Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

SORT

.PAS
Скачиваний:
18
Добавлен:
16.04.2013
Размер:
11.84 Кб
Скачать
uses crt,DOS;
type
koor=record
x1,y1:integer;
end;

var kol:integer;
di :integer;
nap:integer;
elm:integer;
vyb:integer;
xy :array [1..7] of koor;
mas:array [1..20000] of integer;
k :char;

Procedure Calculate(h1,m1,s1,ms1,h2,m2,s2,ms2:Integer);
var
msc:Integer;
begin
if s1>s2 then s2:=60+s2;
if s1=s2 then msc:= ms2-ms1
else
msc:= (s2-s1-1)*1000+1000-ms1+ms2;
gotoxy(45,17);
Write(msc div 1000,'.',msc mod 1000);
end;

{//////////////////////////д-жЁЁ б®авЁа®ўЄЁ ¬ ббЁў /////////////////////////}
{дг­ЄжЁп ᮧ¤ Ґв ¬ ббЁў}
procedure sozd(k,b:integer);
var i:integer;
begin
randomize;
for i:=0 to k do
mas[i]:=random(b);
gotoxy(44,17);
write(' Њ ббЁў ᮧ¤ ­ ');
delay(1000);
gotoxy(44,17);
write(' ');
end;

{дг­ЄжЁп ᮧ¤ Ґв ¬ ббЁў б® ўбҐ¬Ё ®¤Ё­ Є®ўл¬Ё}
procedure sozd1(k,b:integer);
var i,j:integer;
begin
randomize;
j:=random(b);
for i:=0 to k do
mas[i]:=j;
gotoxy(44,17);
write(' Њ ббЁў ᮧ¤ ­ ');
delay(1000);
gotoxy(44,17);
write(' ');
end;

{дг­ЄжЁп ўлў®¤  ¬ ббЁў }
procedure vyvod(k:integer);
var i:integer;
begin
for i:=0 to k do
write(mas[i],' ');
end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў Їг§ламЄ®ўл¬ ¬Ґв®¤®¬ ў Їаאַ¬ ­ Їа ў«Ґ­ЁЁ}
procedure puz(k:integer);
var i,j,t:integer;
begin
for i:=0 to k-1 do
for j:=i+1 to k do
if mas[i]>mas[j] then begin
t:=mas[i];
mas[i]:=mas[j];
mas[j]:=t;
end;
end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў Їг§ламЄ®ўл¬ ¬Ґв®¤®¬ ў ®Ўа в­®¬ ­ Їа ў«Ґ­ЁЁ}
procedure puz1(k:integer);
var i,j,t:integer;
begin
for i:=0 to k-1 do
for j:=i+1 to k do
if mas[i]<mas[j] then begin
t:=mas[i];
mas[i]:=mas[j];
mas[j]:=t;
end;
end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ ®вЎ®а  ў Їаאַ¬ ­ Їа ў«Ґ­ЁЁ}
procedure otbor(k:integer);
var i,m,l,t,r:integer;
begin
for i:=0 to k-1 do begin
m:=0;
l:=i;
t:=mas[i];
for r:=i+1 to k do begin
if mas[r]<t then begin
l:=r;
t:=mas[r];
m:=1;
end; end;
if m<>0 then
begin
mas[l]:=mas[i];
mas[i]:=t;
end;end;end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ ®вЎ®а  ў ®Ўа в­®¬ ­ Їа ў«Ґ­ЁЁ}
procedure otbor1(k:integer);
var i,m,l,t,r:integer;
begin
for i:=0 to k-1 do begin
m:=0;
l:=i;
t:=mas[i];
for r:=i+1 to k do begin
if mas[r]>t then begin
l:=r;
t:=mas[r];
m:=1;
end; end;
if m<>0 then
begin
mas[l]:=mas[i];
mas[i]:=t;
end;end;end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ ўбв ўЄЁ ў Їаאַ¬ ­ Їа ў«Ґ­ЁЁ}
procedure vstavka(k:integer);
var i,t,r:integer;
begin
for i:=1 to k do begin
t:=mas[i];
r:=i-1;
while((r>=0) and (t<mas[r])) do begin mas[r+1]:=mas[r]; r:=r-1; end;
mas[r+1]:=t;
end;
end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ ўбв ўЄЁ ў ®Ўа в­®¬ ­ Їа ў«Ґ­ЁЁ}
procedure vstavka1(k:integer);
var i,t,r:integer;
begin
for i:=1 to k do begin
t:=mas[i];
r:=i-1;
while((r>=0) and (t<mas[r])) do begin mas[r+1]:=mas[r]; r:=r-1; end;
mas[r+1]:=t;
end;
end;

{ дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ Ґ««  ў Їаאַ¬ ­ Їа ў«Ґ­ЁЁ}
procedure Shell(count:integer);
var i,x,j,gap,kk:integer;
a:array [0..4] of integer;
begin
a[0]:=9; a[1]:=5; a[2]:=3; a[3]:=2; a[4]:=1;
for kk:=0 to 4 do begin
gap:=a[kk];
for i:=gap to count do begin
x:=mas[i];
j:=i-gap;
while((x<mas[j]) and (j>=0))
do begin mas[j+gap]:=mas[j]; j:=j-gap; end;
mas[j+gap]:=x;
end;
end;
end;

{ дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ Ґ««  ў ®Ўа в­®¬ ­ Їа ў«Ґ­ЁЁ}
procedure Shell1(count:integer);
var i,x,j,gap,kk:integer;
a:array [0..4] of integer;
begin
a[0]:=9; a[1]:=5; a[2]:=3; a[3]:=2; a[4]:=1;
for kk:=0 to 4 do begin
gap:=a[kk];
for i:=gap to count do begin
x:=mas[i];
j:=i-gap;
while((x>mas[j]) and (j>=0))
do begin mas[j+gap]:=mas[j]; j:=j-gap; end;
mas[j+gap]:=x;
end;
end;
end;

{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ Hoare ў Їаאַ¬ ­ Їа ў«Ґ­ЁЁ }
procedure Hoare(left,right:integer);
var
i,j,b,tmp:integer;
begin
i:=left; j:=right;
b:=mas[(left+right) div 2];
while (i<=j) do begin
while mas[i]<b do i:=i+1;
while b<mas[j] do j:=j-1;

if (i<=j) then begin
tmp:=mas[i];
mas[i]:=mas[j];
mas[j]:=tmp;
i:=i+1; j:=j-1;
end;
end;
if left<j then Hoare(left,j);
if i<right then Hoare(i,right);
end;
{дг­ЄжЁп б®авЁагҐв ¬ ббЁў ¬Ґв®¤®¬ Hoare ў ®Ўа в­®¬ ­ Їа ў«Ґ­ЁЁ }
procedure Hoare1(left,right:integer);
var
i,j,b,tmp:integer;
begin
i:=left; j:=right;
b:=mas[(left+right) div 2];
while (i<=j) do begin
while mas[i]>b do i:=i+1;
while b>mas[j] do j:=j-1;

