Developing.ru

Код: Выделить всё

var [b]B1:Array [1..N,1..M] of integer[/b]

Код: Выделить всё

Program anuta;
uses crt;
const n=5; m=7;
var  i,j,sum, IndexMin : integer;
     B    : Array [1..N,1..M] of integer; 
     OneS : real;
     Aver : Array [1..M] of real; {массив для сохранения средний значений}
     

{процедура переставляет два столбца в массиве B}     
procedure Exchange(Idx1,Idx2:integer);
var iLoc : integer;
    OneB : integer;
begin 
  for iLoc:=1 to N do begin 
     OneB := B[iLoc,Idx1];
     B[iLoc,Idx1]:=B[iLoc, Idx2];
     B[iLoc, Idx2] := OneB;
  end;
end;     
     
begin
clrscr;
  randomize;
  for i:=1 to n do 
  begin
     for j:=1 to m do begin
       b[i,j]:=random(10);
       Write (b[i,j]:4);
     end; 
     writeln; 
  end;
  for j:=1 to m do 
  begin
     sum:=0;
     for i:=1 to n do begin
        sum:=sum+b[i,j];
     end;
     Aver[j] := sum / n;
     writeln ('SredArifm [',j:1,']= ',Aver[j]:5:1);
  end;

  {а вот теперь начинаем сортировку.
     методом "пузырька" - как самым простым}
     

  {Выбирается минимальный элемент массива
  и меняется местами с первым элементом массива.
  Затем процесс повторяется с оставшимися элементами и т. д. }

  for i:=1 to M-1 do begin
    IndexMin := i; {предварительно считаем, что первый элемент наименьший}
    {ищем индекс минимального элемента}
    for j:=i+1 to M do
      if Aver[j]<Aver[IndexMin] then IndexMin := j;

    {меняем местами элементы массива с индексами i и IndexMin
    (ну, если они не равны, конечно) }
    if i<>IndexMin then begin
      OneS := Aver[IndexMin];
      Aver[IndexMin] := Aver[i];
      Aver[i] := OneS;
      
      {а здесь мы поменяем местами два столбца!}
      Exchange(i, IndexMin)
      
    end;
  end;
  
  {выведем отсортированный двухмерный массив}
  WriteLn('--------------- RESULTAT ---------------');
  for i:=1 to n do 
  begin
     for j:=1 to m do 
       Write (b[i,j]:4);
     writeln; 
  end;
  
  {ну, и для проверки, выведем отсортированный массив 
      со среднеарифметическими значениями    }
  Write('SredArifm(');
  for j:=1 to m do
    write ( Aver[j]:5:1,',');
  WriteLn(')');

  readln;
end.