{ Sort - DEMO fuer Datenstrukturen Vorlesung, SS03-Benn  }
{ Autor: Dipl.-Ing. Thomas Speiser                       }
{ Source from: http://Codes.TurboTools.de                }
{ Dank an Antje :-)                                      }

{ BubbleSort, MergeSort, QuickSort, HeapSort, ShellSort, }
{ ShakerSort, mit Schleifenanalyse und Auswertung        }

program sort_demo;
uses Crt;
const n = 20;

type feld = array[1..n] of shortint;
var  zahl,tmp: feld;
     d1,d2,d3,d4: integer;       { Anzahl der Durchlaeufe }
     i: shortint;

procedure insertsort(var zahl: feld);
var i,j: integer;
    t : shortint;
begin
for i := 2 to n do
 begin
  inc(d1);
  t := zahl[i]; j:=i; zahl[1] := t;
  while zahl[j-1] > t do
  begin
    inc(d2);
    zahl[j]:=zahl[j-1];
    dec(j);
  end;
  zahl[j] := t;
 end;
end;

{ Tauschen der Nachbaren }
procedure bubblesort(var zahl: feld);
var i,j: integer;

procedure tausche(var i,i2: shortint);
var tmp: shortint;
begin
 tmp:=i;
 i:=i2;
 i2:=tmp;
end;

begin
 for j:=2 to n do
  begin inc(d1);
  for i:= 10 downto j do begin inc(d2);
    if zahl[i] < zahl[i-1] then
    tausche(zahl[i],zahl[i-1]); end;
  end;
end;

{ Sortieren durch Mischen }
procedure mergesort(var a: feld; start,ende: shortint);
var mitte, i, j, k: shortint;
    b: feld; { Hilfsfeld zum mischen }
begin
 if start < ende then begin
 { Rekursiv Feld teilen }
            mitte:= (start+ende) div 2;
            mergesort(a,start,mitte);
            mergesort(a,mitte+1,ende);
    for j:=mitte downto start do begin inc(d1); b[j]:=zahl[j]; end;
    for k:=mitte+1 to ende    do begin inc(d2); b[ende+mitte+1-k]:=zahl[k]; end;
    for mitte:=start to ende  do begin inc(d3);
      if b[j] < b[k] then
        begin
	  zahl[mitte]:=b[j]; inc(j)
	end
	else
	  begin
	    zahl[mitte]:=b[k]; dec(k);
	  end;
     end;
    end;
end;

{ Sortieren durch Austauschen mit Aenderung der Richtung
  aufeinanderzahlnder Durchlaeufe }
procedure shakersort(var zahl: feld);
var j,k,l,r,i:byte;
begin
l:=2; r:=n; k:=n;
repeat
  for j:=r downto l do begin inc(d1);
  if zahl[j-1] > zahl[j] then begin
   i:=zahl[j-1];
   zahl[j-1]:=zahl[j];
	      zahl[j]:=i;
	      k:=j;
	    end; end;
	  l:=k+1;
	  for j:=l to r do begin inc(d2);
	    if zahl[j-1] > zahl[j] then
	    begin
	      i:=zahl[j-1];
	      zahl[j-1]:=zahl[j];
	      zahl[j]:=i;
	      k:=j;
	    end; end;
	  r:=k-1; inc(d3);
  until l > r;
end;

{ Sortieren durch Einfuegen mit abnehmenden Schrittweiten }
procedure shellsort(var zahl: feld);
const t = 4;
var r,j,k,s: integer;
    i:       byte;
    m: 1..t;
    schritt: array [1..t] of byte;

begin
  schritt[1]:=9; schritt[2]:=5; schritt[3]:=3; schritt[4]:=1;
    for m:=1 to t do
    begin
      k:=schritt[m]; s:=-k;
      for r:=k+1 to n do
      begin
        i:=zahl[r]; j:=r-k;
        if s=0 then s:=-k;
	s:=s+1; zahl[s]:=i;
	while i < zahl[j] do
	begin
	 zahl[j+k]:=zahl[j]; j:=j-k;
	end;
        zahl[j+k]:=i;
     end
   end
end;

{ Sortieren mittels Baum }
procedure heapsort(var zahl: feld);
  var r, l, i: byte;

  procedure sift;   { Sickern des Elementes }
    var j, k:byte;
    begin
      j:=l; k:=2*j; i:=zahl[j];
      while k < = r do
        begin
          inc(d2);
          if k < = r then
	    if ( zahl[k] < zahl[k+1]) and (k < r) then k:=k+1;
          if i >= zahl[k] then k:=n+1
	  else
	  begin
          inc(d4);
	  zahl[j]:=zahl[k]; j:=k; k:=2*j
	  end
        end;
      zahl[j]:=i;
    end;

