(*-------------------------------------------------------------------------*)
(*                                                                         *)
(*  Amiga Oberon Library Module: AVLTrees             Date: 02-Nov-92      *)
(*                                                                         *)
(*   © 1992 by Fridtjof Siebert                                            *)
(*                                                                         *)
(*-------------------------------------------------------------------------*)

MODULE AVLTrees;

IMPORT BT * := BasicTypes,
       BI * := BinaryTrees;

TYPE

  Node * = POINTER TO NodeDesc;
  NodeDesc * = RECORD (BI.NodeDesc)
    bal : INTEGER;
  END;


  Root * = POINTER TO RootDesc;
  RootDesc * = RECORD (BI.RootDesc) END;


CONST

(* Node.bal *)
  left  = -1;
  ok    = 0;
  right = 1;


TYPE
  String * = ARRAY 80 OF CHAR;

  SNode * = POINTER TO SNodeDesc;
  SNodeDesc * = RECORD (NodeDesc)
    name * : String;
  END;

  SRoot * = POINTER TO SRootDesc;
  SRootDesc * = RECORD (RootDesc)
    findstr: String;
  END;


(*-------------------------------------------------------------------------*)


(*------  Create:  ------*)


PROCEDURE Create*(): Root;
(*
 * alloziert neuen, leeren AVL-Baum
 *)

VAR
  r: Root;

BEGIN
  NEW(r); RETURN r;
END Create;


(*------  Add:  ------*)


PROCEDURE (root: Root) Add* (node: BT.ANY);

(* fügt node in den Baum ein.
 * War ein gleichnamiger Knoten bereits im Baum, wird der Baum nicht
 * verändert und root.addOk auf FALSE gesetzt.
 *
 * require
 *   node IS Node
 *
 *)

VAR
  res: BOOLEAN;
  grown: BOOLEAN;
  n1,n2: Node;

  PROCEDURE Search(VAR n: Node);

  VAR c: LONGINT;

  BEGIN
    IF n=NIL THEN                       (* neues Element einfügen: *)
      grown := TRUE;
      n := node(Node);
      n.l := NIL; n.r := NIL; n.bal := 0;
      res := TRUE;
    ELSE
      c := n.Compare(node(Node));
      IF c>0 THEN
        Search(n.l(Node));
        IF grown THEN                   (* linker Zweig gewachsen: *)
          CASE n.bal OF
          right: n.bal := ok; grown := FALSE |
          ok:    n.bal := left |
          left:  n1 := n.l(Node);             (* rebalance *)
                 IF n1.bal = left THEN  (* einfache LL Rotation *)
                   n.l := n1.r; n1.r := n; n.bal := ok; n := n1
                 ELSE                   (* doppelte LR Rotation *)
                   n2 := n1.r(Node); n1.r := n2.l; n2.l := n1; n.l := n2.r; n2.r := n;
                   IF n2.bal=left  THEN n .bal := right ELSE n .bal := ok END;
                   IF n2.bal=right THEN n1.bal := left  ELSE n1.bal := ok END;
                   n := n2;
                 END;
                 n.bal := ok; grown := FALSE |
          END;
        END;
      ELSIF c<0 THEN
        Search(n.r(Node));
        IF grown THEN                   (* rechter Zweig gewachsen: *)
          CASE n.bal OF
          left:  n.bal := ok; grown := FALSE |
          ok:    n.bal := right |
          right: n1 := n.r(Node);             (* rebalance *)
                 IF n1.bal = right THEN (* einfache RR Rotation *)
                   n.r := n1.l; n1.l := n; n.bal := ok; n := n1
                 ELSE                   (* doppelte RL Rotation *)
                   n2 := n1.l(Node); n1.l := n2.r; n2.r := n1;
                   n.r  := n2.l; n2.l := n;
                   IF n2.bal = right THEN n .bal := left  ELSE n .bal := ok END;
                   IF n2.bal = left  THEN n1.bal := right ELSE n1.bal := ok END;
                   n := n2;
                 END;
                 n.bal := ok; grown := FALSE |
          END;
        END;
      ELSE
        grown := FALSE;
        res := FALSE;
      END;
    END;
  END Search;

BEGIN
  Search(root.root(Node));
  root.addOk := res;
END Add;


(*------  Remove:  ------*)


PROCEDURE (root: Root) Remove* (node: BT.ANY);

(* Entfernt node aus dem Baum. 
 * War node nicht im Baum, wird der Baum nicht verändert und roo.remOk auf FALSE 
 * gesetzt.
 *
 * require
 *   node IS Node
 *)

