(*************************************************************************

:Program.    QSort (QuickSort-Algorithmus)
:Author.     Philippe Gressly (PHILU), hartmut Goebel [hG]
:Address.    Näfenhaus, CH-8926 Kappel a/Albis
:History     V0.99 (1.8.91)
:History     V0.99o 27 Sep 1991 [hG] ported to Oberon, LONGINT -> INTEGER
:Copyright.  PD
:Language.   Oberon
:Translator. Amiga Oberon 2.00
:Contents.   Die Prozedur (QSort) zum sortieren von Arrays.

*************************************************************************)

MODULE QSort;

TYPE
  CompProc * = PROCEDURE(a,b: LONGINT): LONGINT;

  (*
   * CompProc is used to compare two nodes. Its result should be:
   * < 0, if a < b
   * > 0, if a > b
   * = 0, if both nodes are equal
   *)

TYPE
 SwapProc * = PROCEDURE(a,b: LONGINT);

 (* Die Prozedur soll das Element an der Stelle Nr1 mit dem
  * Element an der Stelle Nr2 vertauschen.
  *
  * Beispiel:
  *  t := Array[Nr1];
  *  Array[Nr1] := Array[Nr2];
  *  Array[Nr2] := t;
  *
  * Auch diese Prozedur muß selber geschrieben werden.
  *)


(*************************************************************************

Name    : QSort
Input   : start, end: LONGINT; (* Woher bis wohin im Array soll
                                * sortiert werden.
                                *)
          ACHTUNG: ist <start> größer oder gleich <end>, do wird das Array
                   von nicht sortiert.

          gt: CompProc; (* Prozedur, die die Elemente vergleicht *)
          swp: SwapPrc; (* Prozedur, die die Elemente vertauscht *)

*************************************************************************)

PROCEDURE QSort*(start, end: LONGINT; gt: CompProc; swp: SwapProc);
VAR
  i, j: LONGINT;
BEGIN

  IF start >= end THEN RETURN END;

  (* Partitionierung *)
  i := start + 1; j := end;
  REPEAT
    WHILE ~(gt(i,start)>0) AND (i < end      ) DO INC(i) END;
    WHILE  (gt(j,start)>0) AND (j > start + 1) DO DEC(j) END;
    IF (i < j) THEN
       swp(i,j); INC(i); DEC(j)
    END;
  UNTIL j <= i;
  IF (i = j) AND ~(gt(i,start)>0) THEN
    INC(i) END;
  IF i > end THEN
    swp(start, end);
    i := end;
  END;
  (* Ende der Partitionierugn *)

  IF start < i-1 THEN
    QSort(start, i-1, gt, swp) END;
  IF i     < end THEN
    QSort(    i, end, gt, swp) END;
END QSort;

END QSort.