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

[TBVlad]

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

Код

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

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

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

[klem4]

То есть если у тебя в матрице несколько максимальных элементов ? ТОгда сначала надо найти максимальный элемент, запомнить его значение , ну а потом проходить по матрице и проверять, if m[i,j] = max then writeln(i,',',j);

Ты об этом ?

[volvo]

TBVlad,
либо первым проходом по матрице ищешь нужный элемент и вторым проходом - печатаешь его индексы (этот способ неоптимален по времени), либо организуешь буфер позиций, и при нахождении повторного элемента запоминаешь еще одну позицию, а при надобности - просто сбрасываешь буфер и начинаешь по новой (это - неоптимально по запросам памяти)...

Если надо - говори, покажу как реализовать второй способ...

[TBVlad]

Klem4, да, я так именно так и делал.
1. Искал Max. Его индекс сохранён в Imax и Jmax, и первый максимальный член успешно выводится с местоположением.
2. Счётчик есть, с начальным значением 1 (задан до цикла), и равные максимальные члены считает успешно. Прога проверяет элементы на равенство Max, и если они равны, переопределяет их вместе с Imax и Jmax. Задаю Write(Max, ' стоит на ',Imax,':',Jmax,'.')... но индекс выводится неправильно.

volvo, любопытно. Объясни про буфер позиций, plz...

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

[volvo]

Вот так примерно:

const
  n = 5;
var
  arr: array[1 .. n, 1 .. n] of integer;
  buffer: array[1 .. n] of record { я предупреждал, что требует доп. память }
    x, y: integer;
  end;

var
  max, i, j: integer;
  buf_count: integer;

begin
  { заполнение матрицы Arr }

  buf_count := 0;
  max := - maxint;

  for i := 1 to n do begin
    for j := 1 to n do begin

      if arr[i, j] > max then begin
        max := arr[i, j];
        buf_count := 1;
        buffer[buf_count].x := i;
        buffer[buf_count].y := j;
      end
      else
        if arr[i, j] = max then begin
          inc(buf_count);
          buffer[buf_count].x := i;
          buffer[buf_count].y := j;
        end;

    end;
  end;

  { и распечатываешь все значения X:Y из буфера, от 1 до buf_count }
  ...

проверено на матрице:
1, 2, 3, 4, 5
1, 7, 3, 4, 5
1, 2, 3, 4, 5
1, 2, 3, 7, 5
7, 2, 3, 4, 5
Результат:

max = 7; positions are:
2:2 4:4 5:1

[TBVlad]

Volvo, спасибо.

{ и распечатываешь все значения X:Y из буфера, от 1 до buf_count }

Только одна маленькая вещь...
Пишу:

For buffer:=1 to buf_count do
Write(x,':',y);

И мне выдают ошибку 97 (Invalid For control variable).
Цикл For для распечатки буфера не подходит?

[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.

[volvo]

TBVlad, так делай:

  for i := 1 to buf_count do
    with buffer[i] do write(x, ':', y);
  writeln;

Твоя ошибка - в том, что buffer это массив, и не может быть использован как переменная для For

[TBVlad]

Ошибки исправлены Thanx всем =)

Klem4
Вот это телега... но тоже работает
{...А в диске моём учебном такого нету }