home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / btree.mod (.txt) < prev    next >
Oberon Text  |  1994-10-18  |  7KB  |  195 lines

  1. Syntax10.Scn.Fnt
  2. MODULE BTree;
  3.     IMPORT Texts, Oberon;
  4.     CONST N = 3;
  5.     TYPE Page = POINTER TO PageRec;
  6.         Entry = RECORD
  7.                         key, count: INTEGER;
  8.                         p: Page
  9.                      END ;
  10.         PageRec = RECORD
  11.                         m: INTEGER;  (*no. of entries on page*)
  12.                         p0: Page;
  13.                         e: ARRAY 2*N OF Entry
  14.                      END ;
  15.     VAR root: Page;
  16.         W: Texts.Writer;
  17. PROCEDURE search(x: INTEGER; a: Page; VAR cnt: INTEGER);
  18.     VAR i, L, R: INTEGER;
  19. BEGIN (*a # NIL*)
  20.     LOOP L := 0; R := a.m;  (*binary search*)
  21.         WHILE L < R DO
  22.             i := (L+R) DIV 2;
  23.             IF x <= a.e[i].key THEN R := i ELSE L := i+1 END
  24.         END ;
  25.         IF (R < a.m) & (a.e[R].key = x) THEN (*found*)
  26.             INC(a.e[R].count); cnt := a.e[R].count; EXIT
  27.         END ;
  28.         IF R = 0 THEN a := a.p0 ELSE a := a.e[R-1].p END ;
  29.         IF a = NIL THEN (*not found*) cnt := 0; EXIT END
  30. END search;
  31. PROCEDURE insert(x: INTEGER; a: Page; VAR h: BOOLEAN; VAR v: Entry);
  32.     (*a # NIL. Search key x in B-tree with root a; if found, increment counter.
  33.         Otherwise insert new item with key x.  If an entry is to be passed up,
  34.         assign it to v. h := "tree has become higher"*)
  35.     VAR i, L, R: INTEGER;
  36.         b: Page; u: Entry;
  37. BEGIN (*a # NIL & ~h*)
  38.     L := 0; R := a.m;  (*binary search*)
  39.     WHILE L < R DO
  40.         i := (L+R) DIV 2;
  41.         IF x <= a.e[i].key THEN R := i ELSE L := i+1 END
  42.     END ;
  43.     IF (R < a.m) & (a.e[R].key = x) THEN (*found*) INC(a.e[R].count)
  44.     ELSE (*item not on this page*)
  45.         IF R = 0 THEN b := a.p0 ELSE b := a.e[R-1].p END ;
  46.         IF b = NIL THEN (*not in tree, insert*)
  47.             u.count := 0; u.p := NIL; h := TRUE; u.key := x
  48.         ELSE insert(x, b, h, u)
  49.         END ;
  50.         IF h THEN (*insert u to the left of a.e[R]*)
  51.             IF a.m < 2*N THEN
  52.                 h := FALSE; i := a.m;
  53.                 WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
  54.                 a.e[R] := u; INC(a.m)
  55.             ELSE NEW(b); (*overflow; split a into a,b and assign the middle entry to v*)
  56.                 IF R < N THEN (*insert in left page a*)
  57.                     i := N-1; v := a.e[i];
  58.                     WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ;
  59.                     a.e[R] := u; i := 0;
  60.                     WHILE i < N DO b.e[i] := a.e[i+N]; INC(i) END
  61.                 ELSE (*insert in right page b*)
  62.                     DEC(R, N); i := 0;
  63.                     IF R = 0 THEN v := u
  64.                     ELSE v := a.e[N];
  65.                         WHILE i < R-1 DO b.e[i] := a.e[i+N+1]; INC(i) END ;
  66.                         b.e[i] := u; INC(i)
  67.                     END ;
  68.                     WHILE i < N DO b.e[i] := a.e[i+N]; INC(i) END
  69.                 END ;
  70.                 a.m := N; b.m := N; b.p0 := v.p; v.p := b
  71.             END
  72.         END
  73. END insert;
  74. PROCEDURE underflow(c, a: Page; s: INTEGER; VAR h: BOOLEAN);
  75.     (*a = underflowing page, c = ancestor page,
  76.         s = index of deleted entry in c*)
  77.     VAR b: Page;
  78.         i, k: INTEGER;
  79. BEGIN (*h & (a.m = N-1) & (c.e[s-1].p = a) *)
  80.     IF s < c.m THEN (*b := page to the right of a*)
  81.         b := c.e[s].p; k := (b.m-N+1) DIV 2; (*k = nof items available on page b*)
  82.         a.e[N-1] := c.e[s]; a.e[N-1].p := b.p0;
  83.         IF k > 0 THEN (*balance by moving k-1 items from b to a*) i := 0;
  84.             WHILE i < k-1 DO a.e[i+N] := b.e[i]; INC(i) END ;
  85.             c.e[s] := b.e[k-1]; b.p0 := c.e[s].p;
  86.             c.e[s].p := b; DEC(b.m, k); i := 0;
  87.             WHILE i < b.m DO b.e[i] := b.e[i+k]; INC(i) END ;
  88.             a.m := N-1+k; h := FALSE
  89.         ELSE (*merge pages a and b, discard b*)  i := 0;
  90.             WHILE i < N DO a.e[i+N] := b.e[i]; INC(i) END ;
  91.             i := s; DEC(c.m);
  92.             WHILE i < c.m DO c.e[i] := c.e[i+1]; INC(i) END ;
  93.             a.m := 2*N; h := c.m < N
  94.         END
  95.     ELSE (*b := page to the left of a*)  DEC(s);
  96.         IF s = 0 THEN b := c.p0 ELSE b := c.e[s-1].p END ;
  97.         k := (b.m-N+1) DIV 2; (*k = nof items available on page b*)
  98.         IF k > 0 THEN i := N-1;
  99.             WHILE i > 0 DO DEC(i); a.e[i+k] := a.e[i] END ;
  100.             i := k-1; a.e[i] := c.e[s]; a.e[i].p := a.p0;
  101.             (*move k-1 items from b to a, one to c*)  DEC(b.m, k);
  102.             WHILE i > 0 DO DEC(i); a.e[i] := b.e[i+b.m+1] END ;
  103.             c.e[s] := b.e[b.m]; a.p0 := c.e[s].p;
  104.             c.e[s].p := a; a.m := N-1+k; h := FALSE
  105.         ELSE (*merge pages a and b, discard a*)
  106.             c.e[s].p := a.p0; b.e[N] := c.e[s]; i := 0;
  107.             WHILE i < N-1 DO b.e[i+N+1] := a.e[i]; INC(i) END ;
  108.             b.m := 2*N; DEC(c.m); h := c.m < N
  109.         END
  110. END underflow;
  111. PROCEDURE delete(x: INTEGER; a: Page; VAR h: BOOLEAN);
  112.     (*search and delete key x in B-tree a; if a page underflow arises,
  113.         balance with adjacent page or merge; h := "page a is undersize"*)
  114.     VAR i, L, R: INTEGER; q: Page;
  115.     PROCEDURE del(p: Page; VAR h: BOOLEAN);
  116.         VAR k: INTEGER; q: Page;  (*global a, R*)
  117.     BEGIN k := p.m-1; q := p.e[k].p;
  118.         IF q # NIL THEN del(q, h);
  119.             IF h THEN underflow(p, q, p.m, h) END
  120.         ELSE p.e[k].p := a.e[R].p; a.e[R] := p.e[k];
  121.             DEC(p.m); h := p.m < N
  122.         END
  123.     END del;
  124. BEGIN (*a # NIL*)
  125.     L := 0; R := a.m;  (*binary search*)
  126.     WHILE L < R DO
  127.         i := (L+R) DIV 2;
  128.         IF x <= a.e[i].key THEN R := i ELSE L := i+1 END
  129.     END ;
  130.     IF R = 0 THEN q := a.p0 ELSE q := a.e[R-1].p END ;
  131.     IF (R < a.m) & (a.e[R].key = x) THEN (*found*)
  132.         IF q = NIL THEN (*a is leaf page*)
  133.             DEC(a.m); h := a.m < N; i := R;
  134.             WHILE i < a.m DO a.e[i] := a.e[i+1]; INC(i) END
  135.         ELSE del(q, h);
  136.             IF h THEN underflow(a, q, R, h) END
  137.         END
  138.     ELSE delete(x, q, h);
  139.         IF h THEN underflow(a, q, R, h) END
  140. END delete;
  141. PROCEDURE PrintTree(p: Page; level: INTEGER);
  142.     VAR i: INTEGER;
  143. BEGIN
  144.     IF p # NIL THEN i := 0;
  145.         WHILE i < level DO Texts.WriteString(W, "     "); INC(i) END ;
  146.         i := 0;
  147.         WHILE i < p.m DO Texts.WriteInt(W, p.e[i].key, 5); INC(i) END ;
  148.         Texts.WriteLn(W);
  149.         PrintTree(p.p0, level+1); i := 0;
  150.         WHILE i < p.m DO PrintTree(p.e[i].p, level+1); INC(i) END
  151. END PrintTree;
  152. PROCEDURE Search*;
  153.     VAR cnt: INTEGER; S: Texts.Scanner;
  154. BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  155.     Texts.WriteString(W, "search"); Texts.Scan(S);
  156.     WHILE S.class = Texts.Int DO
  157.         Texts.WriteInt(W, S.i, 4); search(SHORT(S.i), root, cnt); Texts.WriteInt(W, cnt, 4)
  158.     END ;
  159.     Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
  160. END Search;
  161. PROCEDURE Insert*;
  162.     VAR S: Texts.Scanner;
  163.         h: BOOLEAN; u: Entry; q: Page;
  164. BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  165.     Texts.WriteString(W, "insert"); Texts.Scan(S);
  166.     WHILE S.class = Texts.Int DO
  167.         Texts.WriteInt(W, S.i, 4); h := FALSE; insert(SHORT(S.i), root, h, u);
  168.         IF h THEN (*insert new base page*)
  169.             q := root; NEW(root);
  170.             root.m := 1; root.p0 := q; root.e[0] := u
  171.         END ;
  172.         Texts.Scan(S)
  173.     END ;
  174.     Texts.WriteLn(W); PrintTree(root, 0); Texts.Append(Oberon.Log, W.buf)
  175. END Insert;
  176. PROCEDURE Delete*;
  177.     VAR S: Texts.Scanner;
  178.         h: BOOLEAN;
  179. BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
  180.     Texts.WriteString(W, "delete"); Texts.Scan(S);
  181.     WHILE S.class = Texts.Int DO
  182.         Texts.WriteInt(W, S.i, 4); h := FALSE; delete(SHORT(S.i), root, h);
  183.         IF h THEN (*base page size underflow*)
  184.             IF root.m = 0 THEN root := root.p0 END
  185.         END ;
  186.         Texts.Scan(S)
  187.     END ;
  188.     Texts.WriteLn(W); PrintTree(root, 0); Texts.Append(Oberon.Log, W.buf)
  189. END Delete;
  190. PROCEDURE Init*;
  191. BEGIN NEW(root); root.m := 0
  192. END Init;
  193. BEGIN Init; Texts.OpenWriter(W)
  194. END BTree.
  195.