Массив, Помогите исправить ошибку!!! Опции

[Макс]

В заданном двумерном массиве поменять местами минимальные элементы среди положительных.

Проблема в том что не могу найти второй наименьший элемент(приравнивается к первому)

Помогите еси не трудно

Код

uses crt;
var a:array[1..50,1..50] of integer;
    i,j,m,n,minp1,minp2,min_i,min_j:integer;
    key:char;
procedure zapolnenie;
begin
  for i:=1 to n do
  for j:=1 to m do
  begin
  A[i,j]:=random(20);
end;
end;

procedure vyvod;
begin
    for i:=1 to n do begin
    for j:=1 to m do
    write(' ',a[i,j]);
    writeln;
    end;
end;

procedure naimpoloz1;
begin
  minp1:=a[1,1];
  min_i:=1;min_j:=1;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp1 then minp1:=a[i,j];
  if a[min_i,min_j]>a[i,j] then begin
  min_i:=i;
  min_j:=j;
  end;
  end;
  writeln(minp1);
  writeln(min_i,'   ',min_j);
  end;

procedure naimpoloz2;
begin
  minp2:=a[min_i,min_j];
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp2 then minp2:=a[i,j];
  end;
  writeln(minp2);
end;

procedure obmen;
begin
..........
end;

begin
    repeat
    clrscr;
    textcolor(white);
    writeln('vvedite kol-vo strok');
    readln(n);
    writeln('vvedite kol-vo stolbcov');
    readln(m);
    zapolnenie;
    vyvod;
    naimpoloz1;
    naimpoloz2;
    obmen;
    writeln('Dla vyhoda nazmite N');
    key:=readkey;
    until upcase (key)='N';
end.

[Гость]

procedure naimpoloz1;
begin
  minp1:=a[1,1];
  min_i:=1;min_j:=1;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp1 then minp1:=a[i,j];
  if a[min_i,min_j]>a[i,j] then begin
  min_i:=i;
  min_j:=j;
  end;
  end;
  writeln(minp1);
  writeln(min_i,'   ',min_j); { <--- Вот тут !!! }
  end;

procedure naimpoloz2;
begin
  minp2:=a[min_i,min_j];
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp2 then minp2:=a[i,j]; { <--- Вот тут !!! }
  end;
  writeln(minp2);
end;

Вот где твоя ошибка, ты ищешь сначала наименьший элемент массива, а потом этот же наименьший элемент сравниваешь с другими (понятно, что меньше его не будет.) Совет такой:
изменить условие, при чем, minp2:=32768;
If (a[i,j]<minp2) and (a[i,j]<>minp1)

Ты когда-нибудь будешь тегами пользоваться?

Сообщение отредактировано: volvo - 24.12.2005 22:41

[Гость]

Слушай, спасибо тебе огромное !
P.S.ошибка действительно очент глупая

[Гость]

Да всегда пожалуйста

[volvo]

изменить условие, при чем, minp2:=32768;

И есть вероятность при компиляции в Дельфях нарваться на проблему (такое уже было, ищи по форуму)...

Не просто так, видимо ввели константу MaxInt...

minP2 := maxInt; { <--- Избавляет от привязки к компилятору }

[Макс]

Немного исправил, и кстати ещё один вопрос: как вывести новую матрицу с замененными элементами

Код

uses crt;
var a:array[1..50,1..50] of integer;
    i,j,m,n,minp1,minp2,min:integer;
    key:char;
procedure zapolnenie;
begin
  for i:=1 to n do
  for j:=1 to m do
  begin
  A[i,j]:=random(20);
end;
end;

procedure vyvod;
begin
    for i:=1 to n do begin
    for j:=1 to m do
    write(' ',a[i,j]);
    writeln;
    end;
end;

procedure naimpoloz1;
begin
  minp1:=a[1,1];
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp1 then minp1:=a[i,j];
  end;
  writeln(minp1);
end;

procedure naimpoloz2;
begin
  minp2:=100;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if (a[i,j]<minp2) and (a[i,j]<>minp1) then minp2:=a[i,j];
  end;
  writeln(minp2);
