Найти все индексы максимальных значений в одномерн Опции

[Павел]

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

Код

Procedure max_sled (i: integer; var maxX: real);
   var k: integer; max, x: real;
    begin
     max:=l[i];
      for i:=1 to 12 do
       begin
        if max<l[i] then max:=l[i];
       end;

      for i:=1 to 12 do
       begin
        if l[i]=max then
        begin
        x:=i;
        writeln('Index of the maximum element ',x:4:2);
        maxX:=x;
        end;
       end;
 end; {max_sled}

Вызываю процедуру.

Код

max_sled (x, maxX);

и потом у меня там идут выводы массивов

Код

if maxX=1 then
      begin
      vozr (a1, b2, c12);
      writeln ('Matrix c12');
      out_array (a1, b2, c12);
      end;

     if maxX=2 then
     begin
     vozr (a1, b3, c13);
     writeln ('Matrix c13');
     out_array (a1, b3, c13);
     end;

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

Код

writeln('Index of the maximum element',x:4:2);

, но потом в x остается одно последнее максимальное значение на
основе которого выводится только последний упорядоченный массив, но мне то нужно их все вывести. Как это можно сделать?
Может я сумбурно объяснил, но я файлик прикрепил там все видно.

Сообщение отредактировано: Павел - 18.05.2004 15:34

[Павел]

Не придумал ничего умнее кроме как засунуть все в процедуру, зато заботает.
Но слишком уж она большая получается, может можно как нтбудь ее урезать?

Код

Procedure max_sled (i: integer; var x: real);
   var k: integer; max: real;
    begin
     max:=l[i];
      for i:=1 to 12 do
       begin
        if max<l[i] then max:=l[i];
       end;

      for i:=1 to 12 do
       begin
        if l[i]=max then
        begin
        x:=i;
        writeln('Index of the maximum element ',x:4:2);

      if X=1 then
      begin
      vozr (a1, b2, c12);
      writeln ('Matrix c12');
      out_array (a1, b2, c12);
      end;

     if X=2 then
     begin
     vozr (a1, b3, c13);
     writeln ('Matrix c13');
     out_array (a1, b3, c13);
     end;

     if X=3 then
     begin
     vozr (a1, b4, c14);
     writeln ('Matrix c14');
     out_array (a1, b4, c14);
     end;

     if X=4 then
     begin
     vozr (a2, b1, c21);
     writeln ('Matrix c21');
     out_array (a2, b1, c21);
     end;

     if X=5 then
     begin
      vozr (a2, b3, c23);
      writeln ('Matrix c23');
      out_array (a2, b3, c23);
     end;

     if X=6 then
     begin
      vozr (a2, b4, c24);
      writeln ('Matrix c24');
      out_array (a2, b4, c24);
     end;

     if X=7 then
     begin
      vozr (a3, b1, c31);
      writeln ('Matrix c31');
      out_array (a3, b1, c31);
     end;

     if X=8 then
     begin
      vozr (a3, b2, c32);
      writeln ('Matrix c32');
      out_array (a3, b2, c32);
     end;

     if X=9 then
     begin
      vozr (a3, b4, c34);
      writeln ('Matrix c34');
      out_array (a3, b4, c34);
     end;

     if X=10 then
     begin
      vozr (a4, b1, c41);
      writeln ('Matrix c41');
      out_array (a4, b1, c41);
     end;

     if X=11 then
     begin
      vozr (a4, b2, c42);
      writeln ('Matrix c42');
      out_array (a4, b2, c42);
     end;

     if X=12 then
     begin
      vozr (a4, b3, c43);
      writeln ('Matrix c43');
      out_array (a4, b3, c43);
     end;
     readln;
   end;
   end;
 end; {max_sled}

[BlackShadow]

Файлик не прикрепил, объяснил сумбурно, так что если что не то - не удивляйся.
Я бы сделал так: объявил тип-функцию

Код

Type
 MyCallBack = Procedure(MaxX:Integer);

Потом бы написал такую вот процедуру:

Код

Procedure DoOut(MaxX:Integer);
Begin
 vozr (a1, b2, c12);
 writeln ('Matrix c1',MaxX+1);
 out_array (a1, b2, c12);
End;

Затем модифицировал твою max_sled, добавив ей 1 параметр типа MyCallBack:

Код

Procedure max_sled (i: integer; var maxX: real; Fn:MyCallBak);

Хотя на куда тебе тут i как параметр не догоняю.
А потом я бы вставил строку

Код

F(x);

сразу после вывода на экран.
Таким образом у тебя для каждого максимума вызывалась бы процедура вывода.

[Павел]

Спасибо за помощь, файлик я прикрепил, посмотри может что подскажешь.
Там я еще ошибку нашел.
Была задана задача: Даны четыре вещественные матрицы произвольной
размерности (размерность вводится пользователем). Вычислить все возможные
произведения матриц. Упорядочить по возратанию элементы главной диагонали
той из полученных матриц, след которой является наибольшим (следом матрицы
называется сумма элементов главной диагонали). Если в результате вычисления
произведений получена одна матрица, применить к ней указанное упорядочение.
Программу организовать в виде вызовов необходимых подпрограмм (процедур или
функций). Предусмотреть обработку ошибок и удобный интерфейс.
Сегодня доделал, если не обращать внимания на процедуру max_sled . Но вот нашел ошибку (: .
В некоторых случаях перемножения матриц выдается ошибочный результат. Если умножать матрицу i,j 3X3 на 3X4 получается матрица 3X4, стороны одной - a1,b1, другой - a1,b2, значит стороны полученной матрицы будут a1,b2, и потом, когда вызываю процедуру упорядочения главной диагонали по возрастанию получается что упорядочение идет for i:=1 to b-1 do, в данном случае получается до 3 (b2 это 4 и 4-1=3), но диагональ то состоит из 3 чисел,
матрица ведь не квадратная. Получается ошибка, максимальное число становится нолем и уходит вверх, остальные остаются на своих местах. Можно ли тут что-то сделать без глобальных переделок программы?

[BlackShadow]

Вечером. Я сейчас ушёл с головой в работу.

[Павел]

Я и не тороплю, и за это огромное спасибо.

[Павел]

Вот еще ошибка, если максимальные элементы 9 и 12, то 12 не выводится, во всех остальных случаях выводтся.

[Павел]

С упорядочением я разобрался, сделал вот так:

Код

Procedure vozr (a, b: integer; var c:massiv);
   var  i, j: integer;
        k: real;
        sort: boolean;
   begin
   if a > b then begin
     Repeat
        sort := false;
        for i:=1 to b-1 do
        if c[i,i] > c[i+1,i+1] then
        begin
         k:=c[i,i];
         c[i,i]:=c[i+1,i+1];
         c[i+1,i+1]:=k;
         sort:= true;
        end;
     Until sort = false;
    end
   else begin
              Repeat
               sort := false;
               for i:=1 to a-1 do
               if c[i,i] > c[i+1,i+1] then
               begin
                k:=c[i,i];
                c[i,i]:=c[i+1,i+1];
                c[i+1,i+1]:=k;
                sort:= true;
               end;
              Until sort = false;
        end;
 end;  {vozr}