Кабардино-Балкарский государственный университет
Опубликован: 11.11.2008 | Доступ: свободный | Студентов: 7271 / 2153 | Оценка: 4.16 / 3.99 | Длительность: 04:36:00
Дополнительный материал 3:

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

< Дополнительный материал 2 || Дополнительный материал 3: 1234

Задача 1.

program P1;
uses crt;
var
  w,a:array[1..500] of real;
  n:integer;
procedure Input_3;
var i:integer;
begin
  clrscr;
  write('Количество тестированных n=');
  readln(n);
  writeln('Ввод результатов тестирования: ');
for i:=1 to n do
  begin
    writeln;
    write('результат ',i,'-го студента a[',i,']=');
    readln(a[i]);
 end;
 writeln;
 writeln('Ввод весов тестирования: ');
 for i:=1 to n do
 begin
    writeln;
    write('веса w[',i,']=');
    readln(w[i]) ;
 end;
end;
procedure Output_3;
var i:integer;
begin
     for i:=1 to n do
          write(a[i]:6:2,' ');
     writeln;
end;
procedure Sort_3;
var i,j:integer;
      tmp:real;
begin
   for i:=1 to n-1 do
     for j:=i+1 to n do
       if (a[i]>a[j])
          then begin
                      tmp:=a[i];
                      a[i]:=a[j];
                      a[j]:=tmp;
                  end;
end;
function SA_3:real;
var s:real;
       i:integer;
begin
   s:=0;
   SA_3:=0;
   for i:=1 to n do
   s:=s+a[i];
   if (n<>0)
      then SA_3:=s/n;
end;
function SW_3:real;
var s:real;
       i:integer;
begin
   s:=0;
   SW_3:=0;
   for i:=1 to n do
   s:=s+a[i]*w[i];
   if (n<>0)
      then SW_3:=s/n;
end;
function SGarm_3:real;
var s:real;
      i:integer;
begin
   s:=0;
   SGarm_3:=0;
   for i:=1 to n do
   if (a[i]<>0)
      then s:=s+1/a[i];
   if (s<>0)
      then SGarm_3:=n/s;
end;
function SWGeom_3:real;
var s:real;
      i:integer;
      w3:real;
begin
  w3:=0;
  for i:=1 to n do
       w3:=w3+w[i];
  s:=1;
  for i:=1 to n do
       s:=s*exp(w[i]*ln(a[i]));
  SWGeom_3:=exp(ln(s)/w3);
end;
function SWQuadr_3:real;
var s:real;
      i:integer;
      w3:real;
begin
  w3:=0;
  for i:=1 to n do
       w3:=w3+w[i];
  s:=1;
  for i:=1 to n do
      s:=s*sqr(a[i])*w[i];
  SWQuadr_3:=sqrt(s/w3);
end;
function Moda_3:real;
var i,j,k,mi:integer;
      max:real;
begin
  mi:=0;
  for i:=1 to n-1 do
      begin
         k:=1;
         for j:=i+1 to n do
             if (a[i]=a[j])
                then inc(k);
         if (k>mi)
            then begin
                          max:=a[i];
                          mi:=k; 
                    end;
      end;
  Moda_3:=max;
end;
function Mediana_3(sorted:boolean):real;
var i,j:integer;
      max,min:real;
begin
  if (sorted)
    then begin
              max:=a[n];
              min:=a[1];
           end
    else  begin
              max:=a[1];
              min:=a[1];
              for i:=2 to n do
                   begin
                       if (a[i]>max)
                          then max:=a[i];
                       if (a[i]<min)
                          then min:=a[i];
                   end;
            end;
  Mediana_3:=(max+min)/2;
end;
function Razmah_3:real;
begin
  razmah_3:=a[n]-a[1];
end;
function SAbsOtkl_3:real;
var s:real;
      i:integer;
      sa:real;
begin
   sa:=sa_3;
   s:=0;
   for i:=1 to n do
       s:=s+abs(a[i]-sa);
   SAbsOtkl_3:=s/n;
end;
function SQuadroOtkl_3:real;
var s:real;
      i:integer;
      sa:real;
begin
   sa:=sa_3;
   s:=0;
   for i:=1 to n do
        s:=s+sqrt(a[i]);
   SQuadroOtkl_3:=abs(s-n*sqrt(sa))/n;
end;
function Dispersia_3:real;
var s:real;
      i:integer;
      sa:real;
begin
   sa:=sa_3;
   s:=0;
   for i:=1 to n do
        s:=s+sqrt(a[i]);
   if (n>1)
      then Dispersia_3:=abs((s-n*sqrt(sa))/(n-1))
      else Dispersia_3:=0;
end;
begin
  Input_3;
  clrscr;
  writeln('Входные данные ');
  Output_3;
  writeln('Генеральная совокупность');
  Sort_3;
  writeln('Среднеарифметическое = ',SA_3:8:2);
  writeln('Средневзвешанное = ',SW_3:8:2);
  writeln('Средняя гармоническая велечина = ',SGarm_3:8:2);
  writeln('Средне взвешанная геометрическая велечина = ',SWGeom_3:8:2);
  writeln('Средне квадратическая величина выборки = ',SWGeom_3:8:2);
  writeln('Мода = ',Moda_3:8:2);
  writeln('Медиана = ',Mediana_3(true):8:2);
  writeln('Размах = ',Razmah_3:8:2);
  writeln('Среднеабсолютное отклонение = ',SAbsOtkl_3:8:2);
  writeln('Среднеквадратическое отклонение = ',SQuadroOtkl_3:8:2);
  writeln('Дисперсия = ',Dispersia_3:8:2);
  writeln('Стандартное отклонение = ',sqrt(Dispersia_3):8:2);
  writeln('Коэфициент вариации = ',sqrt(Dispersia_3)/sa_3:8:2);
  readkey;
end.

Задача 2.

program P2;
uses crt;
var
  a:array[1..50,1..50] of integer;
  n,m:integer;
  b,y:array[1..50] of integer;
  c,d:array[1..50] of real;
procedure Input_5;
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('Введите эталонные результаты');
 for i:=1 to m do
    begin
        write('b[',i,']=');
        readln(b[i]);
    end;
end;
procedure Output_5;
var i,j:integer;
begin
     for i:=1 to n do
         begin
             for j:=1 to m do
                 write(a[i][j]:6,' ');
                 writeln;
         end;
end;
procedure CheckAnsw;
var i,k,j,krs,lh:integer;
begin
   krs:=0;
   lh:=0;
   for j:=1 to m do
      begin
          k:=0;
          for i:=1 to n do
              if (a[i,j]=b[j])
                 then inc(k);
          y[j]:=k;
          if (k=n)
             then inc(krs);
          if (k=0)
             then inc(lh)
      end;
   for j:=1 to m do
   begin
       if (y[j]<>0)
          then c[j]:=krs/y[j]
          else c[j]:=0;
       if (y[j]<>n)
          then d[j]:=lh/(n-y[j])
          else d[j]:=0;
    end;
end;
procedure PrintResult;
var i:integer;
begin
  writeln('Вектор весов выполнения :');
  for i:=1 to m do
       write(c[i]:8:2);
  writeln;
  writeln('Вектор весов невыполнения :');
  for i:=1 to m do
       write(d[i]:8:2);
  writeln;
end;
begin
  clrscr;
  Input_5;
  clrscr;
  Output_5;
  CheckAnsw;
  PrintResult;
  readkey;
end.
< Дополнительный материал 2 || Дополнительный материал 3: 1234
Татьяна Кожушко
Татьяна Кожушко
Евгения Уразаева
Евгения Уразаева