home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / modula2 / baltree.mod < prev    next >
Encoding:
Text File  |  1987-01-08  |  7.5 KB  |  239 lines
  1. (* Insertion and deletion in an AVL-balanced tree.  In the
  2.    previous program (tree), the binary tree may grow in all sorts
  3.    of shapes -- if the inserted keys are ordered upon arrival,
  4.    the "tree" even degenerates into a linear list.  In the
  5.    following program, a balance is maintained, such that at
  6.    each node the heights of its two subtree differ by at most 1. *)
  7.  
  8. MODULE BalTree;
  9. FROM InOut IMPORT WriteString,WriteInt,WriteLn,ReadInt;
  10. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  11.  
  12.  
  13. TYPE  ref = POINTER  TO word;
  14.       word = RECORD 
  15.                key         : INTEGER;
  16.                count       : INTEGER; 
  17.                left ,right : ref;
  18.                bal         : [-1..1]
  19.              END;
  20. VAR root : ref;
  21.     h    : BOOLEAN;
  22.     k    : INTEGER;
  23.  
  24.  
  25. (******************************************************)
  26. PROCEDURE printree(w: ref; l: INTEGER);
  27.   VAR  i : INTEGER;
  28. BEGIN
  29.   IF w <> NIL THEN 
  30.      WITH w^ DO
  31.          printree(left, l+1);
  32.          FOR i := 1 TO l DO WriteString("    ") END;
  33.          WriteInt(key,5); WriteInt(bal,5);WriteLn;
  34.          printree(right,l+1);
  35.      END;(*with*);
  36.    END; (*if*)                  
  37. END printree;
  38.  
  39. (******************************************************)
  40.  
  41. PROCEDURE search(x: INTEGER; VAR p:ref; VAR h: BOOLEAN);
  42.   VAR  p1,p2: ref;                           (* h = FALSE*)
  43. BEGIN
  44.   IF p = NIL THEN                            (* word is not in tree; insert it *)
  45.     NEW(p); h:= TRUE;
  46.     WITH p^ DO
  47.       key := x; count := 1;
  48.       left := NIL; right := NIL;
  49.       bal := 0 
  50.     END;(*with*)
  51.   ELSIF x < p^.key THEN 
  52.     search(x,p^.left,h);
  53.     IF h THEN                              (* left branch has grown higher *)
  54.       CASE p^.bal OF
  55.           1 : p^.bal:= 0; h:= FALSE;
  56.        |  0 : p^.bal:= -1; 
  57.        | -1 : p1 := p^.left;               (* rebalance *)
  58.               IF p1^.bal = -1 THEN         (* single LL rotation *)
  59.                  p^.left:= p1^.right;
  60.                  p1^.right:= p;
  61.                  p^.bal:= 0; p := p1;
  62.               ELSE                         (* double LR rotation *)
  63.                  p2 := p1^.right;
  64.                  p1^.right:= p2^.left;
  65.                  p2^.left:= p1;
  66.                  p^.left:= p2^.right;
  67.                  p2^.right:= p;
  68.                  IF p2^.bal = -1 THEN p^.bal := +1 ELSE p^.bal:= 0 END;
  69.                  IF p2^.bal = +1 THEN p1^.bal := -1 ELSE p1^.bal:= 0 END;
  70.                  p := p2;
  71.               END; (*if*)
  72.               p^.bal:= 0; h:= FALSE;
  73.        END; (*case*)
  74.     END; (*if*)
  75.   ELSIF x > p^.key THEN 
  76.     search(x,p^.right,h);
  77.     IF h THEN                              (*right branch has grown higher *)
  78.       CASE p^.bal OF
  79.          -1 : p^.bal:= 0; h:= FALSE;
  80.        |  0 : p^.bal:= +1; 
  81.        |  1 : p1 := p^.right;              (* rebalance *)
  82.               IF p1^.bal = +1 THEN         (* single RR rotation *)
  83.                  p^.right:= p1^.left;
  84.                  p1^.left:= p;
  85.                  p^.bal:= 0; p := p1;
  86.               ELSE                         (* double RL rotation *)
  87.                  p2 := p1^.left;
  88.                  p1^.left:= p2^.right;
  89.                  p2^.right:= p1;
  90.                  p^.right:= p2^.left;
  91.                  p2^.left:= p;
  92.                  IF p2^.bal = +1 THEN p^.bal := -1 ELSE p^.bal:= 0 END;
  93.                  IF p2^.bal = -1 THEN p1^.bal := +1 ELSE p1^.bal:= 0 END;
  94.                  p := p2
  95.               END; (*if*)
  96.               p^.bal:= 0; h:= FALSE
  97.        END; (*case*)
  98.     END; (*if*)
  99.   ELSE  INC(p^.count); h:= FALSE
  100.   END; (*if*)
  101. END search;
  102.  
  103. (******************************************************)
  104.  
  105. PROCEDURE delete(x: INTEGER; VAR p:ref; VAR h: BOOLEAN);
  106.   VAR  q: ref;                           (* h = FALSE*)
  107.  
  108.  
  109.   PROCEDURE balance1(VAR p:ref; VAR h: BOOLEAN);
  110.     VAR  p1,p2: ref;
  111.          b1,b2: [-1..+1];
  112.   BEGIN                                  (*h = true, left branch has become less high *)
  113.     CASE p^.bal OF
  114.         -1 : p^.bal:= 0;
  115.        | 0 : p^.bal:= +1; h:= FALSE;       (* rebalance *)
  116.        | 1 : p1:= p^.right;
  117.              b1:= p1^.bal;
  118.              IF b1 >= 0 THEN               (* single RR rotation *)
  119.                 p^.right := p1^.left;
  120.                 p1^.left:=p;
  121.                 IF b1 = 0 THEN 
  122.                    p^.bal:= +1;
  123.                    p1^.bal := -1;
  124.                    h:= FALSE
  125.                 ELSE 
  126.                    p^.bal:= 0;
  127.                    p1^.bal:= 0
  128.                 END; (*if*)
  129.                 p := p1;
  130.              ELSE                         (* double RL rotation *)
  131.                 p2 := p1^.left;
  132.                 b2 := p2^.bal;
  133.                 p1^.left:= p2^.right;
  134.                 p2^.right:= p1;
  135.                 p^.right:= p2^.left;
  136.                 p2^.left:= p;
  137.                 IF b2 = +1 THEN p^.bal := -1 ELSE p^.bal:= 0 END;
  138.                 IF b2 = -1 THEN p1^.bal := +1 ELSE p1^.bal:= 0 END;
  139.                 p := p2;
  140.                 p2^.bal := 0;
  141.              END; (*if*)
  142.     END; (*case*)
  143.   END balance1;
  144.  
  145.   PROCEDURE balance2(VAR p:ref; VAR h: BOOLEAN);
  146.     VAR  p1,p2: ref;
  147.          b1,b2: [-1..+1];
  148.   BEGIN                                  (*h = true, right braanch has become less high *)
  149.     CASE p^.bal OF
  150.          1 : p^.bal:= 0;
  151.       |  0 : p^.bal:= -1; h:= FALSE;       
  152.       | -1 : p1:= p^.left;                (* rebalance *) 
  153.              b1:= p1^.bal;
  154.              IF b1 <= 0 THEN               (* single LL rotation *)
  155.                 p^.left:= p1^.right;
  156.                 p1^.right:=p;
  157.                 IF b1 = 0 THEN 
  158.                    p^.bal:= -1;
  159.                    p1^.bal := +1;
  160.                    h:= FALSE
  161.                 ELSE 
  162.                    p^.bal:= 0;
  163.                    p1^.bal:= 0
  164.                 END; (*if*)
  165.                 p := p1;
  166.              ELSE                         (* double LR rotation *)
  167.                 p2 := p1^.right;
  168.                 b2 := p2^.bal;
  169.                 p1^.right:= p2^.left;
  170.                 p2^.left:= p1;
  171.                 p^.left:= p2^.right;
  172.                 p2^.right:= p;
  173.                 IF b2 = -1 THEN p^.bal := +1 ELSE p^.bal:= 0 END;
  174.                 IF b2 = +1 THEN p1^.bal := -1 ELSE p1^.bal:= 0 END;
  175.                 p := p2;
  176.                 p2^.bal := 0;
  177.              END; (*if*)
  178.     END; (*case*)
  179.   END balance2;
  180.  
  181.   PROCEDURE del(VAR r:ref; VAR h: BOOLEAN);
  182.   BEGIN                                            (* h = false *)
  183.     IF r^.right <> NIL THEN
  184.        del(r^.right,h);
  185.        IF h THEN balance2(r,h) END;
  186.     ELSE
  187.        q^.key := r^.key; 
  188.        q^.count := r^.count;
  189.        r := r^.left;
  190.        h := TRUE;
  191.     END; (*if*)
  192.    END del;
  193.  
  194. BEGIN (*delete*)
  195.   IF p = NIL THEN 
  196.      WriteString("key is not in tree");WriteLn;
  197.      h := FALSE;
  198.   ELSIF x < p^.key THEN 
  199.      delete(x,p^.left,h);
  200.      IF h THEN balance1(p,h) END; (*if*)
  201.   ELSIF x > p^.key THEN 
  202.      delete(x,p^.right,h);
  203.      IF h THEN balance2(p,h) END; (*if*)
  204.   ELSE (* delete p^*)
  205.      q := p;
  206.      IF q^.right = NIL THEN
  207.         p := q^.left;
  208.         h := TRUE;
  209.      ELSIF q^.left = NIL THEN
  210.         p := q^.right;
  211.         h := TRUE
  212.      ELSE del(q^.left,h);
  213.         IF h THEN balance1(p,h) END; (*if*)
  214.      END; (*if*)
  215.      (*dispose q*)
  216.   END; (*if*)
  217. END delete;
  218.  
  219. (******************************************************)
  220.  
  221. BEGIN
  222.  WriteString("enter a 0 to quit and a negative number for deletion"); WriteLn;
  223.  WriteString("enter a node ->  ");
  224.  ReadInt(k); WriteLn;
  225.  root := NIL;
  226.  WHILE k <> 0 DO
  227.     IF k >= 0 THEN
  228.       WriteString("insert"); WriteInt(k,4); WriteLn;
  229.       search(k,root,h);
  230.     ELSE 
  231.       WriteString("delete");WriteInt(-k,4); WriteLn;
  232.       delete(-k,root,h)
  233.     END; (*if*)
  234.     printree(root,0);
  235.     WriteString("enter a node ->  ");
  236.     ReadInt(k); WriteLn;
  237.  END; (*while*)
  238. END BalTree.
  239.