home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / AVLTrees.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  8.0 KB  |  334 lines
  1. (*-------------------------------------------------------------------------*)
  2. (*                                                                         *)
  3. (*  Amiga Oberon Library Module: AVLTrees             Date: 02-Nov-92      *)
  4. (*                                                                         *)
  5. (*   © 1992 by Fridtjof Siebert                                            *)
  6. (*                                                                         *)
  7. (*-------------------------------------------------------------------------*)
  8.  
  9. MODULE AVLTrees;
  10.  
  11. IMPORT BT * := BasicTypes,
  12.        BI * := BinaryTrees;
  13.  
  14. TYPE
  15.  
  16.   Node * = POINTER TO NodeDesc;
  17.   NodeDesc * = RECORD (BI.NodeDesc)
  18.     bal : INTEGER;
  19.   END;
  20.  
  21.  
  22.   Root * = POINTER TO RootDesc;
  23.   RootDesc * = RECORD (BI.RootDesc) END;
  24.  
  25.  
  26. CONST
  27.  
  28. (* Node.bal *)
  29.   left  = -1;
  30.   ok    = 0;
  31.   right = 1;
  32.  
  33.  
  34. TYPE
  35.   String * = ARRAY 80 OF CHAR;
  36.  
  37.   SNode * = POINTER TO SNodeDesc;
  38.   SNodeDesc * = RECORD (NodeDesc)
  39.     name * : String;
  40.   END;
  41.  
  42.   SRoot * = POINTER TO SRootDesc;
  43.   SRootDesc * = RECORD (RootDesc)
  44.     findstr: String;
  45.   END;
  46.  
  47.  
  48. (*-------------------------------------------------------------------------*)
  49.  
  50.  
  51. (*------  Create:  ------*)
  52.  
  53.  
  54. PROCEDURE Create*(): Root;
  55. (*
  56.  * alloziert neuen, leeren AVL-Baum
  57.  *)
  58.  
  59. VAR
  60.   r: Root;
  61.  
  62. BEGIN
  63.   NEW(r); RETURN r;
  64. END Create;
  65.  
  66.  
  67. (*------  Add:  ------*)
  68.  
  69.  
  70. PROCEDURE (root: Root) Add* (node: BT.ANY);
  71.  
  72. (* fügt node in den Baum ein.
  73.  * War ein gleichnamiger Knoten bereits im Baum, wird der Baum nicht
  74.  * verändert und root.addOk auf FALSE gesetzt.
  75.  *
  76.  * require
  77.  *   node IS Node
  78.  *
  79.  *)
  80.  
  81. VAR
  82.   res: BOOLEAN;
  83.   grown: BOOLEAN;
  84.   n1,n2: Node;
  85.  
  86.   PROCEDURE Search(VAR n: Node);
  87.  
  88.   VAR c: LONGINT;
  89.  
  90.   BEGIN
  91.     IF n=NIL THEN                       (* neues Element einfügen: *)
  92.       grown := TRUE;
  93.       n := node(Node);
  94.       n.l := NIL; n.r := NIL; n.bal := 0;
  95.       res := TRUE;
  96.     ELSE
  97.       c := n.Compare(node(Node));
  98.       IF c>0 THEN
  99.         Search(n.l(Node));
  100.         IF grown THEN                   (* linker Zweig gewachsen: *)
  101.           CASE n.bal OF
  102.           right: n.bal := ok; grown := FALSE |
  103.           ok:    n.bal := left |
  104.           left:  n1 := n.l(Node);             (* rebalance *)
  105.                  IF n1.bal = left THEN  (* einfache LL Rotation *)
  106.                    n.l := n1.r; n1.r := n; n.bal := ok; n := n1
  107.                  ELSE                   (* doppelte LR Rotation *)
  108.                    n2 := n1.r(Node); n1.r := n2.l; n2.l := n1; n.l := n2.r; n2.r := n;
  109.                    IF n2.bal=left  THEN n .bal := right ELSE n .bal := ok END;
  110.                    IF n2.bal=right THEN n1.bal := left  ELSE n1.bal := ok END;
  111.                    n := n2;
  112.                  END;
  113.                  n.bal := ok; grown := FALSE |
  114.           END;
  115.         END;
  116.       ELSIF c<0 THEN
  117.         Search(n.r(Node));
  118.         IF grown THEN                   (* rechter Zweig gewachsen: *)
  119.           CASE n.bal OF
  120.           left:  n.bal := ok; grown := FALSE |
  121.           ok:    n.bal := right |
  122.           right: n1 := n.r(Node);             (* rebalance *)
  123.                  IF n1.bal = right THEN (* einfache RR Rotation *)
  124.                    n.r := n1.l; n1.l := n; n.bal := ok; n := n1
  125.                  ELSE                   (* doppelte RL Rotation *)
  126.                    n2 := n1.l(Node); n1.l := n2.r; n2.r := n1;
  127.                    n.r  := n2.l; n2.l := n;
  128.                    IF n2.bal = right THEN n .bal := left  ELSE n .bal := ok END;
  129.                    IF n2.bal = left  THEN n1.bal := right ELSE n1.bal := ok END;
  130.                    n := n2;
  131.                  END;
  132.                  n.bal := ok; grown := FALSE |
  133.           END;
  134.         END;
  135.       ELSE
  136.         grown := FALSE;
  137.         res := FALSE;
  138.       END;
  139.     END;
  140.   END Search;
  141.  
  142. BEGIN
  143.   Search(root.root(Node));
  144.   root.addOk := res;
  145. END Add;
  146.  
  147.  
  148. (*------  Remove:  ------*)
  149.  
  150.  
  151. PROCEDURE (root: Root) Remove* (node: BT.ANY);
  152.  
  153. (* Entfernt node aus dem Baum. 
  154.  * War node nicht im Baum, wird der Baum nicht verändert und roo.remOk auf FALSE 
  155.  * gesetzt.
  156.  *
  157.  * require
  158.  *   node IS Node
  159.  *)
  160.  
  161. VAR
  162.   h: BOOLEAN;
  163.   deleted: BOOLEAN;
  164.  
  165.  
  166.   PROCEDURE BalL(VAR n: Node);
  167.   VAR n1, n2 : Node;
  168.       b1, b2 : INTEGER;
  169.   BEGIN
  170.     CASE n.bal OF
  171.     left:  n.bal := ok |
  172.     ok:    n.bal := right; h := FALSE |
  173.     right: n1 := n.r(Node); b1 := n1.bal;     (* rebalance *)
  174.            IF b1 # left THEN            (* single RR rotation *)
  175.              n.r := n1.l; n1.l := n;
  176.              IF b1 = ok THEN n.bal := right; n1.bal := left; h := FALSE
  177.                         ELSE n.bal := ok;    n1.bal := ok;               END;
  178.              n := n1;
  179.            ELSE                         (* double RL rotation *)
  180.              n2 := n1.l(Node); b2 := n2.bal;
  181.              n1.l := n2.r; n2.r := n1;
  182.              n .r := n2.l; n2.l := n;
  183.              IF b2 = right THEN n .bal := left  ELSE n .bal := ok END;
  184.              IF b2 = left  THEN n1.bal := right ELSE n1.bal := ok END;
  185.              n := n2; n2.bal := ok;
  186.            END |
  187.     END;
  188.   END BalL;
  189.  
  190.   PROCEDURE BalR(VAR n: Node);
  191.   VAR n1, n2 : Node;
  192.       b1, b2 : INTEGER;
  193.   BEGIN
  194.     CASE n.bal OF
  195.     right: n.bal :=  ok |
  196.     ok:    n.bal := left; h := FALSE |
  197.     left:  n1 := n.l(Node); b1 := n1.bal;     (* rebalance *)
  198.            IF b1 # right THEN           (* single LL rotation *)
  199.              n.l := n1.r; n1.r := n;
  200.              IF b1 = ok THEN n.bal := left; n1.bal := right; h := FALSE
  201.                         ELSE n.bal := ok;   n1.bal := ok;               END;
  202.              n := n1;
  203.            ELSE                         (* double LR rotation *)
  204.              n2 := n1.r(Node); b2 := n2.bal;
  205.              n1.r := n2.l; n2.l := n1;
  206.              n .l := n2.r; n2.r := n;
  207.              IF b2 = left  THEN n .bal := right ELSE n .bal := ok END;
  208.              IF b2 = right THEN n1.bal := left  ELSE n1.bal := ok END;
  209.              n := n2; n2.bal := ok;
  210.            END |
  211.     END;
  212.   END BalR;
  213.  
  214.   PROCEDURE Rem(VAR n: Node);
  215.  
  216.   VAR
  217.     c: LONGINT;
  218.     New,Q: Node;
  219.  
  220.     PROCEDURE del(VAR m: Node);
  221.     BEGIN
  222.       IF m.r#NIL THEN
  223.         del(m.r(Node)); IF h THEN BalR(m) END
  224.       ELSE
  225.         New := m;
  226.         m := m.l(Node);
  227.         h := TRUE;
  228.       END;
  229.     END del;
  230.  
  231.   BEGIN
  232.     IF n # NIL THEN
  233.       c := n.Compare(node(Node));
  234.       IF    c>0 THEN Rem(n.l(Node)); IF h THEN BalL(n) END
  235.       ELSIF c<0 THEN Rem(n.r(Node)); IF h THEN BalR(n) END
  236.       ELSE
  237.         deleted := TRUE;
  238.         IF    n.r=NIL THEN n := n.l(Node); h := TRUE
  239.         ELSIF n.l=NIL THEN n := n.r(Node); h := TRUE
  240.         ELSE
  241.           Q := n;
  242.           del(n.l(Node));
  243.           n := New;
  244.           n.l := Q.l;
  245.           n.r := Q.r;
  246.           n.bal := Q.bal;
  247.           IF h THEN BalL(n) END
  248.         END;
  249.       END;
  250.     END;
  251.   END Rem;
  252.  
  253. BEGIN
  254.   h := FALSE; deleted := FALSE; Rem(root.root(Node)); root.remOk := deleted;
  255. END Remove;
  256.  
  257.  
  258. (*-------------------------------------------------------------------------*)
  259.  
  260.  
  261. PROCEDURE (a: SNode) Compare*(b: BT.COMPAREABLE): LONGINT;
  262.  
  263. BEGIN
  264.   WITH b: SNode DO
  265.     IF    a.name>b.name THEN RETURN  1
  266.     ELSIF a.name<b.name THEN RETURN -1
  267.                         ELSE RETURN  0 END;
  268.   END;
  269. END Compare;
  270.  
  271.  
  272. PROCEDURE (a: SNode) Find*(root: BI.Root): LONGINT;
  273.  
  274. BEGIN
  275.   WITH root: SRoot DO
  276.     IF    a.name>root.findstr THEN RETURN  1
  277.     ELSIF a.name<root.findstr THEN RETURN -1
  278.                               ELSE RETURN  0 END;
  279.   END;
  280. END Find;
  281.  
  282.  
  283. (*-------------------------------------------------------------------------*)
  284.  
  285.  
  286. (*------  SCreate:  ------*)
  287.  
  288.  
  289. PROCEDURE SCreate*(): SRoot;
  290. (*
  291.  * alloziert neuen, leeren String-AVL-Baum
  292.  *)
  293.  
  294. VAR
  295.   r: SRoot;
  296.  
  297. BEGIN
  298.   NEW(r); RETURN r;
  299. END SCreate;
  300.  
  301.  
  302. (*------  SFind:  ------*)
  303.  
  304.  
  305. PROCEDURE (root: SRoot) SFind*(str: String): SNode;
  306.  
  307. (* Sucht den Knoten mit dem Namen str und gibt seine Adresse oder NIL
  308.    bei Mißerfolg zurück. *)
  309.  
  310. VAR n: BI.Node;
  311.  
  312. BEGIN
  313.   root.findstr := str;
  314.   n := root.Find();
  315.   RETURN n(SNode);
  316. END SFind;
  317.  
  318.  
  319. (*-------------------------------------------------------------------------
  320.  
  321.   Bei String-AVL-Bäumen können die Prozeduren Remove, DoForward, DoBackward
  322.   und Dispose von oben verwendent werden. Sie sind deshalb nicht noch
  323.   einmal Implementiert.
  324.  
  325. -------------------------------------------------------------------------*)
  326.  
  327. END AVLTrees.
  328.  
  329.  
  330.  
  331.  
  332.  
  333.  
  334.