Помогите найти ошибку
Добавлено: 27 янв 2007, 01:38
Это та старая задача, про Transform. Но это не важно, главное то, что программа не правильно находит максимальное и минимальное значения. (или я не правильно прогу написал)
Код: Выделить всё
uses crt;
const n=10;
type mas = array [1..n] of integer;
var a: mas;
b: mas;
i,s,sum: integer;
max,min,k,mxb,mib,no,ansv,t,j: integer;
procedure transform;
begin
b:=a;
k:=0;
while k<>no do begin
for i:= 1 to n do b[i]:=sum-b[i];
inc(k);
end;
for i:= 1 to n do begin
mxb:=b[1];
mib:=b[1];
if mib>b[i] then mib:=b[i];
if mxb<b[i] then mxb:=b[i];
end;
for i:= 1 to n do writeln(b[i]);
end;
begin
clrscr;
writeln('Elementi massiva A');
for i:= 1 to n do begin
a[1]:=45;
a[2]:=52;
a[3]:=47;
a[4]:=46;
a[5]:=44;
a[6]:=48;
a[7]:=49;
a[8]:=43; {при этих значениях }
a[9]:=50; {ответ должен быть равен 9}
a[10]:=51;
end;
for i:= 1 to n do writeln(b[i]);
for i:= 1 to n do begin
max:=a[1];
min:=a[1];
if min>a[i] then min:=a[i];
if max<a[i] then max:=a[i];
end;
sum:=0;
for i:= 1 to n do sum:=sum+a[i];
writeln(' Slolko raz delat "Transform"?');
readln(no);
transform;
ansv:=mxb-mib;
writeln('OTBET ',ansv);
writeln(max,' ',min);
writeln(mxb,' ',mib);
readkey;
end.