home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / turbo4 / qsort.pas < prev    next >
Pascal/Delphi Source File  |  1987-12-08  |  2KB  |  68 lines

  1.  
  2. {           Copyright (c) 1985, 87 by Borland International, Inc.            }
  3.  
  4. program qsort;
  5. {$R-   Bereichs-Überprüfung aus     |                               |  }
  6. {$S-   Stack-Prüfung aus            |  Erhöhung der Geschwindigkeit |  }
  7. uses Crt;
  8.  
  9. { Eine Implementation des Quicksort-Algorithmus, der die zur Zeit
  10.   wohl effizienteste Methode zum Sortieren von Array-Elementen
  11.   (im Hauptspeicher des Computers) darstellt.
  12.   Das Programm erzeugt 1000 Zufallszahlen im Bereich von 0..29999,
  13.   speichert sie in einem Array und sortiert sie in aufsteigender
  14.   Reihenfolge.
  15. }
  16.  
  17. const
  18.   max = 1000;
  19.  
  20. type
  21.   list = array[1..max] of integer;
  22.  
  23. var
  24.   data: list;
  25.   i: integer;
  26.  
  27. { Die Prozedur QuickSort sortiert die Elemente des als A übergebenen
  28.   Arrays (Indices von LO bis HI, inklusive). QuickSort selbst stellt nur
  29.   eine Art Schnittstelle zum Programm dar - der tatsächliche Sortier-
  30.   prozeß wird von der Prozedur Sort ausgeführt, die sich selbst rekursiv
  31.   aufruft.
  32. }
  33.  
  34. procedure quicksort(var a: list; Lo,Hi: integer);
  35.  
  36. procedure sort(l,r: integer);
  37. var
  38.   i,j,x,y: integer;
  39. begin
  40.   i:=l; j:=r; x:=a[(l+r) DIV 2];
  41.   repeat
  42.     while a[i]<x do i:=i+1;
  43.     while x<a[j] do j:=j-1;
  44.     if i<=j then
  45.     begin
  46.       y:=a[i]; a[i]:=a[j]; a[j]:=y;
  47.       i:=i+1; j:=j-1;
  48.     end;
  49.   until i>j;
  50.   if l<j then sort(l,j);
  51.   if i<r then sort(i,r);
  52. end;
  53.  
  54. begin {quicksort};
  55.   sort(Lo,Hi);
  56. end;
  57.  
  58. begin { Hauptprogramm }
  59.   Write('1000 Zufallszahlen werden erzeugt...');
  60.   Randomize;
  61.   for i:=1 to max do data[i]:=Random(30000);
  62.   Writeln;
  63.   Write('Die Zufallszahlen werden sortiert....');
  64.   quicksort(data,1,max);
  65.   Write('Fertig. Weiter mit RETURN: '); Readln;
  66.   for i:=1 to 1000 do Write(data[i]:8);
  67. end.
  68.