Решение задач по ТОЭ, ОТЦ, Высшей математике, Физике, Программированию...

{
Задача 14a (Процедуры и функции)

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

uses CRT;

CONST
  MAXIM = 20;

TYPE
  matrix_2 = array[1..MAXIM, 1..MAXIM] of real;

VAR
  M,N    : integer;
  A,B    : matrix_2;

Procedure Read_Matrix;
  Var
    i,j    : integer;
  Begin
    M:=0;
    Writeln;
    while (M<=0) or (M>MAXIM) do begin
      Write('Ведите число строк исходной матрицы (M): ');
      Readln(M);
      if (M<=0) or (M>MAXIM) then Writeln('M должно быть больше 0 и меньше ',MAXIM,' !');
    end;

    N:=0;
    while (N<=0) or (N>MAXIM) do begin
      Write('Ведите число столбцов исходной матрицы (N): ');
      Readln(N);
      if (N<=0) or (N>MAXIM) then Writeln('N должно быть больше 0 и меньше ',MAXIM,' !');
    end;

    Writeln;
    Writeln('Ввод исходной матрицы (А):');
    for i:=1 to M do begin
      for j:=1 to N do begin
         Write('Ведите элемент исходной матрицы (',i,',',j,'): ');
         Readln(A[i,j]);
      end;
    end;
  End;

Procedure Write_Matrix(N,M: integer);
  Var
    i,j    : integer;
  Begin
    for i:=1 to M do begin
      for j:=1 to N do Write(' ',A[i,j]:0:3);
      Writeln;
    end;
  End;

Procedure Process_Matrix;
  Var
    i,j,k         : integer;
    max_str       : integer;
    min_str       : integer;
    max_str_sum   : real;
    min_str_sum   : real;
    sum           : real;

  Begin
    {Поиск строки с макс и мин суммой элементов}
    sum:=0;
    for j:=1 to N do sum:=sum+A[1,j];
    max_str_sum:=sum;
    max_str:=1;
    min_str_sum:=sum;
    min_str:=1;

    for i:=1 to M do begin
      sum:=0;
      for j:=1 to N do sum:=sum+A[i,j];
      if sum>max_str_sum then begin
        max_str_sum:=sum;
        max_str:=i;
      end;
      if sum<min_str_sum then begin
        min_str_sum:=sum;
        min_str:=i;
      end;
    end;
    Writeln;
    Writeln('Максимальная сумма эл-ов в строке ',max_str);
    Writeln('Минимальная сумма эл-ов в строке ',min_str);

    if (max_str<>min_str) then begin
      {Формируем новую матрицу В по заданному правилу}
      for j:=1 to N do B[1,j]:=A[max_str,j];
      k:=1;
      for i:=1 to M do begin
        if (i<>max_str) and (i<>min_str) then begin
          k:=k+1;
          for j:=1 to N do B[k,j]:=A[i,j];
        end;
      end;
      for j:=1 to N do B[M,j]:=A[min_str,j];

      {A:=B}
      for i:=1 to M do begin
        for j:=1 to N do A[i,j]:=B[i,j];
      end;
    end else begin
      Writeln;
      Writeln('Номера строк с максимальной и минимальной суммой эл-ов совпадают !');
      Writeln('Работа по заданному алгоритму невозможна !');
    end;

  End;

BEGIN
  ClrScr;

  Writeln('Задача 14а');
  Writeln;
  Writeln('  Изменить заданную прямоугольную матрицу так, чтобы на первом месте стояла');
  Writeln('строка максимальной а на последнем месте строка с минимальной суммой');
  Writeln('элементов, сохранив все элементы исходной матрицы.');

  Writeln;

  Read_Matrix;

  Writeln;
  Writeln('Исходная матрица (А):');
  Write_Matrix(N,M);

  Process_Matrix;

  Writeln;
  Writeln('Обработанная матрица (А):');
  Write_Matrix(N,M);

  Writeln;
  Writeln('Нажмите <Enter> для выхода.');
  Readln;
END.