end;

procedure swap;
begin
  minp2:=minp2-minp1;
  minp1:=minp1+minp2;
  minp2:=minp1-minp2;
end;

begin
    repeat
    clrscr;
    textcolor(white);
    writeln('vvedite kol-vo strok');
    readln(n);
    writeln('vvedite kol-vo stolbcov');
    readln(m);
    zapolnenie;
    vyvod;
    naimpoloz1;
    naimpoloz2;
    swap;
    writeln(minp1);writeln(minp2);
    writeln('Dla vyhoda nazmite N');
    key:=readkey;
    until upcase (key)='N';
end.

[Макс]

Всем огромное спасибо - во всём разобрался.
Кстати вот выкладываю полное решение.

Код

uses crt;
var a:array[1..50,1..50] of integer;
    i,j,m,n,minp1,minp2,min:integer;
    key:char;
procedure zapolnenie;
begin
  for i:=1 to n do
  for j:=1 to m do
  begin
  A[i,j]:=random(20);
end;
end;

procedure vyvod;
begin
    for i:=1 to n do begin
    for j:=1 to m do
    write(' ',a[i,j]);
    writeln;
    end;
end;

procedure naimpoloz1;
begin
  minp1:=a[1,1];
  for i:=1 to n do
  for j:=1 to m do
  begin
  if a[i,j]<minp1 then minp1:=a[i,j];
  end;
  writeln(minp1);
end;

procedure naimpoloz2;
begin
  minp2:=maxint;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if (a[i,j]<minp2) and (a[i,j]<>minp1) then minp2:=a[i,j];
  end;
  writeln(minp2);
end;

procedure swap;
begin
  for i:=1 to n do
  for j:=1 to m do
  begin
  minp2:=minp2-minp1;
  minp1:=minp1+minp2;
  minp2:=minp1-minp2;
  if a[i,j]=minp1 then a[i,j]:=minp2;
  if a[i,j]=minp2 then a[i,j]:=minp1;
end;
end;

{main}
begin
    repeat
    clrscr;
    textcolor(white);
    writeln('vvedite kol-vo strok');
    readln(n);
    writeln('vvedite kol-vo stolbcov');
    readln(m);
    zapolnenie;
    vyvod;
    naimpoloz1;
    naimpoloz2;
    swap;
    vyvod;
    writeln('Dla vyhoda nazmite N');
    key:=readkey;
    until upcase (key)='N';
end.

[Макс]

Кстати что надо исправить, чтобы пограмма работала правильно, если массив будет заполнятся отрицательными и положительными числами?
например при генерировании случ чисел от -10 до 10

Код

begin
  for i:=1 to n do
  for j:=1 to m do
  begin
  A[i,j]:=random(21)-10;
end;
end;

[Макс]

Need help, please!

[volvo]

Макс, замени свои процедуры на эти:

procedure naimpoloz1;
begin
  minp1:=maxint;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if (a[i,j]>0) and (a[i,j]<minp1) then minp1:=a[i,j];
  end;
  writeln(minp1);
end;

procedure naimpoloz2;
begin
  minp2:=maxint;
  for i:=1 to n do
  for j:=1 to m do
  begin
  if (a[i,j]>0) and (a[i,j]<minp2) and (a[i,j]<>minp1) then minp2:=a[i,j];
  end;
  writeln(minp2);
end;

НО!!! Это будет работать корректно только тогда, когда в массиве есть по крайней мере 2 разных положительных элемента...

Вот лог программы:

vvedite kol-vo strok
5
vvedite kol-vo stolbcov
5
1 2 5 7 2
8 1 7 -2 3
3 -2 -1 -4 8
-9 10 -5 -2 0
6 7 1 0 1
1
2
2 1 5 7 2
8 2 7 -2 3
3 -2 -1 -4 8
-9 10 -5 -2 0
6 7 2 0 2
Dla vyhoda nazmite N

[Макс]

Volvo, огромное спасибо!