Třídící algoritmy InsertionSort, BubbleSort, ShakerSort, SelectionSort, HeapSort, MergeSort, QuickSort

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategorija:
koupy_sorter.pngZrobil: Petr Koupý
web: koupy.net/programy.php

Program: Sorter.pas
Subor exe: Sorter.exe

Ukázka práce většiny třídících algoritmů, které pro třídění používají porovnávání dvou prvků. Program vytvoří náhodnou posloupnost čísel, kterou zvoleným algoritmem setřídí. Jednoduchým benchmarkem je rovněž možné porovnat časovou složitost jednotlivých algoritmů. Pro vykreselení grafů je použit jednoduchý grafický výstup. Program vznikl v rámci přípravy na maturitu. K programu je přiložen komentovaný zdrojový kód.
{ SORTER.PAS                               Copyright (c) Petr Koupy }
{                                                                   }
{ Demonstrace trideni dat.                                          }
{                                                                   }
{ Ukázka práce většiny třídících algoritmů, které pro třídění       }
{ používají porovnávání dvou prvků. Program vytvoří náhodnou        }
{ posloupnost čísel, kterou zvoleným algoritmem setřídí.            }
{ Jednoduchým benchmarkem je rovněž možné porovnat časovou složitost}
{ jednotlivých algoritmů. Pro vykreselení grafů je použit jednoduchý}
{ grafický výstup. Program vznikl v rámci přípravy na maturitu.     }
{                                                                   }
{ Datum:01.05.2007                             http://www.trsek.com }
 
program sorter;
uses graph,crt,dos;
const xmax=639;
      ymax=479;
type Tpole=array[1..xmax] of integer;
     Tmalepole=array[1..7] of byte;
var graphdriver,graphmode:smallint;
    volba,pocet,k:byte;
    fronta:Tmalepole;
    ukol,hradlo:boolean;
 
procedure GenerujPole(var pole:Tpole);
var i:integer;
begin
  randomize;
  for i:=1 to xmax do pole[i]:=random(ymax-1)+1;
end;
 
procedure Vyjmout(pozice:integer;vstup:Tpole);
begin
  setcolor(black);
  line(pozice+1,480-vstup[pozice],pozice+1,ymax);
end;
 
procedure Vlozit(pozice:integer;vstup:Tpole;zbarveni:byte);
begin
  setcolor(zbarveni);
  line(pozice+1,480-vstup[pozice],pozice+1,ymax);
  setcolor(black);
  line(pozice+1,1,pozice+1,479-vstup[pozice]);
end;
 
procedure Vymenit(pozice1,pozice2:integer;vstup:Tpole;zbarveni:byte);
begin
  setcolor(zbarveni);
  line(pozice1+1,480-vstup[pozice2],pozice1+1,ymax);
  setcolor(black);
  line(pozice1+1,1,pozice1+1,479-vstup[pozice2]);
  setcolor(zbarveni);
  line(pozice2+1,480-vstup[pozice1],pozice2+1,ymax);
  setcolor(black);
  line(pozice2+1,1,pozice2+1,479-vstup[pozice1]);
end;
 
procedure InsertionSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
    misto,index,prvek,posunuti:integer;
    barva:byte;
begin
  if ukol=true then barva:=15;
  setrideno:=nesetrideno;
  for misto:=2 to velikost do
    begin
      index:=1;
      while setrideno[misto]>setrideno[index] do index:=index+1;
      prvek:=setrideno[misto];
      if ukol=true then Vyjmout(misto,setrideno);
      for posunuti:=misto downto index+1 do
        begin
          if ukol=true then delay(cekat);
          setrideno[posunuti]:=setrideno[posunuti-1];
          if ukol=true then Vymenit(posunuti,posunuti-1,setrideno,barva);
        end;
      setrideno[index]:=prvek;
      if ukol=true then Vlozit(index,setrideno,barva);
    end;
end;
 
procedure BubbleSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
    misto,index,prvek,skok:integer;
    barva:byte;
begin
  if ukol=true then barva:=9;
  setrideno:=nesetrideno;
  misto:=velikost;
  repeat
    begin
      skok:=misto-1;
      for index:=1 to misto-1 do
        begin
          if setrideno[index]>setrideno[index+1] then
            begin
              if ukol=true then delay(cekat);
              prvek:=setrideno[index];
              if ukol=true then Vymenit(index,index+1,setrideno,barva);
              setrideno[index]:=setrideno[index+1];
              setrideno[index+1]:=prvek;
              skok:=index;
            end;
        end;
      misto:=skok;
    end;
  until misto<=2;
end;
 
procedure ShakerSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
    index,prvek,skok,dolni,horni:integer;
    barva:byte;
    smer:boolean;
begin
  if ukol=true then barva:=10;
  setrideno:=nesetrideno;
  horni:=velikost;
  dolni:=1;
  index:=0;
  smer:=true;
  skok:=horni;
  repeat
    begin
      repeat
        begin
          if smer=true then
            begin
              index:=index+1;
              if setrideno[index]>setrideno[index+1] then
                begin
                  if ukol=true then delay(cekat);
                  prvek:=setrideno[index];
                  if ukol=true then Vymenit(index,index+1,setrideno,barva);
                  setrideno[index]:=setrideno[index+1];
                  setrideno[index+1]:=prvek;
                  skok:=index;
                end
            end
          else
            begin
              index:=index-1;
              if setrideno[index+1]<setrideno[index] then
                begin
                  if ukol=true then delay(cekat);
                  prvek:=setrideno[index];
                  if ukol=true then Vymenit(index,index+1,setrideno,barva);
                  setrideno[index]:=setrideno[index+1];
                  setrideno[index+1]:=prvek;
                  skok:=index+1;
                end;
            end;
        end;
      until ((smer=true) and (index+1=horni)) or ((smer=false) and (index=dolni));
      if smer=true then
        begin
          smer:=false;
          horni:=skok;
          index:=skok;
        end
      else
        begin
          smer:=true;
          dolni:=skok;
          index:=skok-1;
        end;
    end;
  until horni<=dolni;
end;
 
procedure SelectionSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
    misto1,misto2,index,prvek:integer;
    barva:byte;
begin
  if ukol=true then barva:=11;
  setrideno:=nesetrideno;
  for misto1:=velikost downto 2 do
    begin
      if ukol=true then delay(cekat);
      index:=1;
      for misto2:=1 to misto1 do
        begin
          if setrideno[misto2]>setrideno[index] then index:=misto2;
        end;
      prvek:=setrideno[index];
      if ukol=true then Vymenit(index,misto1,setrideno,barva);
      setrideno[index]:=setrideno[misto1];
      setrideno[misto1]:=prvek;
    end;
end;
 
procedure BublejHaldou(velikost,otec:integer;var halda:Tpole;barva,cekat:integer);
var syn,vymena:integer;
begin
  while 2*otec<=velikost do
    begin
      if ukol=true then delay(cekat);
      syn:=2*otec;
      if (syn<velikost) and (halda[syn]<halda[syn+1]) then syn:=syn+1;
      if halda[otec]>=halda[syn] then break;
      vymena:=halda[otec];
      if ukol=true then Vymenit(otec,syn,halda,barva);
      halda[otec]:=halda[syn];
      halda[syn]:=vymena;
      otec:=syn;
    end;
end;
 
procedure HeapSort(velikost:integer;nesetrideno:Tpole;cekat:integer);
var setrideno:Tpole;
    misto,prvek:integer;
    barva:byte;
begin
  if ukol=true then barva:=12;
  setrideno:=nesetrideno;
  for misto:=(velikost div 2) downto 1 do BublejHaldou(velikost,misto,setrideno,barva,cekat);
  for misto:=velikost downto 2 do
    begin
      if ukol=true then delay(cekat);
      prvek:=setrideno[1];
      if ukol=true then Vymenit(1,misto,setrideno,barva);
      setrideno[1]:=setrideno[misto];
      setrideno[misto]:=prvek;
      BublejHaldou(misto-1,1,setrideno,barva,cekat);
    end;
end;
 
procedure MergeSort(var setrideno,pomocne:Tpole;levy,pravy,cekat:integer);
var i,j,k,stred:integer;
    barva:byte;
begin
  if hradlo=true then
    begin
      for k:=levy to pravy do pomocne[k]:=setrideno[k];
    end;
  if ukol=true then barva:=13;
  stred:=(levy+pravy) div 2;
  if levy<pravy then MergeSort(setrideno,pomocne,levy,stred,cekat);
  if stred+1<pravy then MergeSort(setrideno,pomocne,stred+1,pravy,cekat);
  i:=levy;
  j:=stred+1;
  k:=levy;
  while (i<=stred) and (j<=pravy) do
    begin
      if setrideno[i]<=setrideno[j] then
        begin
          pomocne[k]:=setrideno[i];
          if ukol=true then delay(cekat);
          if ukol=true then Vymenit(k,i,pomocne,barva);
          i:=i+1;
        end
      else
        begin
          pomocne[k]:=setrideno[j];
          if ukol=true then delay(cekat);
          if ukol=true then Vymenit(k,j,pomocne,barva);
          j:=j+1;
        end;
      k:=k+1;
    end;
  while i<=stred do
    begin
      pomocne[k]:=setrideno[i];
      delay(cekat);
      if ukol=true then Vymenit(k,i,pomocne,barva);
      i:=i+1;
      k:=k+1;
    end;
  while j<=pravy do
    begin
      pomocne[k]:=setrideno[j];
      if ukol=true then delay(cekat);
      if ukol=true then Vymenit(k,j,pomocne,barva);
      j:=j+1;
      k:=k+1;
    end;
  for k:=levy to pravy do
    begin
      setrideno[k]:=pomocne[k];
      if ukol=true then delay(cekat);
      if ukol=true then Vyjmout(k,setrideno);
      if ukol=true then Vlozit(k,setrideno,barva);
    end;
end;
 
procedure QuickSort(var setrideno:Tpole;levy,pravy,cekat:integer);
var i,j,pivot,menic:integer;
    barva:byte;
begin
  if ukol=true then barva:=14;
  i:=levy;
  j:=pravy;
  pivot:=setrideno[(i+j) div 2];
  repeat
    begin
      while setrideno[i]<pivot do i:=i+1;
      while setrideno[j]>pivot do j:=j-1;
      if i<=j then
      begin
        if ukol=true then delay(cekat);
        menic:=setrideno[i];
        if ukol=true then Vymenit(i,j,setrideno,barva);
        setrideno[i]:=setrideno[j];
        setrideno[j]:=menic;
        i:=i+1;
        j:=j-1;
      end;
    end;
  until i>=j;
  if j>levy then QuickSort(setrideno,levy,j,cekat);
  if i<pravy then QuickSort(setrideno,i,pravy,cekat);
end;
 
procedure SetridPole(typ:byte);
var polecisel,pomocne:Tpole;
    x,prodleva:integer;
begin
  repeat
    begin
      writeln;
      write('Prodleva vykreslovani grafu (0 az 100 ms): ');
      readln(prodleva);
    end;
  until (prodleva>=0) and (prodleva<=100);
  GenerujPole(polecisel);
  detectgraph(graphdriver, graphmode);
  initgraph(graphdriver, graphmode, 'C:/TP/BP7/BGI');
  setcolor(7);
  line(1,1,1,480);
  line(1,480,640,480);
  case typ of
    1: setcolor(15);
    2: setcolor(9);
    3: setcolor(10);
    4: setcolor(11);
    5: setcolor(12);
    6: setcolor(13);
    7: setcolor(14)
  end;
  hradlo:=true;
  for x:=1 to xmax do line(x+1,480-polecisel[x],x+1,ymax);
  case typ of
    1: InsertionSort(xmax,polecisel,prodleva);
    2: BubbleSort(xmax,polecisel,prodleva);
    3: ShakerSort(xmax,polecisel,prodleva);
    4: SelectionSort(xmax,polecisel,prodleva);
    5: HeapSort(xmax,polecisel,prodleva);
    6: MergeSort(polecisel,pomocne,1,xmax,prodleva);
    7: QuickSort(polecisel,1,xmax,prodleva)
  end;
end;
 
procedure SpocitejGraf(opakovani:byte;seznam:Tmalepole);
var opakuj:byte;
    balon,pomocne:Tpole;
    s1,s2,v1,v2,m1,m2,h1,h2:word;
    cas1,cas2:longint;
    zaplneni,n:integer;
begin
  randomize;
  detectgraph(graphdriver, graphmode);
  initgraph(graphdriver, graphmode, 'C:/TP/BP7/BGI');
  setcolor(7);
  line(1,1,1,480);
  line(1,480,640,480);
  GenerujPole(balon);
  for opakuj:=1 to opakovani do
  begin
    zaplneni:=2;
    cas2:=0;
    n:=0;
    repeat
      begin
        gettime(h1,m1,v1,s1);
        case seznam[opakuj] of
          1: for n:=1 to 10000 do
               begin
                 InsertionSort(zaplneni,balon,0);
                 n:=n+1;
               end;
          2: for n:=1 to 10000 do
               begin
                 BubbleSort(zaplneni,balon,0);
                 n:=n+1;
               end;
          3: for n:=1 to 10000 do
               begin
                 ShakerSort(zaplneni,balon,0);
                 n:=n+1;
               end;
          4: for n:=1 to 10000 do
               begin
                 SelectionSort(zaplneni,balon,0);
                 n:=n+1;
               end;
          5: for n:=1 to 10000 do
               begin
                 HeapSort(zaplneni,balon,0);
                 n:=n+1;
               end;
          6: for n:=1 to 10000 do
               begin
                 MergeSort(balon,pomocne,1,zaplneni,0);
                 n:=n+1;
               end;
          7: for n:=1 to 10000 do
               begin
                 QuickSort(balon,1,zaplneni,0);
                 n:=n+1;
               end
        end;
        gettime(h2,m2,v2,s2);
        cas1:=cas2;
        cas2:=(h2*60*60*100+m2*60*100+v2*100+s2)-(h1*60*60*100+m1*60*100+v1*100+s1);
        case seznam[opakuj] of
          1: setcolor(15);
          2: setcolor(9);
          3: setcolor(10);
          4: setcolor(11);
          5: setcolor(12);
          6: setcolor(13);
          7: setcolor(14)
        end;
        line(4*zaplneni+1-4,479-(6*cas1),4*zaplneni+1,479-(6*cas2));
        zaplneni:=zaplneni+1;
      end;
    until zaplneni>=160;
  end;
end;
 
begin
  clrscr;
  writeln('SORTER - demonstrace trideni dat');
  writeln('Copyright (c) 2007 Petr Koupy');
  repeat
    begin
      writeln;
      writeln('Co chcete provest?');
      writeln('(1) Setridit vygenerovane pole');
      writeln('(2) Zobrazit graf casove slozitosti');
      write('Volba: ');
      readln(volba);
    end;
  until (volba=1) or (volba=2);
  if volba=1 then
    begin
      ukol:=true;
      writeln;
      writeln('Jaky tridici algoritmus chcete pouzit?');
      textcolor(15); writeln('(1) InsertionSort');
      textcolor(9); writeln('(2) BubbleSort');
      textcolor(10); writeln('(3) ShakerSort');
      textcolor(11); writeln('(4) SelectionSort');
      textcolor(12); writeln('(5) HeapSort');
      textcolor(13); writeln('(6) MergeSort');
      textcolor(14); writeln('(7) QuickSort');
      repeat
        begin
          textcolor(7); write('Volba: ');
          readln(volba);
        end;
      until (volba>=1) and (volba<=7);
      SetridPole(volba);
    end
  else
    begin
      ukol:=false;
      repeat
        begin
          writeln;
          writeln('Kolik algoritmu chcete propocitat (1 az 7)?');
          write('Pocet: ');
          readln(pocet);
        end;
      until (pocet>=1) and (pocet<=7);
      writeln;
      writeln('Jaky tridici algoritmus chcete zaradit do fronty?');
      textcolor(15); writeln('(1) InsertionSort');
      textcolor(9); writeln('(2) BubbleSort');
      textcolor(10); writeln('(3) ShakerSort');
      textcolor(11); writeln('(4) SelectionSort');
      textcolor(12); writeln('(5) HeapSort');
      textcolor(13); writeln('(6) MergeSort');
      textcolor(14); writeln('(7) QuickSort');
      textcolor(7);
      for k:=1 to pocet do
        begin
          repeat
            begin
              write('Volba ',k,'. mista fronty: ');
              readln(fronta[k]);
            end;
          until (fronta[k]>=1) and (fronta[k]<=7);
        end;
      SpocitejGraf(pocet,fronta);
    end;
 
  readln;
end.