Triedenie Trmax, Buble, Bublesort v pascale

{ TRIED.PAS                 Copyright (c) TrSek alias Zdeno Sekerak }
{ Program ktorý predvedie a porovná 3 spôsoby triedenia čísel.      }
{ TRMAX - triedenie cez maximum.                                    }
{ BUBLE - bublikové triedenie.                                      }
{ BUBLESORT - bublinkové s príznakom.                               }
{                                                                   }
{ Datum:10.04.1998                             http://www.trsek.com }
 
program sposob_triedenia;
uses crt,dos;
const TmpSoub='cisla.txt';
var
    b:array[1..32000]of integer;
    i,j,pom,pr,max,y,pm:integer;
    t1,t2:real;
    k:char;
 
 
{ vygeneruje subor s nahodnymi cislami }
procedure GenerujTxt(max:integer);
var f:text;
    i:integer;
begin
  assign(f,TmpSoub);
  rewrite(f);
{  append(f);}
 
  Randomize;
  for i:= 1 to max do
    Writeln(f,Random(max));
 
  close(f);
end;
 
 
{ precita txt subor a naplni pole }
procedure CitajTxt;
var f:text;
    i:integer;
begin
  assign(f,TmpSoub);
  reset(f);
  i:=0;
 
  while not(eof(f)) do
  begin
    inc(i);
    Readln(f,b[i]);
  end;
 
  close(f);
end;
 
 
{ zisti aky je aktualny cas a vrati pocet milisekund }
function DajCas:real;
var h,mi,s,ss:word;
begin
  gettime(h,mi,s,ss);
  DajCas := (h*3600) + (mi*60) + s + (ss/100);
end;
 
 
{ vypise ako dlho to trvalo a aky je zoznam }
procedure VypisVysledok(txt:string;cas:real);
var i:integer;
begin
  ClrScr;
  Writeln('Zotriedene:');
 
  for i:= 1 to max do
  begin
    Write(b[i]);
    if (i<>max) then Write(',');
  end;
 
  Writeln;
  Writeln;
  Writeln(txt,' trvalo ',cas:5:5,' sekund. (stlac ENTER)');
  Readln;
end;
 
 
{ Hlavny begin }
begin
 y:=2;
 
 Repeat
   Clrscr;
   Gotoxy(1,1);
   Writeln('Vyberte si sp“sob triedenia (ESC-Koniec):');
   Writeln(' TRMAX     - (triedenie cez maximum)');
   Writeln(' BUBLE     - (bublikov‚ triedenie)');
   Writeln(' BUBLESORT - (BUBLE s prĄznakom)');
   Gotoxy(1,y);
   k:=Readkey;
 
   if (k=#80) and (y<6) then begin
     y:=y+1;
     Gotoxy(1,y);
   end;
 
   if (k=#72) and (y>2) then begin
     y:=y-1;
     Gotoxy(1,y);
   end;
 
   {///////// stlacil ENTER, vygeneruje zoznam cisel /////////}
   if (k=#13) then begin
      Clrscr;
      Write('Zadaj pocet cisel:');
      Readln(max);
      GenerujTxt(max);
   end;
 
   {///////// triedenie cez maximum /////////}
   if (k=#13) and (y=2) then
   begin
     { normalne }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= max downto 2 do begin
       pm:=j;
       for i:= 1 to j do begin
         if b[i]>b[pm] then begin
            pom:=b[i];
            b[i]:=b[pm];
            b[pm]:=pom;pm:=j;
         end;
       end;
     end;
 
     t2:=DajCas;  {cas na konci}
     VypisVysledok('Triedenie cisel',t2-t1);
 
     { zdola nahor }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= max downto 2 do begin
       pm:=j;
       for i:= 1 to j do begin
         if b[i]>b[pm] then begin
            pom:=b[i];
            b[i]:=b[pm];
            b[pm]:=pom;pm:=j;
         end;
       end;
     end;
 
     t2:=DajCas;  {cas na konci}
     VypisVysledok('Triedenie cisel zdola hore',t2-t1);
 
     { zhora nadol }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= max downto 2 do begin
       pm:=j;
       for i:= 1 to j do begin
         if b[i]>b[pm] then begin
            pom:=b[i];
            b[i]:=b[pm];
            b[pm]:=pom;pm:=j;
         end;
       end;
     end;
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie1 z hora dole',t2-t1);
   end;   { if(y=2) }
 
 
   {///////// triedenie buble /////////}
   if (k=#13) and (y=3) then
   begin
     { normalne }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= 1 to max-1 do begin
       for i:= 1 to max-1 do begin
           if b[i]>b[i+1] then begin
              pom:=b[i];
              b[i]:=b[i+1];
              b[i+1]:=pom;
           end;
       end;
     end;
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie roznych cisel',t2-t1);
 
     { z dola nahor }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= 1 to max-1 do begin
         for i:= 1 to max-1 do begin
             if b[i]>b[i+1] then begin
                pom:=b[i];
                b[i]:=b[i+1];
                b[i+1]:=pom;
             end;
         end;
     end;
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie cisel z dola hore',t2-t1);
 
     { zhora nadol }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     for j:= 1 to max-1 do begin
         for i:= 1 to max-1 do begin
             if b[i]>b[i+1] then begin
                pom:=b[i];
                b[i]:=b[i+1];
                b[i+1]:=pom;
             end;
         end;
     end;
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie2 cisel z hora dole',t2-t1);
   end;   { if(y=3) }
 
 
   {///////// triedenie buble s priznakom /////////}
   if (k=#13) and (y=4) then
   begin
     { normalne }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     repeat
       pr:=0;
       for i:= 1 to max-1 do begin
          if b[i]>b[i+1] then begin
             pr:=pr+1;
             pom:=b[i];
             b[i]:=b[i+1];
             b[i+1]:=pom;
          end;
       end;
     until (pr=0);
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie roznych cisel',t2-t1);
 
     { zdola nahor }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     repeat
       pr:=0;
       for i:= 1 to max-1 do begin
          if b[i]>b[i+1] then begin
             pr:=pr+1;
             pom:=b[i];
             b[i]:=b[i+1];
             b[i+1]:=pom;
          end;
       end;
     until (pr=0);
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie cisel z dola hore',t2-t1);
 
     { zhor nadol }
     CitajTxt;
     t1:=DajCas;  {cas pred spustenim }
     Writeln('Triedim ...');
 
     repeat
       pr:=0;
       for i:= 1 to max-1 do begin
           if b[i]>b[i+1] then begin
              pr:=pr+1;
              pom:=b[i];
              b[i]:=b[i+1];
              b[i+1]:=pom;
           end;
       end;
     until (pr=0);
 
     t2:=DajCas;  {dava cas na konci}
     VypisVysledok('Triedenie3 cisel z hora dole',t2-t1);
   end;   { if(y=4) }
 Until k=#27;
end.