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

{
Задача 19b (Использовать модуль)

  Подсчитать как изменится среднее арифметическое элементов матрицы, если во
всех столбцах с номерами, большими, чем номер столбца с максимальным количе-
ством отрицательных элементов, заменить все отрицательные эл-ты их модулями.
}

uses
  _19b_mod,
  CRT;

BEGIN
  ClrScr;

  Writeln('Задача 19b');
  Writeln;
  Writeln('  Подсчитать как изменится среднее арифметическое элементов матрицы, если во');
  Writeln('всех столбцах с номерами, большими, чем номер столбца с максимальным количе-');
  Writeln('ством отрицательных элементов, заменить все отрицательные эл-ты их модулями.');

  Writeln;

  Read_Matrix;

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

  Writeln;
  Writeln('Среднее арифметическое эл-ов матрица А равно: ',sr_arifm:0:3);

  Process_Matrix;

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

  Writeln;
  Writeln('Среднее арифметическое эл-ов обработанной матрицы А равно: ',sr_arifm:0:3);

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

{Модуль для программы 19b.pas}
Unit _19b_mod;

interface

CONST
  MAXIM = 20;

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

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


Procedure Read_Matrix;
Procedure Write_Matrix(N,M: integer);
Function sr_arifm: real;
Procedure Process_Matrix;

implementation

{Процедура ввода матрицы}
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]:7:3);
      Writeln;
    end;
  End;

{Функция вычисления среднего арифметического эл-ов матрица А}
Function sr_arifm: real;
  Var
    i,j          : integer;
    sum          : real;
  Begin
    sum:=0;
    for i:=1 to M do begin
      for j:=1 to N do sum:=sum+A[i,j];
    end;
    sr_arifm:=sum/(N*M);
  End;

{Основная процедура}
Procedure Process_Matrix;
  Var
    i,j           : integer;
    max_stlb      : integer;
    m_o_e         : integer;
    max_moe_stlb  : integer;

  Begin
    {Поиск столбца с макс количеством отрицательных элементов}
    m_o_e:=0;
    for i:=1 to M do if (A[i,1]<0) then m_o_e:=m_o_e+1;
    max_moe_stlb:=m_o_e;
    max_stlb:=1;

    for j:=1 to N do begin
      m_o_e:=0;
      for i:=1 to M do if (A[i,j]<0) then m_o_e:=m_o_e+1;
      if m_o_e>max_moe_stlb then begin
        max_moe_stlb:=m_o_e;
        max_stlb:=j;
      end;
    end;
    Writeln;
    if max_moe_stlb>0 then begin
      Writeln('Максимальное кол-во отрицательных эл-ов в стролбце ',max_stlb);
    end else begin
      Writeln('В матрице А нет отрицательных элементов !');
    end;

    {Меняем отриц элементы на их модули в заданных по условию столбцах}
    for j:=1 to N do begin
      if (j>max_stlb) then begin
        for i:=1 to M do A[i,j]:=abs(A[i,j]);
      end;
    end;
  End;

end.