-
Расчетная часть
3.1 Решение первой задачи
Program CR1_26;
Uses crt;
const players=10; {Игроки}
Type matrix=array[1..players,1..players] of char; {Матрица таблицы турниров}
label 1;
Var m:matrix; {Объявление массива}
i:integer; {Индекс строки}
j:integer; {Индекс столбца}
result:array[1..players] of real;
winner:integer;
function wnpWNP(c:char):char;
begin wnpWNP:=c; if c='в' then wnpWNP:='В';if c='н' then wnpWNP:='Н';if c='п' then wnpWNP:='П' end;
Begin
clrscr;
for i:=1 to players do for j:=1 to players do
if i=j then m[i,j]:='-' else if j>i then begin
1: write('Игрок ',i,' против ',j,' (В,Н,П): ');
Readln(m[i,j]);m[i,j]:=wnpWNP(m[i,j]);
if not (m[i,j] in ['В','Н','П']) then goto 1;
end;
for i:=1 to players do for j:=1 to players do
if i>j then begin
if m[j,i]='В' then m[i,j]:='П';
if m[j,i]='Н' then m[i,j]:='Н';
if m[j,i]='П' then m[i,j]:='В';
end;
for i:=1 to players do begin
for j:=1 to players do write(' ',m[i,j]);
writeln;
end;
for i:=1 to players do result[i]:=0;
for i:=1 to players do for j:=1 to players do begin
if m[i,j]='В' then result[i]:=result[i]+1.0;
if m[i,j]='Н' then result[i]:=result[i]+0.5;
end;
winner:=1;
for i:=2 to players do if result[i]>result[i-1] then winner:=i;
Writeln('Турнир выиграл игрок ',winner,' !!!');
while not keypressed do ; readln
End.
3.2 Решение второй задачи
program CR2_26;
uses crt;
const maxAb=10; { Студенты }
label 1;
type Ab = record { Тип Ab включает 6 полей: F, B, S, Sc, N, I }
FullName: string[25];
BirthYear: integer;
ScoolYear: integer;
Scool_REZ: array[1..10] of Byte;
NeedPlace: byte;
Incom_REZ: array[1..4] of Byte;
end;
var Abit: array[1..maxAb] of Ab; { Массив записей Abit типа Ab }
sp: text; { Файл }
last,rr: byte; { LAST, режим работы }
procedure saveAb(sAb:Ab); { запись в файл информации о студенте }
var j: byte;
begin
with sAb do begin
writeln(sp,Fullname);
writeln(sp,BirthYear);
writeln(sp,ScoolYear);
For j:=1 to 10 do write(sp,Scool_Rez[j],' ');writeln(sp);
writeln(sp,NeedPlace);
For j:=1 to 4 do write(sp,Incom_Rez[j],' ');writeln(sp);
end;
end;
procedure WaitEnter;
begin
write('Нажмите Enter >> ');
while not Keypressed do ; readln
end;
procedure vvod; { процедура создания файла и ввода данных }
var i,j,n:byte;ch:char;
begin { оператор assign находится в основной программе }
last:=maxAb;
rewrite(sp); { открытие файла для записи }
for i:=1 to maxAb do with Abit[i] do begin
clrscr;writeln('Введите:');writeln;
while KeyPressed do ch:=ReadKey;
write(i,'. Ф.И.О. - '); readln(Fullname);
write(i,'. Год рождения - '); readln(BirthYear);
write(i,'. Год окон. школы - '); readln(ScoolYear);
write(i,'. Школьные рез. (10!) - '); For j:=1 to 10 do read(Scool_Rez[j]);
write(i,'. Нужд.в общежитии (0/1) - '); readln(NeedPlace);
write(i,'. Вступ. рез. (4!) - '); For j:=1 to 4 do read(Incom_Rez[j]);
saveAb(Abit[i]);
WaitEnter;
end;
close(sp); { закрытие файла для записи }
end;
procedure print; { процедура чтения и печати всего файла }
var i,j:byte;YesNo:string[3];
begin
clrscr;
reset(sp); { открытие файла для чтения }
for i:=1 to maxAb do with Abit[i] do if not eof(sp) then begin
{ Чтение из файла информации о студенте }
last:=i;
readln(sp,Fullname);
readln(sp,BirthYear);
readln(sp,ScoolYear);
For j:=1 to 10 do read(sp,Scool_Rez[j]);readln(sp);
readln(sp,NeedPlace);
For j:=1 to 4 do read(sp,Incom_Rez[j]);readln(sp);
end;
close(sp); { закрытие файла }
if last<>0 then for i:=1 to last do with Abit[i] do begin
writeln('Список студентов (',i,'/',last,'):');
writeln(i,'. Ф.И.О. - ',Fullname);
writeln(i,'. Год рождения - ',BirthYear);
writeln(i,'. Год окон. школы - ',ScoolYear);
write(i,'. Школьные рез. (10) - ');For j:=1 to 10 do write(Scool_Rez[j],' ');writeln;
write(i,'. Нужд.в общежитии - ');YesNo:='Да ';if NeedPlace=0 then YesNo:='Нет';writeln(YesNo);
write(i,'. Вступ. рез. (4) - ');For j:=1 to 4 do write(Incom_Rez[j],' ');writeln;
WaitEnter;
end;
end;
procedure work;
var i,j:integer;good:array[1..maxAb] of boolean;
begin
rewrite(sp); { открытие файла для записи }
for i:=1 to last do begin good[i]:=true;
for j:=1 to 4 do if Abit[i].Incom_Rez[j]<3 then good[i]:=false;
end;
j:=0; for i:=1 to last do if good[i] then saveAb(Abit[i]) else Inc(j);
writeln('Удалено записей: ',j);
WaitEnter;
close(sp); { закрытие файла для записи }
end;
begin { начало основной программы }
assign(sp,'z:\mc-11.2b\shakirov\vedom.dat'); { связать файловую переменную sp с файлом VEDOM.DAT }
last:=0;
1:rr:=0; while not (rr in [1..4]) do begin {clrscr;}
write('Выберите режим работы (1 - ввод, 2 - печать, 3 - удаление, 4 - END!): '); readln(rr) end;
case rr of
1: begin vvod ; goto 1 end;
2: begin print; goto 1 end;
3: begin if last<>0 then work ; goto 1 end;
end;
writeln;writeln('END!');writeln;WaitEnter;
end.