Кабардино-Балкарский государственный университет
Опубликован: 11.11.2008 | Доступ: свободный | Студентов: 7271 / 2153 | Оценка: 4.16 / 3.99 | Длительность: 04:36:00
Темы: Программирование, Образование
Теги:
Дополнительный материал 3:
Тексты программ на Паскале для решения задач оценивания тестирования
Задача 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.