Amiga ISO Collection/AmigaUtilCD2.iso/Programming/Misc/OB3.2D2.DMS/in.adf/Module/BinaryTrees.mod

Text File | 1994-08-05 | 5.1 KB | 285 lines

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

MODULE BinaryTrees;

IMPORT BT * := BasicTypes;

TYPE

  Node * = POINTER TO NodeDesc;
  NodeDesc * = RECORD (BT.COMPAREABLEDesc)
    l * : Node;
    r * : Node;
  END;


  Root * = POINTER TO RootDesc;
  RootDesc * = RECORD (BT.COLLECTIONDesc)
    root  * : Node;
    addOk * : BOOLEAN;
    remOk * : BOOLEAN;
  END;


PROCEDURE (a: Node) Find*(root: Root): LONGINT;
(* Diese Prozedur wird von Find() verwendet.
 *  Ihr Ergebnis ist
 *    = 0, wenn a das gesuchte Element ist
 *    < 0, wenn a < dem gesuchten Element ist
 *    > 0, wenn a > dem gesuchten Element ist
 *)
BEGIN HALT(20) END Find;


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


(*------  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 roo.addOk auf FALSE gesetzt.
 *
 * require
 *   node IS Node
 *
 *)

  PROCEDURE Search(VAR n: Node);

  VAR c: LONGINT;

  BEGIN
    IF n=NIL THEN                       (* neues Element einfügen: *)
      n := node(Node);
      n.l := NIL; n.r := NIL;
      root.addOk := TRUE;
    ELSE
      c := n.Compare(node(Node));
      IF c>0 THEN
        Search(n.l);
      ELSIF c<0 THEN
        Search(n.r);
      END;
    END;
  END Search;

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


(*------  Find:  ------*)


PROCEDURE (root: Root) Find* (): Node;

(* Sucht denjenigen Knoten, für den Root.Find das Ergebnis 0 liefert und
   gibt seine Adresse oder NIL zurück. *)

VAR
  n: Node;
  c: LONGINT;

BEGIN
  n := root.root;
  LOOP
    IF n=NIL THEN RETURN NIL END;
    c := n.Find(root);
    IF    c<0 THEN n := n.r
    ELSIF c>0 THEN n := n.l
              ELSE RETURN n END;
  END;
END Find;


(*------  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
 *)

  PROCEDURE Rem(VAR n: Node);

  VAR
    c: LONGINT;
    New,Q: Node;

  BEGIN
    IF n # NIL THEN
      c := n.Compare(node(Node));
      IF    c>0 THEN Rem(n.l)
      ELSIF c<0 THEN Rem(n.r)
      ELSE
        root.remOk := TRUE;
        IF    n.r=NIL THEN n := n.l
        ELSIF n.l=NIL THEN n := n.r
        ELSE
          Q := n.l;
          WHILE Q.r#NIL DO Q := Q.r END;
          Q.r := n.r;
          n := n.l;
        END;
      END;
    END;
  END Rem;

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


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


PROCEDURE (tree: Root) nbElements * (): LONGINT;
(* returns the number of elements within tree.
 *)

  PROCEDURE CountElements(n: Node): LONGINT;
  BEGIN
    IF n=NIL THEN RETURN 0
             ELSE RETURN CountElements(n.l) + CountElements(n.r) + 1
    END;
  END CountElements;

BEGIN
  RETURN CountElements(tree.root);
END nbElements;


PROCEDURE (tree: Root) isEmpty * (): BOOLEAN;
(* TRUE if tree is empty
 *)

BEGIN
  RETURN tree.root=NIL;
END isEmpty;


PROCEDURE (tree: Root) Do         * (p: BT.DoProc; par: BT.ANY);
(* calls p(x,par) for every element x stored within tree.
 * the tree is travesed in infix order.
 * par passes some additional information to p. par is not touched by Do.
 *)

  PROCEDURE do(n: Node);

  BEGIN
    IF n#NIL THEN
      do(n.l);
      p(n,par);
      do(n.r);
    END;
  END do;

BEGIN
  do(tree.root);
END Do;


(*------  DoBackward:  ------*)


PROCEDURE (root: Root) DoBackward* (proc: BT.DoProc; par: BT.ANY);

(* calls p(x,par) for every element x stored within tree.
 * the tree is travesed in reverse order.
 * par passes some additional information to p. par is not touched by Do.
 *)

  PROCEDURE DoBkwd(n: Node);

  BEGIN
    IF n#NIL THEN
      DoBkwd(n.r);
      proc(n,par);
      DoBkwd(n.l);
    END;
  END DoBkwd;

BEGIN
  DoBkwd(root.root);
END DoBackward;


(*------  Dispose:  ------*)


PROCEDURE (root: Root) Dispose*;

(* Ruft DISPOSE() mit allen Elementen des Baumes auf, gibt also seinen
 * gesamten Speicher frei.
 *)

(* $IFNOT GarbageCollector *)

  PROCEDURE Disp(n: Node);

  BEGIN
    IF n#NIL THEN
      Disp(n.l);
      Disp(n.r);
      DISPOSE(n);
    END;
  END Disp;

(* $END *)

BEGIN

(* $IFNOT GarbageCollector *)

  Disp(root.root);

(* $ELSE *)

  root.root := NIL;

(* $END *)

END Dispose;


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


END BinaryTrees.