home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1989 / 02 / colleg / sortiere.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1988-10-30  |  4.1 KB  |  115 lines
  1. (* ------------------------------------------------------ *)
  2. (*                    SORTIERE.PAS                        *)
  3. (*    Demonstration zur Funktionsweise des Quick-Sort     *)
  4. (*        Sortiert wird ein Array mit REAL-Werten         *)
  5. (*            (c) 1988 W.J.Weber und TOOLBOX              *)
  6. (* ------------------------------------------------------ *)
  7. PROGRAM Sortiere(Input,Output);
  8.  
  9. CONST Max = 90;           (* bei eigenen Tests vergrößern!*)
  10. TYPE  Realarray    = ARRAY[1..Max] OF REAL;
  11. VAR   Sortierarray : Realarray;
  12.  
  13. PROCEDURE Fuelle(VAR Wert : Realarray);
  14. VAR i : 1..Max;
  15. BEGIN               (* Setze zufällige Werte in das Array *)
  16.   FOR i := 1 TO Max DO
  17.     Wert[i] := Random * 100
  18.                     (* Zufällige Werte zwischen 0 und 100 *)
  19.                     (* Die Random-Funktion gehört nicht   *)
  20.                     (* zum Sprachumfang von Standard-     *)
  21.                     (* Pascal, wird aber z.B. in          *)
  22.                     (* Turbo-Pascal geboten.              *)
  23. END;
  24.  
  25. PROCEDURE Zeige(Wert : Realarray);
  26. VAR i : 1..Max;
  27. BEGIN
  28.   WriteLn;
  29.   FOR i := 1 TO Max DO BEGIN
  30.     Write(Wert[i]:5:1);
  31.     IF i MOD 15 = 0 THEN
  32.       WriteLn;            (* neue Zeile nach je 15 Werten *)
  33.     END;
  34.   WriteLn; WriteLn;       (* Abstand zwei Leerzeilen      *)
  35. END;
  36.  
  37. FUNCTION Geordnet(Wert : Realarray) : BOOLEAN;
  38. VAR i : 1..Max;  Fehler : BOOLEAN;
  39. BEGIN
  40.   Fehler := FALSE;
  41.   FOR i := 2 TO Max DO BEGIN
  42.     IF Wert[i-1]>Wert[i] THEN BEGIN
  43.       Write('Fehlerhafte Ordnung an Stelle ',i);
  44.       Fehler := TRUE;
  45.     END;
  46.   END;
  47.   Geordnet := NOT Fehler
  48. END;
  49.  
  50. PROCEDURE Quicksort(VAR Wert : Realarray;
  51.                         Element1, ElementN : INTEGER);
  52.  
  53.   (* ---------------------------------------------------- *)
  54.   (* Hauptstück des gesamten Programms: Der Inhalt des    *)
  55.   (* Array Wert wird nach dem Quicksort-Verfahren sortiert*)
  56.   (* Diese Prozedur wird mehrfach durch sich selbst auf-  *)
  57.   (* gerufen (Rekursion). Wert: Die zu sortierende Werte; *)
  58.   (* Element1: Erstes  Element d.Liste;                   *)
  59.   (* ElementN: Letztes Element d.Liste                    *)
  60.   (* ---------------------------------------------------- *)
  61.  
  62. VAR links, rechts, Grenze : 1..Max;
  63.  
  64.   PROCEDURE Tausche(VAR x, y : REAL);
  65.     (* Vertauschen der Werte x und y                      *)
  66.     (* Diese Prozedur ist lokales Objekt von Quicksort    *)
  67.     VAR Hilf : REAL;
  68.   BEGIN
  69.     Hilf := x; x := y; y := Hilf;
  70.   END;
  71.  
  72. BEGIN            (* Anweisungsteil der Prozedur QuickSort *)
  73. IF Element1 < ElementN THEN BEGIN
  74.                  (* Sortierfeld enthält mehrere Elemente  *)
  75.   links := Element1; rechts := ElementN;
  76.   Grenze:= (Element1+ElementN) DIV 2;
  77.     (* Zerlege das Array in zwei Teillisten durch im      *)
  78.     (* Prinzip willkürliche Wahl des Grenzschlüssels      *)
  79.     (* (hier Array-Element mit mittlerem Index)           *)
  80.   REPEAT
  81.     WHILE (Wert[links]<=Wert[Grenze])AND(links<ElementN) DO
  82.       links := succ(links);
  83.         (* suche falsch plazierten Wert im linken Teil *)
  84.     WHILE (Wert[rechts]>=Wert[Grenze])AND(rechts>Element1) DO
  85.       rechts := pred(rechts);
  86.         (* suche falsch plazierten Wert im rechten Teil *)
  87.     IF (links < rechts) THEN
  88.       Tausche(Wert[links], Wert[rechts])
  89.     ELSE IF links < Grenze THEN
  90.       Tausche(Wert[links], Wert[Grenze])
  91.       ELSE IF rechts>Grenze THEN
  92.         Tausche(Wert[rechts], Wert[Grenze])
  93.   UNTIL links >= rechts;
  94.   IF Element1 < rechts THEN
  95.   (* Sortiere rekursiv die Liste mit den kleineren Werten *)
  96.     Quicksort(Wert, Element1, rechts);
  97.   IF links < ElementN THEN
  98.   (* Sortiere rekursiv die Liste mit den größeren Werten *)
  99.     Quicksort(Wert, links, ElementN)
  100.   END;
  101. END;
  102.  
  103. BEGIN                                    (* Hauptprogramm *)
  104.   Fuelle(Sortierarray);
  105.   WriteLn('Ausgangsdaten:');
  106.   Zeige(Sortierarray);
  107.   Quicksort(Sortierarray,1,Max);
  108.   WriteLn('Daten nach Quicksort:');
  109.   Zeige(Sortierarray);
  110.   IF Geordnet(Sortierarray) THEN
  111.     WriteLn('ARRAY ist aufsteigend sortiert!')
  112. END.
  113. (* ------------------------------------------------------ *)
  114. (*                Ende von SORTIERE.PAS                   *)
  115.