🚀 go-pugleaf

From: cs200cap@st1.vuw.ac.nz
Date: 2 Jun 90 05:01:43 GMT
Organization: Victoria University of Wellington
Message-ID: <1697.26669f77@st1.vuw.ac.nz>
Newsgroups: comp.lang.modula2

In article, vixie@decwrl.dec.com (Paul A Vixie) writes:

> There are some B-tree routines in Wirth's "Algorythms and Data Structures"
> (second version, source code in M2 rather than P).  I converted them to C
> and posted them to comp.sources.unix a few years back, but the originals
> are still in the book :-)..

Yeah, I adapted Wirth's B-Tree routines from the 2nd edition.  His original
ones are reprinted below without permission (it helps if you buy/borrow a
copy of his book so you can follow what is going on as his variable names
are a little cryptic).

The Tab character size should be 4, so you will need to replace the tab
characters with 4 spaces below.

Create a file of integers, if an integer is -ve, then the code below will
try and delete the integer from the tree.  If the integer is +ve then
the code will insert the integer in the tree, if it's already in the tree
then it will INC(record.count).

pat  --  cs200cap@st1.vuw.ac.nz



MODULE BTree;
(* B-tree procedures by Niklaus Wirth *)

FROM InOut IMPORT       OpenInput, OpenOutput, CloseInput, CloseOutput, ReadInt,
                                        Done, WriteInt, WriteString, WriteLn, Write;

FROM Storage IMPORT ALLOCATE;

CONST n=9;  (* Order of b-tree *)

TYPE PPtr=POINTER TO Page;

Item=   RECORD
                  key   : INTEGER;
                  p             : PPtr;
                  count : CARDINAL;
                END;

Page=   RECORD
                  m             : [0..2*n]; (* no. of items on page *)
                  p0    : PPtr;
                  e             : ARRAY[1..2*n] OF Item;
                END;
                
VAR root,q      : PPtr;
        x               : INTEGER;
        h               : BOOLEAN;
        u               : Item;
        

