Последовательный вывод индексов, (это с матрицей) Опции

[TBVlad]

Каким бы образом сделать так, чтобы на вывод шёл не только первый встреченный искомый элемент с его местоположением (ну например максимальный), но и другие равные ему, с их родными индексами?
Слегка не понимаю, как зашить это в цикл, чтобы получилось:

Код

Максимальный член - N найден в позициях:
i:j, i:j, i:j, ...

Если это уже разбиралось, киньте ссылку, plz.

Сообщение отредактировано: TBVlad - 20.01.2006 18:45

[klem4]

я вот чо насочинял

uses crt;
type
   TElem = integer;
   PArray = ^TArray;
   TArray = array [1..1] of TElem;
   PMatrix = ^TMatrix;
   TMatrix = array [1..1] of PArray;

   PBufer =  ^ TBufer;
   TBufer = record
      x,y : word;
      next : PBufer;
   end;

procedure AddBuf(var buf : PBufer; var first : PBufer; i,j : word);
begin
   new(buf);
   buf^.next := first;
   buf^.x := i;
   buf^.y := j;
   first := buf;
end;

procedure PrintBUF(buf : PBufer);
var
   p : PBufer;
begin
   writeln;
   p := buf;
   while(p <> nil) do begin
      writeln(p^.x,'  ',p^.y);
      p := p^.next;
   end;
end;

procedure FreeBUF(var P : Pbufer);
begin
   Dispose(p);
   p := nil;
end;

procedure InitMX(var mx : PMatrix; size : word);
var
   i : word;
begin
   GetMem(mx, size * sizeof(PArray));
   for i := 1 to size do GetMem(mx^[i], size * sizeof(TElem));
end;

procedure FreeMx(var mx : PMatrix; size : word);
var
   i : word;
begin
   for i := 1 to size do FreeMem(mx^[i], size * sizeof(TElem));
   FreeMem(mx, size * sizeof(PArray));
end;

procedure Input(var mx : Pmatrix; size : word);
var
   i,j : word;
begin
   for i := 1 to size do
    for j := 1 to size do begin
       write('mx[',i,',',j,']=');
       readln(mx^[i]^[j]);
    end;
end;

procedure Print(mx : PMatrix; size : word);
var
   i,j : word;
begin
   for i := 1 to size do begin
      writeln;
      for j := 1 to size do write(mx^[i]^[j]:2,' ');
   end;
end;

procedure Work(var mx : PMatrix; var buf : PBufer; size : word);
var
   i,j,imax,jmax : word;
   max : TElem;
   f : PBufer;
begin
   f := nil;
   imax := 1;
   jmax := 1;
   for i := 1 to size do
    for j := 1 to size do
     if mx^[i]^[j] >= mx^[imax]^[jmax] then
      if mx^[i]^[j] = mx^[imax]^[jmax] then
       AddBuf(buf,f,i,j)
       else begin
          imax := i;
          jmax := j;
          FreeBuf(buf);
          f := nil;
          AddBuf(buf,f,imax,jmax);
       end;
end;

var
   Matrix : PMatrix;
   Bufer  : PBufer;
   n : word = 2;

begin
   clrscr;
   InitMX(Matrix,n);
   Input(Matrix,n);
   Print(Matrix,n);
   Work(Matrix, Bufer, n);
   writeln;
   PrintBUF(bufer);
   FreeMX(Matrix,n);
   FreeBUF(bufer);
   readln;
end.