cs200cap@st1.vuw.ac.nz (06/02/90)
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 *) IF R=1 THEN q:=p0 ELSE q:=e[R-1].p END; (* of IF *) IF (R<=m) & (e[R].key=x) THEN (* found, now delete *) IF q=NIL THEN (* a is a terminal page *) m:=m-1; h:=m<n; FOR i:=R TO m DO e[i]:=e[i+1] END ELSE del(q,h); IF h THEN underflow(a, q, R-1, h) END END ELSE delete(x, q, h); IF h THEN underflow(a, q, R-1, h) END END END END END delete; PROCEDURE PrintTree(p: PPtr; level: CARDINAL); VAR i: CARDINAL; BEGIN IF p#NIL THEN FOR i:=1 TO level DO WriteString("****") END; FOR i:=1 TO p^.m DO WriteInt(p^.e[i].key, 4) END; WriteLn; PrintTree(p^.p0, level+1); FOR i:=1 TO p^.m DO PrintTree(p^.e[i].p, level+1) END END END PrintTree; BEGIN (* main program *) OpenInput("TXT"); OpenOutput("TREE"); root:=NIL; Write(">"); ReadInt(x); WHILE Done DO WriteInt(x,5); WriteLn; IF x>=0 THEN search(x, root, h, u); a; if a page underflow arises, balance with adjacent page or merge; h:= "page ZE(Page)); WITH root^ DO m:=1; p0:=q; e[1]:=u END END ELSE delete(-x, root, h); IF h THEN (* base page size reduced *) IF root^.m=0 THEN q:=root; root:=q^.p0; (* deallocate(q) *) END END END; PrintTree(root, 0); WriteLn; Write(">"); ReadInt(x) END; CloseInput; CloseOutput END BTree.
cs200cap@st1.vuw.ac.nz@p0.f42.n105.z1.fidonet.org (cs200cap@st1.vuw.ac.nz) (06/08/90)
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