Program KKR3_10;
uses crt;
type Matrix=array[1..9999] of integer;
     DinamicArray=^Matrix;
     Matrica=array[1..999] of DinamicArray;
var K,L,i,j,max_j,min_j,buf,A,B:integer;
	  InputFile,OutputFile:text;
    X:Matrica;
begin
  clrscr;
  writeln('Здравствуйте, уважаемый пользователь!');
  writeln('Эта программа в каждом столбце меняет местами наибольший и наименьший по модулю элементы.');
  assign(InputFile,'in.txt');
  reset(InputFile);
  for i:=1 to 1 do
    begin
      for j:=1 to 2 do
        read(InputFile,X[i]^[j]);
    end;
  K:=X[1]^[1];
  L:=X[1]^[2];
  for i:=1 to K do
    getmem(X[i],L*sizeof(integer));
  for i:=1 to K do
    begin
      for j:=1 to L do
        read(InputFile,X[i]^[j]);
    end;
  close(InputFile);
  if (K<=0) or (K>50) or (L<=0) or (L>=35) then
    begin
      writeln('Ошибка ввода!!! Введите размерность в файле 0<K<=50 и 0<L<=35.');
      readln;
      halt;
    end;
  writeln('Вы ввели такую исходную матрицу:');
  for i:=1 to K do
    begin
      for j:=1 to L do
        write(X[i]^[j]:4,' ');
        writeln;
    end;
  for j:=1 to L do
    begin
      max_j:=X[1]^[i];
      min_j:=X[1]^[i];
      for i:=1 to K do
        begin
          if abs(X[i]^[j])>=max_j then
            begin
              max_j:=abs(X[i]^[j]);
              A:=i;
            end;
          if abs(X[i]^[j])<=min_j then
            begin
              min_j:=abs(X[i]^[j]);
              B:=i;
            end;
         end;
       buf:=X[A]^[j];
       X[A]^[j]:=X[B]^[j];
       X[B]^[j]:=buf;
     end;
  assign(OutputFile,'out.txt');
  rewrite(OutputFile);
  writeln('В итоге, получили матрицу:');
  for i:=1 to K do
    begin
      for j:=1 to L do
        begin
          write(X[i]^[j]:4,' ');
          write(OutputFile,X[i]^[j]:4,' ');
        end;
      writeln;
      writeln(OutputFile,'');
    end;
  close(OutputFile);
  for i:=1 to K do
    freemem(X[i],L*sizeof(integer));
  readln;
end.

Program KKR3_10;
uses CRT;
type Matrix=array[1..9999] of integer;
     DinamicArray=^Matrix;
     Matrica=array[1..999] of DinamicArray;

Procedure CheckingInputSizeOfMatrix(K,L:integer);
begin
  if (K<=0) or (K>50) or (L<=0) or (L>=35) then
    begin
      writeln('Ошибка ввода!!! Введите размерность в файле 0<K<=50 и 0<L<=35.');
      readln;
      halt;
    end;
end;

Procedure InputMatrixFromTxtFile(var X:Matrica; var K,L:integer);
var InputFile:text;
    i,j:integer;
begin
  assign(InputFile,'in.txt');
  reset(InputFile);
  for i:=1 to 1 do
    begin
      for j:=1 to 2 do
        read(InputFile,X[i]^[j]);
    end;
  K:=X[1]^[1];
  L:=X[1]^[2];
  CheckingInputSizeOfMatrix(K,L);
  for i:=1 to K do
    getmem(X[i],L*sizeof(integer));
  for i:=1 to K do
    begin
      for j:=1 to L do
        read(InputFile,X[i]^[j]);
    end;
  close(InputFile);
end;

Procedure InputedMatrix(X:Matrica; K,L:integer);
var i,j:integer;
begin
  writeln('Вы ввели такую исходную матрицу:');
  for i:=1 to K do
    begin
      for j:=1 to L do
        write(X[i]^[j]:4,' ');
        writeln;
    end;
end;

Procedure TranspositingMaxMinElementInJ(var X:Matrica; K,L:integer);
var i,j,buf,A,B,min_j,max_j:integer;
begin
  for j:=1 to L do
    begin
      max_j:=X[1]^[i];
      min_j:=X[1]^[i];
      for i:=1 to K do
        begin
          if abs(X[i]^[j])>=max_j then
            begin
              max_j:=abs(X[i]^[j]);
              A:=i;
            end;
          if abs(X[i]^[j])<=min_j then
            begin
              min_j:=abs(X[i]^[j]);
              B:=i;
            end;
         end;
       buf:=X[A]^[j];
       X[A]^[j]:=X[B]^[j];
       X[B]^[j]:=buf;
     end;
end;

Procedure OutputMatrixToTxtFile(X:Matrica; K,L:integer);
var i,j:integer;
    OutputFile:text;
