Текст програми
OSN
program n78;
uses crt,MAINMENU;
begin
MainMenuWork;
readln;
end.
unit Common
unit common;
interface
uses crt;
const p=5;
n=40;
m=40;
type TVector=array[1..p,1..m,1..n] of integer;
TTime=record
Hours,
Minutes,
Seconds,
HSeconds:word
end;
var A:TVector;
STime,FTime:TTime;
Res,Res11,Res12,Res13,Res21,Res22,Res23,Res31,Res32,Res33:longint;
implementation
begin
end.
unit MAINMENU
unit MAINMENU;
interface
procedure MainMenuDisplay;
procedure MainMenuWork;
procedure MenuMas;
procedure MenuTmp1;
procedure MenuTmp2;
procedure MenuSort;
procedure AlgWatch;
implementation
uses crt,SORT,MAS,BATCH,Common;
procedure MainMenuDisplay;
begin
clrscr;
writeLn('Choose action from the list:');
writeLn('1: Fill matrix');
writeLn('2: Look result table');
writeln('3: Pack mode');
writeln('4: Pack mode for 1D');
writeln;
writeln('0: Exit');
end;
procedure MainMenuWork;
var
ch:byte;
begin
clrscr;
MainMenuDisplay;
readln(ch);
case ch of
1 : begin
MenuMas;
end;
2 : begin
AlgWatch;
readln;
MainMenuWork;
end;
3: begin
clrscr;
BatchAlg1;
writeln('BatchAlg1 ended');
BatchAlg2;
writeln('BatchAlg2 ended');
BatchAlg3;
writeln('BatchAlg3 ended');
writeln; writeln('PRESS ENTER');
readln;
MainMenuWork;
end;
4: begin
clrscr;
BatchAlg1_1D;
writeln('BatchAlg1_1D ended');
BatchAlg2_1D;
writeln('BatchAlg2 ended');
BatchAlg3_1D;
writeln('BatchAlg3_1D ended');
writeln; writeln('PRESS ENTER');
readln;
MainMenuWork;
end;
0 : Exit
else exit;
end;
end;
procedure MenuMas;
var
ch:byte;
begin
clrscr;
writeln('Choose the way of filling the matrix:');
writeln('1: Sorted matrix');
writeln('2: Backsorted matrix');
writeln('3: Unsorted matrix');
writeln('4: Back');
writeln;
writeln('0: Exit');
readln(ch);
case ch of
1: begin
SortMas;
MonitorMatrix;
readln;
MenuTmp1;
end;
2: begin
BackSortMas;
MonitorMatrix;
readln;
MenuTmp1;
end;
3: begin
UnSortMas;
MonitorMatrix;
readln;
MenuTmp1;
end;
4: MainMenuWork;
0: Exit;
else exit;
end;
end;
procedure MenuTmp1;
var
ch:byte;
begin
clrscr;
writeln;
writeln('Choose action from the list:');
writeln('1: Forward to sorted matrix');
writeln('2: See another section');
writeln('3: Fill another matrix');
writeln;
writeln('0: Exit');
readln(ch);
case ch of
1: MenuSort;
2: begin
MonitorMatrix;
readln;
MenuTmp1;
end;
3: MenuMas;
0: Exit;
end;
end;
procedure MenuTmp2;
var
ch:byte;
begin
clrscr;
writeln('Choose action grom the list:');
writeln('1: See another section');
writeln('2: Back to main menu');
writeln;
writeln('0: Exit');
readln(ch);
case ch of
1: begin
MonitorMatrix;
readln;
writeln('Result=',Res);
MenuTmp2;
end;
2: MainMenuWork;
0: exit
else exit;
end;
end;
procedure MenuSort;
var
ch:byte;
begin
clrscr;
writeln('Choose the algorythm to sort matrix:');
writeln('1: Vstavka-1');
writeln('2: Vibir-4');
writeln('3: Obmin-3');
writeln;
writeln('0: Exit');
readln(ch);
case ch of
1: begin
Vstavka1;
MonitorMatrix;
writeln('Result=',Res);
readln;
MenuTmp2;
end;
2: begin
Vibir4;
MonitorMatrix;
writeln('Result=',Res);
readln;
MenuTmp2;
end;
3: begin
Obmin3;
MonitorMatrix;
writeln('Result=',Res);
readln;
MenuTmp2;
end;
0: Exit;
end;
end;
procedure AlgWatch;
var i,k,a:integer;
begin
clrscr;
write(chr(218));
gotoxy(2,1);
for i:=2 to 77 do
write(chr(196));
writeln(chr(191));
write(' STATISTICS OF ALGORYTHMS');
gotoxy(1,2);
for i:=1 to 5 do
begin
gotoxy(1,2*i);
write(chr(179));
end;
for i:=1 to 4 do
begin
gotoxy(1,2*i+1);
write(chr(195));
for k:=1 to 77 do
if (k=20) or (k=39) or (k=58) then
write(chr(197))
else
write(chr(196));
end;
gotoxy(21,3);write(chr(194));gotoxy(40,3);write(chr(194));
gotoxy(59,3);write(chr(194));
gotoxy(20,4);
a:=21;
for k:=1 to 4 do
begin
for i:=2 to 5 do
begin
gotoxy(a,2*i);
write(chr(179));
end;
a:=a+19;
end;
gotoxy(78,2);write(chr(179));
for i:=1 to 4 do
begin
gotoxy(78,2*i+1);
write(chr(180));
end;
gotoxy(1,11);
write(chr(192));
for k:=1 to 76 do
if (k=20) or (k=39) or (k=58) then
write(chr(193))
else
write(chr(196));
write(chr(217));
gotoxy(2,4); write(' ALGORYTHM');
gotoxy(2,6); write('Insert #1');
gotoxy(2,8); write('Select #4');
gotoxy(2,10);write('Exchange #3');
gotoxy(22,4); write(' Sorted');
gotoxy(41,4); write(' Unsorted');
gotoxy(60,4); write(' Reverse sorted');
gotoxy(22,6);write(Res11:10);
gotoxy(41,6);write(Res12:10);
gotoxy(60,6);write(Res13:10);
gotoxy(22,8);write(Res21:10);
gotoxy(41,8);write(Res22:10);
gotoxy(60,8);write(Res23:10);
gotoxy(22,10);write(Res31:10);
gotoxy(41,10);write(Res32:10);
gotoxy(60,10);write(Res33:10);
gotoxy(58,12); writeln('sclav Nadtochiy T.V.');
writeln('PRESS ''ENTER''');
end;
BEGIN
END.
unit MAS
unit MAS;
interface
uses Common;
procedure SortMas; {Vidsortovaniy Masiv}
procedure UnSortMas; {Nevidsortovaniy Masiv}
procedure BackSortMas; {Vidsortovaniy Navpaki Masiv}
procedure MonitorMatrix; {Vivod Razreza Na Ekran}
procedure SortMas_1D; {Vidsortovaniy Vektor}
procedure UnSortMas_1D; {Nevidsortovaniy Vektor}
procedure BackSortMas_1D; {Vidsortovaniy Navpaki Vektor}
function ResTime(var Stime,Ftime:TTime):longint;{Vimiryuvannya Chasu}
implementation
uses crt;
var k,i,j,B,l:integer;
procedure SortMas; {Vidsortovaniy Masiv}
BEGIN
B:=0;
for k:=1 to p do
for i:=1 to m do
for j:=1 to n do
begin
A[k,i,j]:=B;
B:=B+1;
end;
END;
procedure UnSortMas; {Nevidsortovaniy Masiv}
BEGIN
randomize;
for k:=1 to p do
for i:=1 to m do
for j:=1 to n do
a[k,i,j]:=random(99);
END;
procedure BackSortMas; {Vidsortovaniy Navpaki Masiv}
BEGIN
B:=0;
for k:=1 to p do
for i:=m downto 1 do
for j:=n downto 1 do
begin
A[k,i,j]:=B;
B:=B+1;
end;
END;
procedure SortMas_1D; {Vidsortovaniy Vektor}
BEGIN
B:=0;
for i:=1 to m*n do
begin
C[i]:=B;
B:=B+1;
end;
END;
procedure UnSortMas_1D; {Nevidsortovaniy Vektor}
BEGIN
randomize;
for i:=1 to m*n do
C[i]:=random(99);
END;
procedure BackSortMas_1D; {Vidsortovaniy Navpaki Vektor}
BEGIN
B:=0;
for i:=m*n downto 1 do
begin
C[i]:=B;
B:=B+1;
end;
END;
procedure MonitorMatrix;
var
SecNum:integer;
begin
clrscr;
repeat
clrscr;
writeln('Enter the number os section to display(1-3):');
readln(SecNum);
until SecNum<=p;
for i:=1 to m do
begin
writeln;
for j:=1 to n do
begin
write(a[SecNum,i,j],' ');
end;
end;
writeln;writeln;
writeln('PRESS ''ENTER''');
end;
function ResTime(var STime,FTime:TTime):longint;
BEGIN
ResTime:=36000*(FTime.Hours-STime.Hours)+
6000*(FTime.Minutes-STime.Minutes)+
100*(FTime.Seconds-STime.Seconds)+
(FTime.HSeconds-STime.HSeconds);
END;
Begin
End.
unit BATCH
unit BATCH;
interface
procedure BatchAlg1;
procedure BatchAlg2;
procedure BatchAlg3;
procedure BatchAlg1_1D;
procedure BatchAlg2_1D;
procedure BatchAlg3_1D;
implementation
uses crt,Common,MAS,SORT;
procedure BatchAlg1;
begin
SortMas; {Massinve - sorted, algorythm - Vstavka1}
Vstavka1;
Res11:=Res;
writeln('Res11=',Res11);
UnSortMas; {Massinve - unsorted, algorythm - Vstavka1}
Vstavka1;
Res12:=Res;
writeln('Res12=',Res12);
BackSortMas; {Massinve - reverse-sorted, algorythm - Vstavka1}
Vstavka1;
Res13:=Res;
writeln('Res13=',Res13);
end;
procedure BatchAlg2;
begin
SortMas; {Massinve - sorted, algorythm - Vibir4}
Vibir4;
Res21:=Res;
writeln('Res21=',Res21);
UnSortMas; {Massinve - unsorted, algorythm - Vibir4}
Vibir4;
Res22:=Res;
writeln('Res22=',Res22);
BackSortMas; {Massinve - reverse-sorted, algorythm - Vibir4}
Vibir4;
Res23:=Res;
writeln('Res23=',Res23);
end;
procedure BatchAlg3;
begin
SortMas; {Massinve - sorted, algorythm - Obmin3}
Obmin3;
Res31:=Res;
writeln('Res31=',Res31);
UnSortMas; {Massinve - unsorted, algorythm - Obmin3}
Obmin3;
Res32:=Res;
writeln('Res32=',Res32);
BackSortMas; {Massinve - reverse-sorted, algorythm - Obmin3}
Obmin3;
Res33:=Res;
writeln('Res33=',Res33);
end;
procedure BatchAlg1_1D;
begin
SortMas_1D; {Massive - sorted, algorythm - Vstavka1}
Vstavka1;
Res11:=Res;
writeln('Res11=',Res11);
UnSortMas_1D; {Massive - unsorted, algorythm - Vstavka1}
Vstavka1;
Res12:=Res;
writeln('Res12=',Res12);
BackSortMas_1D; {Massive - reverse-sorted, algorythm - Vstavka1}
Vstavka1;
Res13:=Res;
writeln('Res13=',Res13);
end;
procedure BatchAlg2_1D;
begin
SortMas_1D; {Massive - sorted, algorythm - Vstavka1}
Vibir4;
Res11:=Res;
writeln('Res11=',Res11);
UnSortMas_1D; {Massive - unsorted, algorythm - Vstavka1}
Vibir4;
Res12:=Res;
writeln('Res12=',Res12);
BackSortMas_1D; {Massive - reverse-sorted, algorythm - Vstavka1}
Vibir4;
Res13:=Res;
writeln('Res13=',Res13);
end;
procedure BatchAlg3_1D;
begin
SortMas_1D; {Massinve - sorted, algorythm - Obmin3}
Obmin3;
Res31:=Res;
writeln('Res31=',Res31);
UnSortMas_1D; {Massinve - unsorted, algorythm - Obmin3}
Obmin3;
Res32:=Res;
writeln('Res32=',Res32);
BackSortMas_1D; {Massinve - reverse-sorted, algorythm - Obmin3}
Obmin3;
Res33:=Res;
writeln('Res33=',Res33);
end;
BEGIN
END.
unit SORT
unit SORT;
interface
procedure Vstavka1;
procedure Vibir4;
procedure Obmin3;
procedure Vstavka1_1d;
procedure Vibir4_1d;
procedure Obmin3_1d;
implementation
uses crt,Common,MAS,dos;
var i,j,k,l,q,d,b,t:integer;
STime,FTime:TTime;
boo:boolean;
procedure Vstavka1;
var bi,bj,pbi,pbj:integer;
BEGIN
with STime do GetTime(Hours,Minutes,Seconds,HSeconds); {START TIME}
for k:=1 to p do
begin
i:=1; j:=2;
while i<>m+1 do
begin
B:=A[k,i,j];
bj:=1;
bi:=1;
while B>A[k,bi,bj] do
begin
bj:=bj+1;
if bj=n+1 then
begin
bi:=bi+1;
bj:=1;
end;
end;
pbj:=j;
pbi:=i;
while (bj<>pbj) or (bi<>pbi) do
begin
if (pbi<>1) and (pbj=1) then
begin
A[k,pbi,1]:=A[k,pbi-1,n];
pbi:=pbi-1;
pbj:=n;
end
else
begin
A[k,pbi,pbj]:=A[k,pbi,pbj-1];
pbj:=pbj-1;
end;
if (pbj=0) and (pbi<>1) then
begin
pbj:=n;
pbi:=pbi-1;
end;
end;
A[k,bi,bj]:=B;
j:=j+1;
if j=n+1 then
begin
j:=1;
i:=i+1;
end;
end;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime);
END;
procedure Vibir4;
var Li,Lj,Ri,Rj,imax,imin,jmax,jmin:integer;
BEGIN
with STime do GetTime(Hours,Minutes,Seconds,HSeconds); {START TIME}
for k:=1 to p do
begin
Li:=1; Lj:=1; Ri:=m; Rj:=n;
while (Li<Ri) or ((Li=Ri) and (Lj<Rj)) do
begin
imin:=Li; imax:=Li;
jmin:=Lj; jmax:=Lj;
for i:=Li to Ri do
for j:=Lj to Rj do
if A[k,i,j] < A[k,imin,jmin] then
begin
imin:=i;
jmin:=j;
end
else
if A[k,i,j] > A[k,imax,jmax] then
begin
imax:=i;
jmax:=j;
end;
B:=A[k,imin,jmin];
A[k,imin,jmin]:=A[k,Li,Lj];
A[k,Li,Lj]:=B;
if (imax=Li) AND (jmax=Lj) then
begin
B:=A[k,imin,jmin];
A[k,imin,jmin]:=A[k,Ri,Rj];
A[k,Ri,Rj]:=B;
end
else
begin
B:=A[k,imax,jmax];
A[k,imax,jmax]:=A[k,Ri,Rj];
A[k,Ri,Rj]:=B;
end;
if Lj<n then Lj:=Lj+1 else
begin
Lj:=1; Li:=Li+1;
end;
if Rj>1 then Rj:=Rj-1 else
begin
Rj:=m; Ri:=Ri-1;
end;
end;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime);
END;
procedure Obmin3;
var R,bi,bj,pbi,pbj:integer;
BEGIN
with STime do GetTime(Hours,Minutes,Seconds,HSeconds); {START TIME}
for k:=1 to p do
begin
bi:=m;
bj:=n;
while (bj>1) or (bi>1) do
begin
pbj:=1;
pbi:=1;
for i:=1 to bi-1 do
begin
for j:=1 to n-1 do
if (A[k,i,j]>A[k,i,j+1]) then
begin
B:=A[k,i,j];
A[k,i,j]:=A[k,i,j+1];
A[k,i,j+1]:=B;
pbj:=j;
pbi:=i;
end;
if (A[k,i,n]>A[k,i+1,1]) then
begin
B:=A[k,i,n];
A[k,i,n]:=A[k,i+1,1];
A[k,i+1,1]:=B;
pbj:=n;
pbi:=i;
end;
end;
i:=bi;
for j:=1 to bj-1 do
if (A[k,i,j]>A[k,i,j+1]) then
begin
B:=A[k,i,j];
A[k,i,j]:=A[k,i,j+1];
A[k,i,j+1]:=B;
pbi:=i;
pbj:=j;
end;
bj:=pbj;
bi:=pbi;
end;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime);
END;
procedure Vstavka1_1d;
Begin
with STime do GetTime(Hours,Minutes,Seconds,HSeconds);
for i:=2 to n*m do
begin
B:=C[i];
j:=1;
while B>C[j] do j:=j+1;
for k:=i-1 downto j do
C[k+1]:=C[k];
C[j]:=B;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime)*p;
End;
procedure Vibir4_1d;
var Left,Right,Imin,Imax:integer;
Begin
with STime do GetTime(Hours,Minutes,Seconds,HSeconds);
Left:=1; Right:=n*m;
while Left<Right do
begin
Imin:=Left; Imax:=Left;
for i:=Left+1 to Right do
if C[i] < C[Imin] then
Imin:=i
else
if C[i] > C[Imax] then
Imax:=i;
B:=C[Imin];
C[Imin]:=C[Left];
C[Left]:=B;
if Imax=Left then
begin
B:=C[Imin];
C[Imin]:=C[Right];
C[Right]:=B;
end
else begin
B:=C[Imax];
C[Imax]:=C[Right];
C[Right]:=B;
end;
Left:=Left+1; Right:=Right-1;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime)*p;
End;
procedure Obmin3_1d;
var R:integer;
Begin
with STime do GetTime(Hours,Minutes,Seconds,HSeconds);
R:=n*m;
while R>1 do
begin
k:=1;
for i:=1 to R-1 do
if C[i] > C[i+1] then
begin
B:=C[i];
C[i]:=C[i+1];
C[i+1]:=B;
k:=i;
end;
R:=k;
end;
with FTime do GetTime(Hours,Minutes,Seconds,HSeconds); {END TIME}
Res:=ResTime(STime,FTime)*p;
End;
BEGIN
END.
Тести:
Для всіх алгоритмів тести були проведені для одного й того ж масиву. Отримані результати були очікувані: всі алгоритми впорядкували розрізи трьохвимірного масиву(5х5х5) по рядкам наскрізно (від лівого верхнього кута до правого нижнього). Отримані результати для масиву 5х5х5:
Початковий масив:
Відсортований масив:
