home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1990 / 03 / kurs / sortmerg.mod < prev    next >
Encoding:
Modula Implementation  |  1990-01-10  |  3.4 KB  |  91 lines
  1. (**********************************************************)
  2. (*                   Modula-Kurs Teil 6                   *)
  3. (*             (C) Peter Viczena & toolbox 1990           *)
  4. (**********************************************************)
  5.  
  6. IMPLEMENTATION MODULE SortMerg;
  7. (* Evtl. Importe, je nach Compiler. Dann sind entspre-    *)
  8. (* chende Änderungen auch im Quelltext vorzunehmen        *)
  9. (* FROM SYSTEM  IMPORT LONG,SHORT; *)
  10. (* FROM Strings IMPORT Less,Equal,Greater; *)
  11.  
  12. PROCEDURE PointerQuickSort(VAR a: ARRAY OF Ptr; n: INTEGER;
  13.                           CompP : CProc);
  14.  
  15. CONST   M = 50;                    (* Maximale Stackgröße *)
  16.        IM = 243000;       (* Konstanten für Zufallszahlen *)
  17.        IC = 51349; IA = 4561;
  18. VAR i,j,k,L,R : INTEGER;
  19.     x,w   : Ptr;
  20.     s     : [0..M];
  21.     stack : ARRAY [1..M] OF RECORD L,R : INTEGER; END;
  22.     seed  : LONGINT;
  23.  
  24. BEGIN                                 (* PointerQuickSort *)
  25.    s := 1;
  26.    stack[1].L := 0;
  27.    stack[s].R := n-1;
  28.    seed := 0;
  29.    REPEAT                (* Nimm das oberste Stackelement *)
  30.       L := stack[s].L;
  31.       R := stack[s].R;
  32.       s := s-1;
  33.       IF ((R-L) < 8) AND ((R-L) > 0) THEN
  34.          FOR i := L TO R-1 DO
  35.             k := i;  (* Für kleine Stücke sortiere linear *)
  36.             x := a[i];
  37.             FOR j := i + 1 TO R DO
  38.                IF CompP(a[j],x) = Less THEN
  39.                   k := j;
  40.                   x := a[k];
  41.                END;         (* IF CompP(a[j],x)=Less THEN *)
  42.             END;                  (* FOR j := i+1 TO R DO *)
  43.             a[k] := a[i];
  44.             a[i] := x;
  45.          END;                     (* FOR i := L TO R-1 DO *)
  46.       ELSE
  47.          REPEAT                (* Partition a[L] ... a[R] *)
  48.             i := L;
  49.             j := R;   (* einfacher Zufallszahlengenerator *)
  50.                     (* sucht das Vergleichsglied (LUXUS!) *)
  51.             seed := (seed * IA + IC) MOD IM;
  52.             k := L + INTEGER((LONGINT(R-L+1)* seed) DIV IM);
  53.             x := a[k];
  54.                REPEAT
  55.                   WHILE CompP(a[i],x) = Less DO
  56.                      i := i+1;
  57.                   END;     (* WHILE CompP(a[i],x)=Less DO *)
  58.                   WHILE CompP(x,a[j])=Less DO
  59.                      j := j-1;
  60.                   END;     (* WHILE CompP(x,a[j])=Less DO *)
  61.                   IF i <= j THEN
  62.                      w := a[i];
  63.                      a[i] := a[j];
  64.                      a[j] := w;
  65.                      i := i+1;
  66.                      j := j-1;
  67.                   END;                    (* IF i<=j THEN *)
  68.                UNTIL i > j;
  69.  
  70.                IF (j-L) < (R-i) THEN
  71.                   IF i<R THEN (* sichere die rechte Seite *)
  72.                      s := s+1;
  73.                      stack[s].L := i;
  74.                      stack[s].R := R;
  75.                   END;                     (* IF i<R THEN *)
  76.                   R := j;     (*  mit linker Seite weiter *)
  77.               ELSE
  78.                   IF L<j THEN  (* sichere die linke Seite *)
  79.                      s := s+1;
  80.                      stack[s].L := L;
  81.                      stack[s].R := j;
  82.                   END;
  83.                   L := i; (* mit der rechten Seite weiter *)
  84.                END;              (* IF (j-L) < (R-i) THEN *)
  85.          UNTIL L >= R;
  86.       END;         (* IF ((R-L) < 8) AND ((R-L) > 0) THEN *)
  87.    UNTIL s = 0;
  88. END PointerQuickSort;
  89.  
  90. END SortMerg.
  91.