B-TREE <IMPLEMENTATION MODULE - GENERIC> 
Author Message
 B-TREE <IMPLEMENTATION MODULE - GENERIC>

IMPLEMENTATION MODULE BTree;

    FROM SYSTEM  IMPORT  ADR, ADDRESS,   WORD, BYTE;

    FROM Storage IMPORT  ALLOCATE,  DEALLOCATE;

    FROM Texts IMPORT TEXT, State, Options,input, output,ReadInt, ReadChar,
                      WriteInt, WriteString, WriteLn, WriteChar,ReadLn,
                      Open, Close,ReadString;

    FROM Files IMPORT FILE;

    IMPORT Files;

    FROM MyIO IMPORT MultiWrite, BlankLines, WriteStrLn,OpenFile,
                     ClearLine,GetResponse;

            TYPE
                 btree = POINTER TO node;

                 node = RECORD
                          count: INTEGER;
                          key: ARRAY[1..max] OF ADDRESS;
                          branch: ARRAY[0..max] OF btree;
                        END;

                 BTree = POINTER TO header;

                 header = RECORD;
                              Tree:btree;
                              Less:CompProc;
                              Equal:CompProc;
                              Print:PrintProc;
                              ValueSize:INTEGER;
                              noOfElements:INTEGER;
                          END;

(***************************************************************************)
PROCEDURE CopyBytes(source,dest:ADDRESS; numBytes:INTEGER);

TYPE
    BytePointer = POINTER TO BYTE;
VAR
    i : INTEGER;
    sourceByte, destByte : BytePointer;

BEGIN
     sourceByte := source;
     destByte := dest;
     FOR i := 1 TO numBytes DO
         destByte^ := sourceByte^;
         sourceByte := BytePointer(INTEGER(sourceByte) + 1);
         destByte := BytePointer(INTEGER(destByte) + 1);
     END;
END CopyBytes;

(***************************************************************************)
PROCEDURE InitTree (VAR B:BTree;valueSize:INTEGER;print:PrintProc;
                    less:CompProc;equal:CompProc);
BEGIN
   ALLOCATE (B,SIZE(header));
   WITH B^ DO
     Tree:=NIL;
     Less:=less;
     Print:=print;
     Equal := equal;
     ValueSize:=valueSize;
     noOfElements := 0;
   END;
END InitTree;