begin
  assign(OutputFile,'out.txt');
  rewrite(OutputFile);
  writeln('В итоге, получили матрицу:');
  for i:=1 to K do
    begin
      for j:=1 to L do
        begin
          write(X[i]^[j]:4,' ');
          write(OutputFile,X[i]^[j]:4,' ');
        end;
      writeln;
      writeln(OutputFile,'');
    end;
  close(OutputFile);
  for i:=1 to K do
    freemem(X[i],L*sizeof(integer));
end;

var K,L:integer;
    X:Matrica;
begin
  clrscr;
  writeln('Здравствуйте, уважаемый пользователь!');
  writeln('Эта программа в каждом столбце меняет местами наибольший и наименьший по модулю элементы.');
  InputMatrixFromTxtFile(X,K,L);
  InputedMatrix(X,K,L);
  TranspositingMaxMinElementInJ(X,K,L);
  OutputMatrixToTxtFile(X,K,L);
  readln;
end.

Program KKR4_10;
uses CRT,Graph;
const MaxNumberOfStudents=99;
type TStudent=record
             Name:string[25];
             Mark:2..5;
     end;
     TListOfStudents=record
                     Items:array[1..MaxNumberOfStudents] of TStudent;
                     Count:integer;
     end;
     TJournal=record
              Group:string[6];
              Students:TListOfStudents;
     end;
type ArrayMarks=array[1..4] of integer;

Procedure InputStudent(var s:TStudent);
begin
  write(' Ученик: ');
  readln(s.Name);
  write('   Оценка: ');
  readln(s.Mark);
end;

Procedure InputListOfStudents(var j:TListOfStudents);
var i:integer;
begin
  write('Введите число учеников: ');
  readln(j.Count);
  writeln('Список учеников и оценок:');
  for i:=1 to j.Count do
    begin
      write('№',i );
      InputStudent(j.Items[i]);
    end;
  clrscr;
end;

Procedure InputJournal(var j:TJournal);
begin
  write('Класс: ');
  readln(j.Group);
  InputListOfStudents(j.Students);
end;

Procedure OutputRegister(mark:byte; Magazine:TJournal);
var i:integer;
begin
  writeln(' Класс - ',Magazine.Group);
  writeln('Оценка ученика -  (',mark,'):');
  for i:=1 to Magazine.Students.Count do
    if Magazine.Students.Items[i].Mark=mark then
      writeln(Magazine.Students.Items[i].name);
  readln;
end;

{Procedure Diagramma (Magazine:TJournal; var sm:ArrayMarks);
var i,j:byte;
begin
  for i:=1 to Magazine.Students.Count do
    if Magazine.Students.Items[i].Mark=2 then
      sm[1]:=sm[1]+1
    else if Magazine.Students.Items[i].Mark=3 then
	  sm[2]:=sm[2]+1
    else if Magazine.Students.Items[i].Mark=4 then
      sm[3]:=sm[3]+1
    else if Magazine.Students.Items[i].Mark=5 then
      sm[4]:=sm[4]+1;
    for i:=1 to 4 do
      begin
        textcolor(i);
         write('Kolichestvo ',i+1,'   ');
         for j:=1 to sm[i]*2 do
           write(#178);
         write('  ',sm[i]);
         writeln;
	  end;
  readln;
end;}

Function CountCoordinateForY(sm:ArrayMarks):integer;
var i,y:integer;
begin
  Y:=sm[i];
  CountCoordinateForY:=round(200/Y);
end;

Procedure Diagramma(Magazine:Tjournal; sm:ArrayMarks);
var driver,mode,Err,i:integer;
begin
  clrscr;
  driver:=detect;
  InitGraph(driver,mode,'C:\BGI');
  Err:=GraphResult;
  if Err<>grOK then
    writeln('Ошибка при инициализации графического режима')
  else
    begin
      SetViewPort(0,0,200,300,ClipOff);
      for i:=1 to Magazine.Students.Count do
        if Magazine.Students.Items[i].Mark=2 then
          sm[1]:=sm[1]+1
        else if Magazine.Students.Items[i].Mark=3 then
	        sm[2]:=sm[2]+1
        else if Magazine.Students.Items[i].Mark=4 then
          sm[3]:=sm[3]+1
        else if Magazine.Students.Items[i].Mark=5 then
          sm[4]:=sm[4]+1;
      Rectangle(CountCoordinateForY(sm[1]),0,0,75);{2}
      Rectangle(CountCoordinateForY(sm[2]),75,0,150);{3}
      Rectangle(CountCoordinateForY(sm[3]),150,0,225);{4}
      Rectangle(CountCoordinateForY(sm[4]),225,0,300);{5}
    end;
end;

var j:TJournal;
    sm:ArrayMarks;
begin
  clrscr;
  InputJournal(j);
  OutputRegister(5,j);
  OutputRegister(4,j);
  OutputRegister(3,j);
  OutputRegister(2,j);
  Diagramma(j,sm);
  readln;
end.