begin { heapsort }
  r:=n; l:=(n div 2)+1;
  while l>1 do
    begin
      inc(d1);
      l:=l-1; sift
    end;
  while r>1 do
    begin
      inc(d3);
      i:=zahl[l];
      zahl[l]:=zahl[r];
      zahl[r]:=i;
      r:=r-1;
      sift
    end;
end;

{   Quicksort-Algorithmus

Falls Anzahl der Elemente in a kleiner 2, bleibt a
unveraendert; sonst:

Divide:

Waehle ein Element k aus a aus und teile a ohne k in
Teilfolgen a1 und a2 bezueglich k:

     a1 enthaelt nur Elemente von a (ohne k), die < = k sind,
     a2 enthaelt nur Elemente von a (ohne k), die > = k sind;

Conquer:

Quicksort(a1), Quicksort(a 2);
QUELLE: Ottmann / Widmayer: Algorithmen und Datenstrukturen, Spektrum 2002

Divide and Conquer im Quicksort
 l                      r
 55 80 12 92 58 "24" 17 28
       l                r
 55 80 12 92 58 "24" 17 28
          l          r
 55 80 28 92 58 "24" 17 12
             l       r
 55 80 28 92 58 "24" 17 12
                 lr
 55 80 28 92 17 "24" 58 12
             r       l
 55 80 28 92 17 "24" 58 12

Quicksort(...) Quicksort(...)


{ Sortieren mittels Partition des Feldes }
procedure quicksort(var zahl: feld);

  procedure sort(l,r: byte);
    var j,k,vglzahl,platzhalter:byte;
    begin
      j:=l; k:=r; vglzahl:=zahl[(j+k) div 2];
	    repeat
        while zahl[j] < vglzahl do j:=j+1;
        while vglzahl < zahl[k] do k:=k-1;
        if j < = k then
          begin
            platzhalter:=zahl[j];
            zahl[j]:=zahl[k];
            zahl[k]:=platzhalter;
            j:=j+1;
            k:=k-1;
          end;
      until j > k;
      if l < k then sort(l,k);
      if j < r then sort(j,r);
    end;
  begin { quicksort }
  sort (1,n)
  end;

procedure reset;
begin
 d1:=0;
 d2:=0;
 d3:=0;
 d4:=0;
 for i:=1 to n do zahl[i]:=tmp[i];
end;

procedure show;
begin
 for i:=1 to n do write(zahl[i],' ');
 writeLN;
 writeLN('Durchlaeufe D1: ',d1,' D2: ',d2,' D3: ',d3,' D4: ',d4);
end;

begin
TextMode(CO80 xor Lo(LastMode)+Font8x8 xor LASTMODE);
randomize;
reset;
ClrScr;
writeLN('S O R T - D E M O ! ! !');
writeLN;
writeLN('ZUFAELLIGE LISTE:');
for i:=1 to n do begin zahl[i]:=random(9)+1; write(zahl[i],' '); tmp[i]:=zahl[i]; end;
writeLN;

writeLN;
writeLN('INSERTSORT: O(nē)');
insertsort(zahl);
show;
writeLN('D1*D2) = ',d1*d2);
reset;

writeLN;
writeLN('BUBBLESORT: O(nē)');
bubblesort(zahl);
show;
writeLN('D1*D2 = ',d1*d2);
reset;

writeLN;
writeLN('SHAKERSORT: O(nē)');
shakersort(zahl);
show;
writeLN('D1*(D2+D3) = ',d1*(d2+d3));
reset;

{
writeLN;
writeLN('SHELLSORT: O(nē)');
shellsort(zahl);
show;
reset;
}
writeLN;
writeLN('HEAPSORT: O(n * log n)');
heapsort(zahl);
show;
writeLN('(D1*D2)+(D3*D4) = ',(d1*d2)+(d3*d4));
reset;

writeLN;
writeLN('MERGESORT: O(n * log n)');
mergesort(zahl);
show;
writeLN('D1+D2+D3 = ',d1+d2+d3);
reset;

writeLN;
writeLN('QUICKSORT: O(n * log n)');
quicksort(zahl);
show;
reset;

readLN;
end.