Кабардино-Балкарский государственный университет
Опубликован: 11.11.2008 | Доступ: свободный | Студентов: 7312 / 2172 | Оценка: 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.