VAR
  h: BOOLEAN;
  deleted: BOOLEAN;


  PROCEDURE BalL(VAR n: Node);
  VAR n1, n2 : Node;
      b1, b2 : INTEGER;
  BEGIN
    CASE n.bal OF
    left:  n.bal := ok |
    ok:    n.bal := right; h := FALSE |
    right: n1 := n.r(Node); b1 := n1.bal;     (* rebalance *)
           IF b1 # left THEN            (* single RR rotation *)
             n.r := n1.l; n1.l := n;
             IF b1 = ok THEN n.bal := right; n1.bal := left; h := FALSE
                        ELSE n.bal := ok;    n1.bal := ok;               END;
             n := n1;
           ELSE                         (* double RL rotation *)
             n2 := n1.l(Node); b2 := n2.bal;
             n1.l := n2.r; n2.r := n1;
             n .r := n2.l; n2.l := n;
             IF b2 = right THEN n .bal := left  ELSE n .bal := ok END;
             IF b2 = left  THEN n1.bal := right ELSE n1.bal := ok END;
             n := n2; n2.bal := ok;
           END |
    END;
  END BalL;

  PROCEDURE BalR(VAR n: Node);
  VAR n1, n2 : Node;
      b1, b2 : INTEGER;
  BEGIN
    CASE n.bal OF
    right: n.bal :=  ok |
    ok:    n.bal := left; h := FALSE |
    left:  n1 := n.l(Node); b1 := n1.bal;     (* rebalance *)
           IF b1 # right THEN           (* single LL rotation *)
             n.l := n1.r; n1.r := n;
             IF b1 = ok THEN n.bal := left; n1.bal := right; h := FALSE
                        ELSE n.bal := ok;   n1.bal := ok;               END;
             n := n1;
           ELSE                         (* double LR rotation *)
             n2 := n1.r(Node); b2 := n2.bal;
             n1.r := n2.l; n2.l := n1;
             n .l := n2.r; n2.r := n;
             IF b2 = left  THEN n .bal := right ELSE n .bal := ok END;
             IF b2 = right THEN n1.bal := left  ELSE n1.bal := ok END;
             n := n2; n2.bal := ok;
           END |
    END;
  END BalR;

  PROCEDURE Rem(VAR n: Node);

  VAR
    c: LONGINT;
    New,Q: Node;

    PROCEDURE del(VAR m: Node);
    BEGIN
      IF m.r#NIL THEN
        del(m.r(Node)); IF h THEN BalR(m) END
      ELSE
        New := m;
        m := m.l(Node);
        h := TRUE;
      END;
    END del;

  BEGIN
    IF n # NIL THEN
      c := n.Compare(node(Node));
      IF    c>0 THEN Rem(n.l(Node)); IF h THEN BalL(n) END
      ELSIF c<0 THEN Rem(n.r(Node)); IF h THEN BalR(n) END
      ELSE
        deleted := TRUE;
        IF    n.r=NIL THEN n := n.l(Node); h := TRUE
        ELSIF n.l=NIL THEN n := n.r(Node); h := TRUE
        ELSE
          Q := n;
          del(n.l(Node));
          n := New;
          n.l := Q.l;
          n.r := Q.r;
          n.bal := Q.bal;
          IF h THEN BalL(n) END
        END;
      END;
    END;
  END Rem;

BEGIN
  h := FALSE; deleted := FALSE; Rem(root.root(Node)); root.remOk := deleted;
END Remove;


(*-------------------------------------------------------------------------*)


PROCEDURE (a: SNode) Compare*(b: BT.COMPAREABLE): LONGINT;

BEGIN
  WITH b: SNode DO
    IF    a.name>b.name THEN RETURN  1
    ELSIF a.name<b.name THEN RETURN -1
                        ELSE RETURN  0 END;
  END;
END Compare;


PROCEDURE (a: SNode) Find*(root: BI.Root): LONGINT;

BEGIN
  WITH root: SRoot DO
    IF    a.name>root.findstr THEN RETURN  1
    ELSIF a.name<root.findstr THEN RETURN -1
                              ELSE RETURN  0 END;
  END;
END Find;


(*-------------------------------------------------------------------------*)


(*------  SCreate:  ------*)


PROCEDURE SCreate*(): SRoot;
(*
 * alloziert neuen, leeren String-AVL-Baum
 *)

VAR
  r: SRoot;

BEGIN
  NEW(r); RETURN r;
END SCreate;


(*------  SFind:  ------*)


PROCEDURE (root: SRoot) SFind*(str: String): SNode;

(* Sucht den Knoten mit dem Namen str und gibt seine Adresse oder NIL
   bei Mißerfolg zurück. *)

VAR n: BI.Node;

BEGIN
  root.findstr := str;
  n := root.Find();
  RETURN n(SNode);
END SFind;


(*-------------------------------------------------------------------------

  Bei String-AVL-Bäumen können die Prozeduren Remove, DoForward, DoBackward
  und Dispose von oben verwendent werden. Sie sind deshalb nicht noch
  einmal Implementiert.

-------------------------------------------------------------------------*)

END AVLTrees.