Тексты программ на Паскале для решения задач оценивания тестирования

program P5;
uses crt;
var
  a:array[1..50,1..50] of real;
  k,n,m:integer;
  z:array[1..50] of integer;
  c,y:array[1..50] of real;
  pk,min_8:real;
procedure minmax(jj:integer;var min,max:real);
var i:integer;
begin
  min:= a[1,jj];
  max:=a[1,jj];
  for i:=2 to n do
     if (a[i,jj]>max)
        then max:=a[i,jj]
        else if (a[i,jj]<min)
                  then min:=a[i,jj];
end;
function SA_8(jj:integer):real;
var s:real;
i:integer;
begin
   s:=0;
   SA_8:=0;
   for i:=1 to n do
       s:=s+a[i,jj];
   if (n<>0)
      then SA_8:=s/n;
end;
procedure Input_8;
var i,j:integer;
begin
   write('Количество тестированных n=');
   readln(n);
   write('Длина теста m=');
   readln(m);
   writeln('Введите результаты тестирования');
   for i:=1 to n do
       for j:=1 to m do
           begin
               write('a[',i,',',j,']=');
               readln(a[i,j]);
           end;
   writeln;
   writeln('Введите количество групп');
   write('k=');
   readln(k);
   for i:=1 to m do
       z[i]:=1;
end;
procedure Output_8;
var i,j:integer;
begin
    for i:=1 to n do
         begin
             for j:=1 to m do
                 write(a[i][j]:6:2,' ');
             writeln;
         end;
end;
procedure CheckAnsw;
var i,j:integer;
      min,max,sa,s:real;
begin
   for j:=1 to m do
       begin
            minmax(j,min,max);
            for i:=1 to n do
                 begin
                      a[i,j]:=(a[i,j]-min)/(max-min);
                      if (z[j]=-1)
                         then a[i,j]:=1-a[i,j]
                 end;
   end;
   for j:=1 to m do
        begin
             sa:=SA_8(j);
             s:=0;
             for i:=1 to n do
                  s:=s+sqr(a[i,j]-sa);
             if (n>1)
                then c[j]:=sqrt(s/(n-1))
                else c[j]:=0;
        end;
    for i:=1 to n do
        begin
             s:=0;
             for j:=1 to m do
                  s:=s+a[i,j]*c[j];
             y[i]:=s;
        end;
    min:= y[1];
    max:=y[1];
    for i:=2 to n do
         if (y[i]>max)
            then max:=y[i]
            else if (y[i]<min)
                      then min:=y[i];
    pk:=max-min;
    min_8:=min;
    if (k>1)
       then pk:=pk/k;
end;
procedure PrintResult;
var i:integer;
      kk:integer;
begin
    writeln('Значения интегрального показателя и соотв класс :');
    for i:=1 to m do
        begin
            write(y[i]:8:2);
            kk:=0;
            if (pk>0)
               then begin
                           kk:=trunc((y[i]-min_8)/pk) ;
                           if (Frac((y[i]-min_8)/pk)>0.0006)
                               then inc(kk);
                      end;
            writeln('  класс #',kk) ;
        end;
end;
begin
  clrscr;
  Input_8;
  clrscr;
  Output_8;
  CheckAnsw;
  PrintResult;
  readkey;
end.

program P6;
uses crt;
var
   a:array[1..50,1..50] of real;
   n,m:integer;
   b:array[1..50] of real;
function SA_9(jj:integer):real;
var s:real;
      i:integer;
begin
   s:=0;
   SA_9:=0;
   for i:=1 to n do
        s:=s+a[i,jj];
   if (n<>0) then SA_9:=s/n;
end;
procedure Input_9;
var i,j:integer;
begin
   write('Количество тестированных n=');
   readln(n);
   write('Длина теста m=');
   readln(m);
   writeln('Введите результаты тестирования');
   for i:=1 to n do
       for j:=1 to m do
           begin
                write('a[',i,',',j,']=');
                readln(a[i,j]);
           end;
end;
procedure Output_9;
var i,j:integer;
begin
     for i:=1 to n do
         begin
              for j:=1 to m do
                   write(a[i][j]:6:2,' ');
              writeln;
         end;
end;
procedure CheckAnsw;
var i,j:integer;
s,tmp:real;
begin
    for i:=1 to n do
        begin
            s:=0;
            for j:=1 to m do
                 s:=s+a[i,j];
            b[i]:=s;
        end;
    for i:=1 to n-1 do
       for j:=i+1 to n do
           if (b[i]>b[j])
              then begin
                          tmp:=b[i];
                          b[j]:=b[i];
                          b[i]:=tmp
                      end;
end;
procedure PrintResult;
var i:integer;
      kk:integer;
      const b_koef=0.6;
begin
   writeln('Значения интегрального показателя и соотв группа :');
   for i:=1 to m do
        begin
             write(b[i]:8:2);
             if (b[i]>=b[1]+b_koef*(b[n]-b[i]))
                then kk:=1
                else if (b[i]<=b[1]+(1-b_koef)*(b[n]-b[i]))
                           then kk:=3
                           else kk:=2;
             writeln('  группа #',kk) ;
        end;
end;
begin
   clrscr;
   Input_9;
   clrscr;
   Output_9;
   CheckAnsw;
   PrintResult;
   readkey;
end.

program P7;
uses crt;
var
   n:integer;
   x:array[1..50] of real;
   dmax_10,min_10,max_10,sx,w_10:real;
procedure minmax(var min,max:real);
var i:integer;
begin
  min:= x[1];
  max:=x[1];
  for i:=2 to n do
    if (x[i]>max)
       then max:=x[i]
       else if (x[i]<min)
                 then min:=x[i];
end;
function SA_10:real;
var s:real;
      i:integer;
begin
   s:=0;
   SA_10:=0;
   for i:=1 to n do
   s:=s+x[i];
   if (n<>0)
      then SA_10:=s/n;
end;
procedure Input_10;
var i:integer;
begin
   write('Количество тестированных n=');
   readln(n);
   writeln('Введите результаты тестирования');
   for i:=1 to n do
       begin
           write('х[',i,']=');
           readln(x[i]);
       end;
end;
procedure Output_10;
var i:integer;
begin
    for i:=1 to n do
         write(x[i]:6:2,' ');
    writeln;
end;
procedure CheckAnsw;
begin
  sx:=SA_10;
  minmax(min_10,max_10);
  dmax_10:=abs(min_10-sx);
  if (abs(max_10-sx)>dmax_10)
      then dmax_10:=abs(max_10-sx);
  if (sx<>0)
      then w_10:=dmax_10/sx;
end;
procedure PrintResult;
begin
  writeln('Средняя велечина :',sx:8:2);
  writeln('Наибольшее значение :',max_10:8:2);
  writeln('Наимньшее значение :',min_10:8:2);
  writeln('Наибольшее отклонение в группе :',dmax_10:8:2);
  writeln('Относительное отклонение в группе :',w_10:8:2);
end;
begin
  clrscr;
  Input_10;
  clrscr;
  Output_10;
  CheckAnsw;
  PrintResult;
  readkey;
end.