(***************************************************************************)
   PROCEDURE printtree(B: BTree;p:btree;l:INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       WITH p^ DO
         FOR i := 1 TO l DO WriteString(output,'   ');END;
         FOR i := 1 TO count DO
           B^.Print(p^.key[i]);
         END;
         WriteLn(output);
         FOR i := 0 TO count DO
            printtree(B,p^.branch[i],l+1);
         END;
       END;
     END;
   END printtree;

(***************************************************************************)
PROCEDURE PrintSubTree(B: BTree; b: btree);
BEGIN
  printtree(B,b,1);
END PrintSubTree;

(***************************************************************************)
PROCEDURE PrintTree(B:BTree);
BEGIN
  printtree(B,B^.Tree,1);
END PrintTree;

(***************************************************************************)
PROCEDURE PrintNode(B: BTree; b: btree);
VAR i: INTEGER;
BEGIN
  IF b <> NIL THEN
    FOR i := 1 TO b^.count DO
      B^.Print(b^.key[i]);
    END;
  END;
END PrintNode;

(***************************************************************************)
PROCEDURE PrintLevel(B: BTree; level: INTEGER);

   PROCEDURE printlevel(p: btree; current: INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       IF (level = current) THEN
         FOR i := 1 TO p^.count DO
           B^.Print(p^.key[i]); WriteString(output,' |');
         END;
         WriteLn(output);
       ELSE
         FOR i := 0 TO p^.count DO
           printlevel(p^.branch[i],current+1);
         END;
       END;
     END;
   END printlevel;

BEGIN
  printlevel(B^.Tree,1);
END PrintLevel;

(***************************************************************************)
PROCEDURE AvgProbeLength(B: BTree):REAL;
VAR totalProbes: INTEGER;
   PROCEDURE avgProbeLength(p: btree; level: INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
         totalProbes := totalProbes + level;
         FOR i := 0 TO p^.count DO
           avgProbeLength(p^.branch[i],level + 1);
         END;
     END;
   END avgProbeLength;

BEGIN
  totalProbes := 0;
  avgProbeLength(B^.Tree,1);
  IF B^.noOfElements # 0 THEN
    RETURN (FLOAT(totalProbes) / FLOAT(B^.noOfElements));
  ELSE RETURN (0.0);
  END;
END AvgProbeLength;

(***************************************************************************)
PROCEDURE LevelElementCount(B: BTree; level: INTEGER):INTEGER;
VAR noOfElements: INTEGER;
   PROCEDURE levelElementCount(p: btree; current: INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       IF (level = current) THEN
         FOR i := 1 TO p^.count DO
           INC(noOfElements);
         END;
       ELSE
         FOR i := 0 TO p^.count DO
           levelElementCount(p^.branch[i],current+1);
         END;
       END;
     END;
   END levelElementCount;

BEGIN
  noOfElements := 0;
  levelElementCount(B^.Tree,1);
  RETURN noOfElements;
END LevelElementCount;

(***************************************************************************)
PROCEDURE LevelNodeCount(B: BTree; level: INTEGER):INTEGER;
VAR noOfNodes: INTEGER;
   PROCEDURE levelNodeCount(p: btree; current: INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       IF (level = current) THEN
         INC(noOfNodes);
       ELSE
         FOR i := 0 TO p^.count DO
           levelNodeCount(p^.branch[i],current+1);
         END;
       END;
     END;
   END levelNodeCount;

BEGIN
  noOfNodes := 0;
  levelNodeCount(B^.Tree,1);
  RETURN noOfNodes;
END LevelNodeCount;

(***************************************************************************)
   PROCEDURE SearchNode(B:BTree; target: ADDRESS; p: btree;
     VAR found: BOOLEAN; VAR k: INTEGER);
   BEGIN
     WITH p^ DO
       IF B^.Less(target,key[1]) THEN
         found := FALSE;
         k := 0;
       ELSE k := count;
         WHILE (B^.Less(target,key[k]) AND (k > 1)) DO
           k := k - 1;
         END;
         found := B^.Equal(target,key[k]);
       END;
     END;
   END SearchNode;

(***************************************************************************)
PROCEDURE Search(target: ADDRESS; B: BTree; VAR found: BOOLEAN;
                 VAR targetnode: btree; VAR targetpos: INTEGER);

   PROCEDURE search(target: ADDRESS; b: btree; VAR found: BOOLEAN;
                    VAR targetnode: btree; VAR targetpos: INTEGER);
   BEGIN
     IF B = NIL THEN found := FALSE;
     ELSE
       SearchNode(B,target,b,found,targetpos);
       IF found THEN targetnode := b;
       ELSE search(target,b^.branch[targetpos],found,targetnode, targetpos);
       END;
     END;
   END search;

BEGIN
  search(target,B^.Tree,found,targetnode,targetpos);
END Search;

(***************************************************************************)
PROCEDURE Insert(newkey: ADDRESS; VAR B: BTree);
VAR success: BOOLEAN;

   PROCEDURE PushIn(x: ADDRESS; xr,p: btree; k: INTEGER);
   (*INSERTS KEY x AND POINTER xr INTO NODE p^ AT INTEGER k*)
   VAR i: INTEGER;
   BEGIN
     WITH p^ DO
       FOR i := count TO (k + 1) BY -1 DO
         ALLOCATE(key[i+1],B^.ValueSize);
         CopyBytes(key[i],key[i+1],B^.ValueSize);
         branch[i + 1] := branch[i];
       END;
          ALLOCATE(key[k+1],B^.ValueSize);
          CopyBytes(x,key[k+1],B^.ValueSize);
          branch[k + 1] := xr;
       INC(count);
     END;
   END PushIn;

   PROCEDURE Split(x: ADDRESS; xr,p: btree; k: INTEGER;
     VAR y: ADDRESS; VAR yr: btree);
   (*SPLITS NODE p^ WITH KEY x AND POINTER xr AT INTEGER k INTO NODES p^ AND
     yr^ WITH MEDIAN KEY y*)
   VAR i: INTEGER;
       median: INTEGER;
   BEGIN
     IF k <= min THEN
       median := min;
     ELSE median := min + 1;
     END;
     ALLOCATE(yr,SIZE(node));
     WITH p^ DO
       FOR i := (median + 1) TO max DO
         ALLOCATE(yr^.key[i - median],B^.ValueSize);
         CopyBytes(key[i],yr^.key[i - median],B^.ValueSize);
         yr^.branch[i - median] := branch[i];
       END;
       yr^.count := max - median;
       count := median;
       IF k <= min THEN
         PushIn(x,xr,p,k);
       ELSE
         PushIn(x,xr,yr,k - median);
       END;
       ALLOCATE(y,B^.ValueSize);
       CopyBytes(key[count],y,B^.ValueSize);
       yr^.branch[0] := branch[count];
       count := count - 1;
     END;
   END Split;

   PROCEDURE PushDown(newkey: ADDRESS; p: btree;
       VAR pushup: BOOLEAN; VAR x: ADDRESS; VAR xr: btree);
   VAR k:     INTEGER;
       found: BOOLEAN;
   BEGIN
     IF p = NIL THEN
       pushup := TRUE;
       x      := newkey;
       xr     := NIL;
     ELSE
       SearchNode(B,newkey,p,found,k);
       IF found THEN
         WriteStrLn(output,'ERROR: inserting duplicate key');
         success := FALSE; pushup := FALSE;
       ELSE
         PushDown(newkey,p^.branch[k],pushup,x,xr);
         IF pushup THEN
           WITH p^ DO
             IF count < max THEN
               pushup := FALSE;
               PushIn(x,xr,p,k);
             ELSE pushup := TRUE;
               Split(x,xr,p,k,x,xr);
             END;
           END;
         END;
       END;
     END;
   END PushDown;

   PROCEDURE insert(newkey: ADDRESS; VAR tree: btree);
   (*INSERTS NEWKEY INTO THE B-TREE WITH GIVEN node. REQUIRES THAT NEWKEY IS
   NOT ALREADY PRESENT IN THE TREE.*)
   VAR  pushup:        BOOLEAN;
        x:             ADDRESS;
        xr,p:          btree;
        i:             INTEGER;
   BEGIN
     PushDown(newkey,tree,pushup,x,xr);
     IF pushup THEN
       ALLOCATE(p,SIZE(node));
       WITH p^ DO
         count      := 1;
         ALLOCATE(key[1],B^.ValueSize);
         CopyBytes(x,key[1],B^.ValueSize);
         branch[0]  := tree;
         branch[1]  := xr;
         tree       := p;
       END;
     END;
   END insert;

BEGIN
  success := TRUE;
  insert(newkey,B^.Tree);
  IF success THEN INC(B^.noOfElements);
  END;
END Insert;

(***************************************************************************)
PROCEDURE Delete(target: ADDRESS; VAR B: BTree);

   PROCEDURE Remove(p: btree; k: INTEGER);
   (*REMOVES key[k] AND branch[k] FROM p^*)
   VAR i: INTEGER;
   BEGIN
     WITH p^ DO
       FOR i := (k + 1) TO count DO
         ALLOCATE(key[i-1],B^.ValueSize);
         CopyBytes(key[i],key[i-1],B^.ValueSize);
         branch[i - 1] := branch[i];
       END;
       count := count - 1;
     END;
   END Remove;

   PROCEDURE Successor(p: btree; k: INTEGER);
   (*REPLACES p^.key[k] BY ITS IMMEDIATE SUCCESSOR UNDER NATURAL ORDER*)
   VAR q: btree;
   BEGIN
     q := p^.branch[k];
     WHILE q^.branch[0] <> NIL DO
       q := q^.branch[0];
     END;
     ALLOCATE(p^.key[k],B^.ValueSize);
     CopyBytes(q^.key[1],p^.key[k],B^.ValueSize);
   END Successor;

   PROCEDURE MoveRight(p: btree; k: INTEGER);
   VAR c: INTEGER;
   BEGIN
     WITH p^.branch[k]^ DO
       FOR c:= count TO 1 BY -1 DO
         ALLOCATE(key[c+1],B^.ValueSize);
         CopyBytes(key[c],key[c+1],B^.ValueSize);
         branch[c+1] := branch[c];
       END;
       branch[1] := branch[0];
       count := count + 1;
       ALLOCATE(key[1],B^.ValueSize);
       CopyBytes(p^.key[k],key[1],B^.ValueSize);
     END;
     WITH p^.branch[k-1]^ DO
       ALLOCATE(p^.key[k],B^.ValueSize);
       CopyBytes(key[count],p^.key[k],B^.ValueSize);
       p^.branch[k]^.branch[0] := branch[count];
       count := count - 1;
     END;
   END MoveRight;

   PROCEDURE MoveLeft(p: btree; k: INTEGER);
   VAR c: INTEGER;
   BEGIN
     WITH p^.branch[k-1]^ DO
       count := count + 1;
       ALLOCATE(key[count],B^.ValueSize);
       CopyBytes(p^.key[k],key[count],B^.ValueSize);
       branch[count] := p^.branch[k]^.branch[0];
     END;
     WITH p^.branch[k]^ DO
       ALLOCATE(p^.key[k],B^.ValueSize);
       CopyBytes(key[1],p^.key[k],B^.ValueSize);
       branch[0] := branch[1];
       count := count -1;
       FOR c := 1 TO count DO
         ALLOCATE(key[c],B^.ValueSize);
         CopyBytes(key[c+1],key[c],B^.ValueSize);
         branch[c] := branch[c+1];
       END;
     END;
   END MoveLeft;

   PROCEDURE Combine(p: btree; k: INTEGER);
   VAR i,c: INTEGER;
       q: btree;
   BEGIN
     q := p^.branch[k];
     WITH p^.branch[k - 1]^ DO
       count := count + 1;
       ALLOCATE(key[count],B^.ValueSize);
       CopyBytes(p^.key[k],key[count],B^.ValueSize);
       branch[count] := q^.branch[0];
       FOR c := 1 TO q^.count DO
         count := count + 1;
         ALLOCATE(key[count],B^.ValueSize);
         CopyBytes(q^.key[c],key[count],B^.ValueSize);
         branch[count] := q^.branch[c];
       END;
     END;
     WITH p^ DO
       FOR c := k TO count -1 DO
         ALLOCATE(key[c],B^.ValueSize);
         CopyBytes(key[c+1],key[c],B^.ValueSize);
         branch[c] := branch[c+1];
       END;
       count := count -1;
     END;
     FOR i := 1 TO q^.count DO
        DEALLOCATE(q^.key[i],B^.ValueSize);
     END;
     DEALLOCATE(q,SIZE(node));
   END Combine;

   PROCEDURE Restore(p: btree; k: INTEGER);
   (*FINDS A KEY AND INSERTS IT INTO p^.branch[k]^ SO AS TO RESTORE MINIMUM*)
   BEGIN
     IF k > 0 THEN
       IF p^.branch[k-1]^.count > min THEN
         MoveRight(p,k);
       ELSE Combine(p,k);
       END;
     ELSE
       IF p^.branch[1]^.count > min THEN
         MoveLeft(p,1);
       ELSE Combine(p,1);
       END;
     END;
   END Restore;

   PROCEDURE RecDelete(target: ADDRESS; p: btree; VAR found: BOOLEAN);
   VAR k: INTEGER;
   BEGIN
     IF p = NIL THEN
       found := FALSE;
     ELSE
       WITH p^ DO
         SearchNode(B,target,p,found,k);
         IF found THEN
           DEC(B^.noOfElements);
           IF branch[k-1] = NIL THEN
             Remove(p,k);
           ELSE Successor(p,k);
             RecDelete(key[k],branch[k],found);
             IF NOT found THEN
               WriteStrLn(output,'Error: key not found');
             END;
           END;
         ELSE RecDelete(target,branch[k],found);
         END;
         IF branch[k] <> NIL THEN
           IF branch[k]^.count < min THEN
             Restore(p,k);
           END;
         END;
       END;
     END;
   END RecDelete;

   PROCEDURE delete(target: ADDRESS; VAR b: btree);
   VAR found: BOOLEAN;
       i: INTEGER;
       p: btree;
   BEGIN
     RecDelete(target,b,found);
     IF NOT found THEN
       WriteStrLn(output,'Error: key is not found');
     ELSIF b^.count = 0 THEN
       p := b;
       b := b^.branch[0];
       FOR i := 1 TO p^.count DO
          DEALLOCATE(p^.key[i],B^.ValueSize);
       END;
       DEALLOCATE(p,SIZE(node));
     END;
   END delete;

BEGIN
  delete(target,B^.Tree);
END Delete;

(***************************************************************************)
PROCEDURE TraverseTree(ord: Order; B:BTree; visit: OpProc; addr: ADDRESS);

    PROCEDURE inorder(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          inorder(branch[0]);
          FOR i := 1 TO count DO visit(key[i],addr);
            inorder(branch[i]);
          END;
        END;
      END;
    END inorder;

    PROCEDURE preorder(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          FOR i := 1 TO count DO visit(key[i],addr); END;
          FOR i := 0 TO count DO preorder(branch[i]) END;
        END;
      END;
    END preorder;

    PROCEDURE postorder(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          postorder(branch[0]);
          FOR i := 1 TO count DO postorder(branch[i]);
          END;
          FOR i := 1 TO count DO visit(key[i],addr);
          END;
        END;
      END;
    END postorder;

    PROCEDURE reverse(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          FOR i := count TO 1 BY -1 DO reverse(branch[i]);
            visit(key[i],addr);
          END;
          reverse(branch[0]);
        END
      END;
    END reverse;

BEGIN
  CASE ord OF
      preOrder : preorder(B^.Tree);
  |  postOrder : postorder(B^.Tree);
  |    inOrder : inorder(B^.Tree);
  |   revOrder : reverse(B^.Tree);
  ELSE WriteString(output,'Error in order type');
  END;
END TraverseTree;

(***************************************************************************)
PROCEDURE ElementCount(B:BTree):INTEGER;
BEGIN
  RETURN B^.noOfElements;
END ElementCount;

(***************************************************************************)
PROCEDURE EmptyBTree(B:BTree):BOOLEAN;
BEGIN
  RETURN (B^.Tree = NIL);
END EmptyBTree;

(***************************************************************************)
PROCEDURE Root(B:BTree):btree;
BEGIN
  RETURN (B^.Tree);
END Root;

(***************************************************************************)
PROCEDURE NumEntries(b:btree):INTEGER;
BEGIN
  RETURN b^.count;
END NumEntries;

(***************************************************************************)
PROCEDURE Content(b:btree;pos:INTEGER):ADDRESS;
BEGIN
    RETURN b^.key[pos];
END Content;

(***************************************************************************)
PROCEDURE GetChild(b:btree;path:INTEGER):btree;
BEGIN
  IF (b <> NIL) AND (path <= b^.count) AND (path >= 0) THEN
    IF b^.branch[path] <> NIL THEN RETURN b^.branch[path];
    ELSE RETURN b; END;
  ELSE RETURN b;
  END;
END GetChild;

(***************************************************************************)
PROCEDURE EmptyNode(b:btree):BOOLEAN;
BEGIN
  RETURN (b = NIL);
END EmptyNode;

(***************************************************************************)
PROCEDURE IsLeaf(b:btree):BOOLEAN;
VAR pos : INTEGER;
    empty: BOOLEAN;
BEGIN
  empty := FALSE;
  IF NOT EmptyNode(b) THEN
    pos := 0;
    WHILE (NOT empty) AND (pos <= b^.count) DO
      empty := (b^.branch[pos] = NIL);
      INC(pos);
    END;
  END;
  RETURN empty;
END IsLeaf;

(***************************************************************************)
PROCEDURE IsChild(B:BTree;b:btree;element:ADDRESS):BOOLEAN;
VAR found: BOOLEAN;
    k:      INTEGER;
    c:      btree;

   PROCEDURE search(target: ADDRESS; b: btree; VAR found: BOOLEAN;
                    VAR targetnode: btree; VAR targetpos: INTEGER);
   BEGIN
     IF B = NIL THEN found := FALSE;
     ELSE
       SearchNode(B,target,b,found,targetpos);
       IF found THEN targetnode := b;
       ELSIF NOT EmptyNode(b^.branch[targetpos]) THEN
          search(target,b^.branch[targetpos],found,targetnode,targetpos);
       END;
     END;
   END search;

BEGIN
  search(element,b,found,c,k);
  IF b # c THEN RETURN found;
  ELSE RETURN FALSE; END;
END IsChild;

(***************************************************************************)
PROCEDURE GetParent(B:BTree;b:btree):btree;
VAR parent:      btree;

   PROCEDURE search(t:btree; i: INTEGER);
   VAR found : BOOLEAN;
   BEGIN
     IF NOT EmptyNode(t) THEN
       REPEAT
         found := (t^.branch[i] = b);
         IF NOT found THEN search(t^.branch[i],0); END;
         INC(i);
       UNTIL (i > t^.count) OR (found);
       IF found THEN parent := t; END;
     END;
   END search;

BEGIN
  parent := b;
  IF (b # Root(B)) AND (NOT EmptyNode(b)) THEN search(B^.Tree,0); END;
  RETURN parent;
END GetParent;

(***************************************************************************)
PROCEDURE Height(B:BTree):INTEGER;
VAR h: INTEGER;
    b: btree;
BEGIN
  b := Root(B);
  h := 0;
  WHILE b <> NIL DO
    b := b^.branch[0];
    INC(h);
  END;
  RETURN h;
END Height;

(***************************************************************************)
PROCEDURE DeleteLeaves(VAR B:BTree);

   PROCEDURE deleteleaves(p,lastnode:btree;path:INTEGER);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       IF (p^.branch[0] = NIL) THEN
         FOR i := 1 TO p^.count DO
            DEALLOCATE(p^.key[i],B^.ValueSize);
         END;
         DEALLOCATE(p,SIZE(node));
         DEC(B^.noOfElements);
         IF (lastnode # NIL) THEN lastnode^.branch[path] := NIL;
         END;
       ELSE
         FOR i := 0 TO p^.count DO
            deleteleaves(p^.branch[i],p,i);
         END;
       END;
     END;
   END deleteleaves;

BEGIN
  IF (B^.Tree # NIL) THEN
    IF B^.Tree^.branch[0] := NIL THEN deleteleaves(B^.Tree,NIL,0);
      B^.Tree := NIL;
    ELSE deleteleaves(B^.Tree,NIL,0);
    END;
  END;
END DeleteLeaves;

(***************************************************************************)
PROCEDURE DeleteTree(VAR B:BTree);

   PROCEDURE deletetree(p:btree);
   VAR i: INTEGER;
   BEGIN
     IF p # NIL THEN
       FOR i := 0 TO p^.count DO
          deletetree(p^.branch[i]);
       END;
       FOR i := 1 TO p^.count DO
          DEALLOCATE(p^.key[i],B^.ValueSize);
       END;
       DEALLOCATE(p,SIZE(node));
     END;
   END deletetree;

BEGIN
  deletetree(B^.Tree);
  B^.Tree := NIL;
  B^.noOfElements := 0;
END DeleteTree;

(***************************************************************************)
PROCEDURE MergeBTree(B1, B2: BTree):BTree;
VAR newTree: BTree;

    PROCEDURE insertion(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          FOR i := 1 TO count DO Insert(key[i],newTree); END;
          FOR i := 0 TO count DO insertion(branch[i]) END;
        END;
      END;
    END insertion;

BEGIN
  InitTree(newTree,B1^.ValueSize,B1^.Print,B1^.Less,B1^.Equal);
  insertion(B1^.Tree);
  insertion(B2^.Tree);
  RETURN newTree;
END MergeBTree;

(***************************************************************************)
PROCEDURE SplitBTree(B: BTree; pivot: ADDRESS; VAR B1: BTree; VAR B2: BTree);

    PROCEDURE insertion(p: btree);
    VAR i: INTEGER;
    BEGIN
      IF p # NIL THEN
        WITH p^ DO
          insertion(branch[0]);
          FOR i := 1 TO count DO
            IF B^.Less(key[i],pivot) THEN Insert(key[i],B1);
            ELSE Insert(key[i],B2);
            END;
            insertion(branch[i]);
          END;
        END;
      END;
    END insertion;

BEGIN
  InitTree(B1,B^.ValueSize,B^.Print,B^.Less,B^.Equal);
  InitTree(B2,B^.ValueSize,B^.Print,B^.Less,B^.Equal);
  insertion(B^.Tree);
END SplitBTree;

PROCEDURE GetLeftCorner(B:BTree):btree;
VAR b: btree;
BEGIN
  IF (B^.Tree # NIL) THEN
    b := B^.Tree;
    WHILE b^.branch[0] # NIL DO
      b:= b^.branch[0];
    END;
  END;
  RETURN b;
END GetLeftCorner;

PROCEDURE GetRightCorner(B:BTree):btree;
VAR b: btree;
BEGIN
  IF (B^.Tree # NIL) THEN
    b := B^.Tree;
    WHILE b^.branch[b^.count] # NIL DO
      b:= b^.branch[b^.count];
    END;
  END;
  RETURN b;
END GetRightCorner;

PROCEDURE CopyTree(B: BTree):BTree;
VAR new: BTree;

    PROCEDURE copyNode(b, lastnode: btree; path: INTEGER);
    VAR i: INTEGER;
        c: btree;
    BEGIN
      IF b # NIL THEN
          ALLOCATE(c,SIZE(node));
          CopyBytes(b,c,SIZE(node));
          FOR i := 1 TO c^.count DO
            ALLOCATE(c^.key[i],B^.ValueSize);
            CopyBytes(b^.key[i],c^.key[i],B^.ValueSize);
          END;
          IF lastnode = NIL THEN
            new^.Tree := c;
          ELSE lastnode^.branch[path] := c;
          END;
          FOR i := 0 TO b^.count DO copyNode(b^.branch[i],c,i) END;
      END;
    END copyNode;

BEGIN
  InitTree(new,B^.ValueSize,B^.Print,B^.Less,B^.Equal);
  copyNode(B^.Tree,NIL,0);
  new^.noOfElements := B^.noOfElements;
  RETURN new;
END CopyTree;

PROCEDURE Write(addr: ADDRESS; data: ADDRESS);
TYPE
   infoType = RECORD
                f: FILE;
                size: INTEGER;
                state: Files.State;
              END;
VAR ptr: POINTER TO infoType;
BEGIN
  ptr := data;
  Files.WriteBuffer(ptr^.f,addr,ptr^.size,ptr^.state);
END Write;

PROCEDURE SaveBTree(VAR B:BTree; name: ARRAY OF CHAR);
TYPE
   infoType = RECORD
                f: FILE;
                size: INTEGER;
                state: Files.State;
              END;
VAR info: infoType;
BEGIN
 info.size := B^.ValueSize;
 Files.Create(info.f,name,Files.readWrite,info.state);
 IF info.state = Files.ok THEN TraverseTree(preOrder,B,Write,ADR(info));
 ELSE WriteStrLn(output,'ERROR: Creating file ');
 END;
 Files.Close(info.f,info.state);
END SaveBTree;

PROCEDURE LoadBTree(B:BTree; name: ARRAY OF CHAR);
VAR f: FILE;
    element: ADDRESS;
    state: Files.State;
    bytesRead: CARDINAL;
BEGIN
  ALLOCATE(element,B^.ValueSize);
  Files.Open(f,name,Files.readOnly,state);
  REPEAT
    Files.ReadBuffer(f,element,B^.ValueSize,bytesRead,state);
    CASE state OF
      Files.ok    : Insert(element,B);
   |  Files.error : WriteStrLn(output,'ERROR');
   |  Files.eof   : WriteStrLn(output,'FINISHED READING');
    END;
  UNTIL state # Files.ok;
  Files.Close(f,state);
END LoadBTree;
END BTree.



Sun, 11 Sep 1994 09:28:30 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. B-TREE <DEFINITION MODULE - GENERIC>

2. ><><><><>Heeeeeeeeeeeeeeelp on INT 14!><><><><><>

3. Generic Table -- Binary Tree Implementation Module

4. Generic Table -- B-Tree Implementation Module

5. <<<<<YOU MUST CHECK THIS OUT >>>>>>>>>> 2103

6. >>Problems w/ HTML module <<

7. <><><> FLOODFILL <><><>

8. >>>HELP, DECOMPILER<<<

9. <<<XXX Password>>>

10. >>>>>>>>>>>>>>>>>>>HEY!<<<<<<<<<<<<<<<<<<<<<<<

11. <<<XXX Password>>>

12. ??? <<<<<<<<<<<<<<<<<<<< RGB 4 MMX >>>>>>>>>>>>>>>>>>>>>>>?

 

 
Powered by phpBB® Forum Software