PROCEDURE search(x : INTEGER; a : PPtr; VAR h : BOOLEAN; VAR v :Item);
(* Search key x in B-tree with root a; if found, increment counter.
   Otherwise insert new item with key x.  If an item is passed up,
   assign it to v.  h = "tree has become higher" *)

        VAR i, L, R     : CARDINAL;
                b               : PPtr;
                u               : Item;
                
        BEGIN (* ~h *)
                IF a=NIL
                THEN
                        h:=TRUE; (* not in tree *)
                        WITH v DO
                                key:=x;
                                count:=1;
                                p:=NIL;
                        END; (* of WITH *)
                ELSE
                        WITH a^ DO
                                L:=1;
                                R:=m+1; (* binary search *)
                                WHILE L<R DO
                                        i:=(L+R) DIV 2;
                                        IF e[i].key<=x
                                        THEN
                                                L:=i+1;
                                        ELSE
                                                R:=i;
                                        END; (* of IF *)
                                END; (* of WHILE *)
                                R:=R-1;
                                IF (R>0) & (e[R].key=x)
                                THEN
                                        INC(e[R].count)
                                ELSE (* item not on this page *)
                                        IF R=0
                                        THEN
                                                search(x,p0,h,u);
                                        ELSE
                                                search(x,e[R].p,h,u)
                                        END; (* IF *)
                                        IF h
                                        THEN (* insert u to the right of e[R] *)
                                                IF m<2*n
                                                THEN
                                                        h:=FALSE;
                                                        m:=m+1;
                                                        FOR i:=m TO R+2 BY -1 DO
                                                                e[i]:=e[i-1] END;
                                                        e[R+1]:=u
                                                ELSE ALLOCATE(b, SIZE(Page)); (* overflow *)
                                                 (* split a into a,b and assign the middle item to v *)
                                                 IF R<=n
                                                 THEN
                                                        IF R=n
                                                        THEN
                                                                v:=u
                                                        ELSE
                                                                v:=e[n];
                                                                FOR i:=n TO R+2 BY -1 DO e[i]:=e[i-1] END;
                                                                e[R+1]:=u
                                                        END;
                                                        FOR i:=1 TO n DO b^.e[i]:=a^.e[i+n] END
                                                 ELSE (* insert in riMODULE BTree;
(* B-tree procedures by Niklaus Wirth *)

FROM InOut IMPORT       OpenInpu        b^.e[i]:=a^.e[i+n+1]
                                                        END; (* of FOR *)
                                                        b^.e[R]:=u;
                                                        FOR i:=R+1 TO n DO
                                                                b^.e[i]:=a^.e[i+n]
                                                        END; (* of for *)
                                                 END; (* of IF *)
                                                 m:=n;
                                                 b^.m:=n;
                                                 b^.p0:=v.p;
                                                 v.p:=b;
                                                END;
                                        END;
                                END;
                        END;
                END;
        END search;

PROCEDURE underflow(c, a:PPtr; s:CARDINAL; VAR h: BOOLEAN);
(*      a=underflowing page, c=ancestor page,
        s=index of deleted item in c, h:= *)
        
        VAR b:PPtr;
        VAR i,k,mb,mc: CARDINAL;
        
        BEGIN
                mc:=c^.m; (* h, a^.m=n-1 *)
                IF s<mc
                THEN
                        (* b:=page to the right of a *)
                        s:=s+1;
                        b:=c^.e[s].p;
                        mb:=b^.m;
                        k:=(mb-n+1) DIV 2;
                        (* k=no. of items available on page b *)
                        a^.e[n]:=c^.e[s];
                        a^.e[n].p:=b^.p0;
                        IF k>0
                        THEN
                                (* move k items from b to a *)
                                FOR i:=1 TO k-1 DO
                                        a^.e[i+n]:=b^.e[i]
                                        END;
                                c^.e[s]:=b^.e[k];
                                c^.e[s].p:=b;
                                b^.p0:=b^.e[k].p;
                                mb:=mb-k;
                                FOR i:=1 TO mb DO
                                        b^.e[i]:=b^.e[i+k]
                                        END;
                                b^.m:=mb;
                                a^.m:=n-1+k;
                                h:=FALSE
                        ELSE (* merge pages a and b *)
                                FOR i:=1 TO n DO
                                        a^.e[i+n]:=b^.e[i]
                                        END;
                                FOR i:=s TO mc-1 DO
                                        c^.e[i]:=c^.e[i+1]
                                        END;
                                a^.m:=2*n;
                                c^.m:=mc-1;
                                h:=mc<=n;
                                (* Deallocate(b) *)
                        END;
                ELSE (* b:= page to the left of a *)
                        IF s=1
                        THEN
                                b:=c^.p0
                        ELSE
                                b:=c^.e[s-1].p
                                END;
                        mb:=b^.m+1;
                        k:=(mb-n) DIV 2;
                        IF k>0
                        THEN
                                (* move k items for page b to a *)
                                FOR i:=n-1 TO 1 BY -1 DO
                                        a^.e[i+k]:=a^.e[i]
                                        END;
                                a^.e[k]:=c^.e[s];
                                a^.e[k].p:=a^.p0;
                                mb:=mb-k;
                                FOR i:=k-1 TO 1 BY -1 DO
                                        a^.e[i]:=b^.e[i+mb]
                                        END;
                                a^.p0:=b^.e[mb].p;
                                c^.e[s]:=b^.e[mb];
                                c^.e[s].p:=a;
                                b^.m:=mb-1;
                                a^.m:=n-1+k;
                                h:=FALSE
                        ELSE
                                (* merge pages a and b *)
                                b^.e[mb]:=c^.e[s];
                                b^.e[mb].p:=a^.p0;
                                FOR i:=1 TO n-1 DO
                                        b^.e[i+mb]:=a^.e[i]
                                        END;
                                b^.m:=2*n;
                                c^.m:=mc-1;
                                h:=mc<=n;
                                (* Deallocate(a) *)
                        END
                END
        END underflow;

PROCEDU b^.e[i]:=a^.e[i+n+1]
                                                        END; (* of FOR *)
                                                        b^.e[R]:=u;
                                                        FOR i: a; if a page underflow arises,
   balance with adjacent page or merge; h:= "page a is undersize" *)
   
   VAR i,L,R: CARDINAL;
        q               : PPtr;
        
        PROCEDURE del(P:PPtr; VAR h:BOOLEAN);
                VAR q:PPtr; (* global a,R *)
                
                BEGIN
                        WITH P^ DO
                                q:=e[m].p;
                                IF q # NIL
                                THEN
                                        del(q,h);
                                        IF h
                                        THEN
                                                underflow(P,q,m,h)
                                        END
                                ELSE
                                        P^.e[m].p:=a^.e[R].p;
                                        a^.e[R]:=P^.e[m];
                                        m:=m-1;
                                        h:=m<n
                                END
                        END
                END del;
   
        BEGIN
                IF a=NIL
                THEN (* x not in tree *)
                        h:=FALSE;
                ELSE
                        WITH a^ DO
                                L:=1;
                                R:=m+1; (* binary search *)
                                WHILE L<R DO
                                        i:=(L+R) DIV 2;
                                        IF e[i].key<x
                                        THEN
                                                L:=i+1;
                                        ELSE
                                                R:=i
                                        END (* of IF *)
                                END; (* of WHILE *)



--  
uucp: uunet!m2xenix!puddle!42.0!cs200cap@st1.vuw.ac.nz
Internet: cs200cap@st1.vuw.ac.nz@p0.f42.n105.z1.fidonet.org