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

SORT

.PAS
Скачиваний:
20
Добавлен:
16.04.2013
Размер:
12 Кб
Скачать
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.
Соседние файлы в предмете Алгоритмы и системы данных