В программе для сортировки записей по именам и оценкам используется
метод пузырьковой сортировки. Обычно этот метод ругают в учебниках
за медлительность, зато он достаточно очевиден в написании и отладке.
А по скорости для современных компьютеров он работает практически мгновенно,
и "продвинутые алгоритмы", т н сортировка Шелла и быстрая сортировка
не оправдывают многочасовых усилий в изучении, написании и отладке.
Pascal Код:
Type
Student = record
FIO:string[30];
Data:string[12];
ocenki:array[1..5] of integer;
End;
const nmax=50;
Var
s:Student;
f:file of Student;
i,j,n:integer;
G:array[1..nmax] of student;
index:array[1..nmax] of integer;
procedure CreateTest;
begin
n:=0;
n:=n+1;with G[n] do begin fio:='Neznayka';data:='23.02.2000';
ocenki[1]:=2;ocenki[2]:=2;ocenki[3]:=2;ocenki[4]:=2;ocenki[5]:=2 end;
n:=n+1;with G[n] do begin fio:='Znayka';data:='08.03.2000';
ocenki[1]:=5;ocenki[2]:=5;ocenki[3]:=5;ocenki[4]:=5;ocenki[5]:=5 end;
n:=n+1;with G[n] do begin fio:='Tubik';data:='01.05.2000';
ocenki[1]:=2;ocenki[2]:=3;ocenki[3]:=2;ocenki[4]:=3;ocenki[5]:=2 end;
n:=n+1;with G[n] do begin fio:='Vintik';data:='14.06.2000';
ocenki[1]:=4;ocenki[2]:=4;ocenki[3]:=4;ocenki[4]:=4;ocenki[5]:=5 end;
n:=n+1;with G[n] do begin fio:='Shpuntik';data:='12.08.2001';
ocenki[1]:=4;ocenki[2]:=4;ocenki[3]:=4;ocenki[4]:=4;ocenki[5]:=4 end;
for i:=1 to nmax do begin index[i]:=0 end;
for i:=1 to n do begin index[i]:=i end;
end;
procedure CreateStud;
label 1;
begin
writeln('Dlya wyhoda wwedite "0"');
n:=0;
while (n<nmax) do begin
n:=n+1;
writeln('Student ',n);
write('FIO>');readln(s.fio);
if (s.fio='0') then begin writeln('==Stop==');n:=n-1;goto 1;end;
Write('Data>');Readln(s.Data);
Writeln('Vvedite ocenki');
for j:=1 to 5 do begin write('Ocenka',j,'>'); Readln(s.ocenki[j]);end;
G[n]:=s;
end;
1:
for i:=1 to nmax do begin index[i]:=0 end;
for i:=1 to n do begin index[i]:=i end;
end;
procedure WriteFile;
Begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
Assign(f,'SCHOOL');Rewrite(f);
for i:=1 to n do begin Write(f,G[index[i]]) end;
Close(f);
writeln('File zapisan,zapisey ',n);
end;
procedure ReadFile;
begin
n:=0;
Assign(f,'SCHOOL');Reset(f);
while not eof(f) do begin
n:=n+1;read(f,G[n]) end;
close(f);
for i:=1 to nmax do begin index[i]:=0 end;
for i:=1 to n do begin index[i]:=i end;
writeln('File schitan,zapisey ',n);
end;
function srednee(k:integer):real;
var sum:real;
ii:integer;
begin
sum:=0;
for ii:=1 to 5 do sum:=sum+G[k].ocenki[ii];
srednee:=sum/5.0;
end;
procedure SortImena;
var exflag:integer;t:integer;
begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
exflag:=0;
while (exflag=0) do begin
exflag:=1;
for i:=1 to n-1 do begin
if (G[index[i]].fio > G[index[i+1]].fio) then
begin exflag:=0;
t:=index[i+1];index[i+1]:=index[i];index[i]:=t end;
end;
end;
end;
procedure SortOcenki;
var exflag:integer;t:integer;
begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
exflag:=0;
while (exflag=0) do begin
exflag:=1;
for i:=1 to n-1 do begin
if (srednee(index[i]) > srednee(index[i+1])) then
begin exflag:=0;
t:=index[i+1];index[i+1]:=index[i];index[i]:=t end;
end;
end;
end;
procedure LineStud(k:integer);
var ii:integer;
begin
with G[k] do begin write(k,chr(32),fio,chr(9),data);
for ii:=1 to 5 do write(chr(32),ocenki[ii]);
writeln (chr(32),srednee(k):3:1);
end;
end;
procedure ShowStud;
begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
for i:=1 to n do begin LineStud(index[i]) end;
end;
procedure ShowStud2(Sredn:real);
begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
for i:=1 to n do begin
if (srednee(index[i])<Sredn) then LineStud(index[i])
end;
end;
procedure ShowStud3;
var found:integer;
begin
if (n=0) then begin writeln('Sozdayte dannye');exit end;
found:=0;
write('FIO>');readln(s.fio);
for i:=1 to n do begin
if (G[index[i]].fio=s.fio) then
begin found:=1;LineStud(index[i]);end;
end;
if (found=0) then writeln('Student ne najden');
end;
{main}
var exitprog:integer;cmd:integer;
begin
exitprog:=0;
while (exitprog=0) do begin
writeln;
writeln('1. Sozdat demo bazu');
writeln('2. Sozdat bazu');
writeln('3. Sortirovka po imeni');
writeln('4. Sortirovka po srednemu ballu');
writeln('5. Spisok vsex studentov');
writeln('6. Spisok studentov so srednim ballom < 3');
writeln('7. Poisk dannyh po imeni studenta');
writeln('8. Zagruzit fail');
writeln('9. Zapisat fail na disk');
writeln('0. Konec raboty');
write('>');readln(cmd);
case cmd of
0:begin exitprog:=1 end;
1:begin CreateTest;ShowStud end;
2:begin CreateStud;ShowStud end;
3:begin SortImena;ShowStud end;
4:begin SortOcenki;ShowStud end;
5:begin ShowStud end;
6:begin ShowStud2(3.0) end;
7:begin ShowStud3 end;
8:begin ReadFile;ShowStud end;
9:begin WriteFile end;
end; {case}
end; {while}
end.