if (i<=j) then begin
tmp:=mas[i];
mas[i]:=mas[j];
mas[j]:=tmp;
i:=i+1; j:=j-1;
end;
end;
if left<j then Hoare1(left,j);
if i<right then Hoare1(i,right);
end;
{/////////////////////д-жЁЁ а Ў®вл б нЄа ­®¬ Ё гбв ­®ўЄ ¬Ё//////////////////}
procedure sozd_mas_xy;
begin
xy[1].x1:=25;
xy[1].y1:=4;
xy[2].x1:=25;
xy[2].y1:=6;
xy[3].x1:=8;
xy[3].y1:=10;
xy[4].x1:=8;
xy[4].y1:=11;
xy[5].x1:=8;
xy[5].y1:=16;
xy[6].x1:=8;
xy[6].y1:=17;
xy[7].x1:=58;
xy[7].y1:=12;
end;

procedure tabl(sx,sy,ex,ey,st:integer);
var i,j:integer;
begin
textcolor(13);
gotoxy(sx,sy); write('Ъ');
gotoxy(sx,ey); write('А');
gotoxy(ex,ey); write('Щ');
gotoxy(ex,sy); write('ї');
for i:=sx+1 to ex-1 do begin
gotoxy(i,sy); write('Д');
gotoxy(i,ey); write('Д');
end;
for i:=sy+1 to ey-1 do begin
gotoxy(sx,i); write('і');
gotoxy(ex,i); write('і');
end;
textcolor(11);
end;

procedure screen;
begin
textbackground(0);
clrscr;
textcolor(11);

gotoxy(5,4);
write('„«Ё­  ¬ ббЁў : ');

gotoxy(5,6);
write('„Ё Ї®§®­ ¬ ббЁў : ');

tabl(5,9,20,12,2);
gotoxy(5,8);
write('Ќ Їа ў«Ґ­ЁҐ б®авЁа®ўЄЁ: ');
gotoxy(7,10);
write('[ ] ЇаאַҐ ');
gotoxy(7,11);
write('[ ] ®Ўа в­®Ґ ');

tabl(5,15,28,18,2);
gotoxy(5,14);
write('ќ«Ґ¬Ґ­вл ¬ ббЁў : ');
gotoxy(7,16);
write('[ ] Ґбвм б®ўЇ ¤ ойЁҐ');
gotoxy(7,17);
write('[ ] ўбҐ ®¤Ё­ Є®ўлҐ');

tabl(43,5,65,11,5);
gotoxy(45,4);
write('‘®авЁа®ўЄЁ:');
gotoxy(45,6);
write('1- Їг§ламЄ®ў п');
gotoxy(45,7);
write('2- ¬Ґв®¤ ®вЎ®а  ');
gotoxy(45,8);
write('3- ¬Ґв®¤ ўбв ўЄЁ');
gotoxy(45,9);
write('4- ¬Ґв®¤ Ґ«« ');
gotoxy(45,10);
write('5- ¬Ґв®¤ •® а ');

gotoxy(45,12);
write('‚ и ўлЎ®а: ');

tabl(43,15,65,18,2);
gotoxy(44,16);
write(' ‚६п б®авЁа®ўЄЁ:');

textcolor(13);
gotoxy(25,5);
write('-----');
gotoxy(25,7);
write('-----');

gotoxy(1,25);
write(' Џа®ЎҐ«-Ё§¬Ґ­Ёвм ®ЇжЁо * N-ᮧ¤ вм ¬ ббЁў * S-б®авЁа®ў вм * Esc-ўл室');

{­ з «м­лҐ §­ зҐ­Ёп}
textcolor(14);
gotoxy(25,4);
write('500'); kol:=500;
gotoxy(25,6);
write('500'); di:=500;
gotoxy(8,10);
write('x'); nap:=0;
gotoxy(8,16);
write('x'); elm:=0;
gotoxy(58,12);
write('1'); vyb:=1;
gotoxy(25,4);
end;

procedure Choose;
var m:integer;
hour,minutes,seconds,milliseconds:Word;
hour1,minutes1,seconds1,milliseconds1:Word;
begin
m:=1;
sozd_mas_xy;
while KeyPressed do k:=readkey;
repeat
k:=readkey;
if ((k='n') and (elm=0)) then begin
sozd(kol,di);
gotoxy(xy[m].x1,xy[m].y1); end;
if ((k='n') and (elm=1)) then begin
sozd1(kol,di);
gotoxy(xy[m].x1,xy[m].y1); end;

if k='s' then begin
gotoxy(44,17);
write(' €¤Ґв б®авЁа®ўЄ ');
GetTime(hour,minutes,seconds,milliseconds);
case vyb of
1:if nap=0 then puz(kol) else puz1(kol);
2:if nap=0 then otbor(kol) else otbor1(kol);
3:if nap=0 then vstavka(kol) else vstavka1(kol);
4:if nap=0 then Shell(kol) else Shell1(kol);
5:if nap=0 then Hoare(0,kol) else Hoare1(0,kol);
end;
GetTime(hour1,minutes1,seconds1,milliseconds1);
gotoxy(44,17);
write(' ');
Calculate(hour,minutes,seconds,milliseconds,hour1,minutes1,seconds1,milliseconds1);
gotoxy(xy[m].x1,xy[m].y1);
end;
if ((k=' ') and (xy[m].x1=xy[3].x1) and (xy[m].y1=xy[3].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write('x');
gotoxy(xy[m+1].x1,xy[m+1].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
nap:=0;
end;
if ((k=' ') and (xy[m].x1=xy[4].x1) and (xy[m].y1=xy[4].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write('x');
gotoxy(xy[m-1].x1,xy[m-1].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
nap:=1;
end;

if ((k=' ') and (xy[m].x1=xy[5].x1) and (xy[m].y1=xy[5].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write('x');
gotoxy(xy[m+1].x1,xy[m+1].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
elm:=0;
end;
if ((k=' ') and (xy[m].x1=xy[6].x1) and (xy[m].y1=xy[6].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write('x');
gotoxy(xy[m-1].x1,xy[m-1].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
elm:=1;
end;
if ((k=' ') and (xy[m].x1=xy[1].x1) and (xy[m].y1=xy[1].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
readln(kol);
gotoxy(xy[m].x1,xy[m].y1);
end;
if ((k=' ') and (xy[m].x1=xy[2].x1) and (xy[m].y1=xy[2].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
readln(di);
gotoxy(xy[m].x1,xy[m].y1);
end;
if ((k=' ') and (xy[m].x1=xy[7].x1) and (xy[m].y1=xy[7].y1))
then begin
gotoxy(xy[m].x1,xy[m].y1); write(' ');
gotoxy(xy[m].x1,xy[m].y1);
readln(vyb);
gotoxy(xy[m].x1,xy[m].y1);
end;

if k=#0 then k:=readkey {­ ¦ в  дг­Єж. Є« ўЁи }
else continue;
if k=#72 then begin m:=m-1; if m=0 then m:=7;
gotoxy(xy[m].x1,xy[m].y1); end;
if k=#80 then begin m:=m+1; if m=8 then m:=1;
gotoxy(xy[m].x1,xy[m].y1); end;

until k=#27;
end;

begin
screen;
Choose;
end.
Соседние файлы в предмете Алгоритмы и системы данных