spacefrogg
/
critbit
1
0
Fork 0
Code Releases Activity

Distinguish into internal and leaf nodes; Implement appending leaf node 

No internal node splitting
master
Michael Raitza 2020-02-09 21:28:06 +01:00
parent 0674a825b0
commit 9de4680d39
1 changed files with 29 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
cb/cb.factor
View File

@ -16,7 +16,7 @@
USING: accessors arrays assocs kernel math namespaces sequences serialize trees USING: accessors arrays assocs kernel math namespaces sequences serialize trees
trees.private ; trees.private ;
IN: trees.cb; IN: trees.cb
TUPLE: cb < tree ; TUPLE: cb < tree ;
@ -24,13 +24,16 @@ TUPLE: cb < tree ;
<PRIVATE <PRIVATE
TUPLE: cb-node < node { byte# integer } { bits integer } ; TUPLE: cb-node { byte# integer } { bits integer } left right ;
: <cb-node> ( byte# bits key value -- node ) : new-node ( byte# bits class -- node )
cb-node new-node new
swap >>bits swap >>bits
swap >>byte# ; inline swap >>byte# ; inline
: <cb-node> ( byte# bits -- node )
cb-node new-node ;
! 0 = left ! 0 = left
! 1 = right ! 1 = right
: direction ( n n -- direction ) : direction ( n n -- direction )
@ -49,8 +52,8 @@ SYMBOL: current-key
: with-key ( key quot -- ) : with-key ( key quot -- )
[ [
{ current-key key-bytes } { current-key key-bytes } swap
[ dup object>bytes 2array ] dip zip dup object>bytes 2array zip
] dip with-variables ; inline ] dip with-variables ; inline
: byte-at ( byte# -- byte/0 ) : byte-at ( byte# -- byte/0 )
@ -61,29 +64,33 @@ SYMBOL: current-key
DEFER: cb-set DEFER: cb-set
: cb-insert ( value key node -- node taller? created? ) : cb-insert ( value node -- node created? )
f ;
swap [
dup [ bits>> ] [ byte#>> ] bi
byte-at key-side [
node-link cb-set
] with-side
] with-key ;
! Implement this and cb-insert using SYMBOL for current key bytes while ! Implement this and cb-insert using SYMBOL for current key bytes while
! traversing the tree. ! traversing the tree.
: (cb-set) ( value key node -- node taller? created? ) : (cb-set) ( value node -- created? )
drop dup cb-node? [
dup key>> current-key get = [ dup [ bits>> ] [ byte#>> ] bi
current-key get >>key swap >>value f f byte-at key-side [
] [ current-key get swap cb-insert ] if ; [ node-link cb-set ] keep
swap [ set-node-link ] dip
] with-side
] [
dup key>> current-key get = [
dup current-key get
[ value<< ] [ >>key drop ] 2bi* f
] [
2drop f ! cb-insert
] if
] if ;
! Insert a node into the tree ! Insert a node into the tree
: cb-set ( value key node -- node taller? created? ) : cb-set ( value node -- node created? )
[ (cb-set) ] [ [ 0 byte-at 0xfe ] 2dip swap <cb-node> t t ] if* ; [ [ (cb-set) ] keep ] [ current-key get swap <node> t ] if* ;
PRIVATE> PRIVATE>
M: cb set-at ( value key cb -- ) M: cb set-at ( value key cb -- )
[ cb-set nip swap ] change-root [ swap [ cb-set ] with-key ] change-root
swap [ dup inc-count ] when drop ; swap [ dup inc-count ] when drop ;