1
0
Fork 0

WIP Deactivate broken insert code and rewrite

Split into:
 - walk for best fit
 - updating leaf / creating new split node and leaf node
 - insert new split node if necessary (WIP)
master
Michael Raitza 2020-02-11 22:30:10 +01:00
parent 8400602c06
commit f06eda5f16
1 changed files with 92 additions and 26 deletions

View File

@ -68,14 +68,15 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
! environment for it with =with-key=.
SYMBOL: key-bytes
SYMBOL: current-key
SYMBOL: new-side
: key>bytes ( key -- bytes )
object>bytes ;
: with-key ( key quot -- )
[
{ current-key key-bytes } swap
dup key>bytes 2array zip
{ current-key key-bytes new-side } swap
dup key>bytes left 3array zip
] dip with-variables ; inline
! Extract the critical byte
@ -92,39 +93,104 @@ SYMBOL: current-key
! Tree insertion must be done by traversing the tree from the root, as it is
! ordered.
! Insert a node at a leaf-node by first inserting a split node.
: cb-insert ( value leaf-node -- node created? )
[ current-key get swap <node> ] dip
dup key>> key>bytes key-bytes get swap
bytes-diff swap <cb-node>
! ( new-leaf old-leaf side cb-node -- )
[ swap
[ [ set-node-link ] keep
set-node+link
] with-side
] keep t ;
! ! Insert a node at a leaf-node by first inserting a split node.
! : cb-insert ( value leaf-node -- node created? )
! [ current-key get swap <node> ] dip
! dup key>> key>bytes key-bytes get swap
! bytes-diff swap <cb-node>
! ! ( new-leaf old-leaf side cb-node -- )
! [ swap
! [ [ set-node-link ] keep
! set-node+link
! ] with-side
! ] keep t ;
DEFER: cb-set
! DEFER: cb-set
! Insert a node into a non-empty tree.
: (cb-set) ( value parent node -- parent node created? )
dup cb-node? [
select-side [
[ node-link (cb-set) ] keep
swap [ [ set-node-link ] keep ] dip
] with-side
! ! Insert a node into a non-empty tree.
! : (cb-set) ( value parent node -- parent node created? )
! dup cb-node? [
! select-side [
! [ node-link (cb-set) ] keep
! swap [ [ set-node-link ] keep ] dip
! ] with-side
! ] [
! cb-insert
! ] if ;
! ! Insert a node into the tree
! : cb-set ( value node -- node created? )
! [ dup (cb-set) ] [ current-key get swap <node> t ] if* ;
! ** Walking the tree for the best fit
! We need to remember the parent node as it will be the split node where our new
! value starts to differ, should it not be (key-)identical with the current
! node. Start with =f= as the parent.
GENERIC: cb-best-fit ( parent/f node -- node child )
M: f cb-best-fit ;
M: node cb-best-fit ;
M: cb-node cb-best-fit
select-side [
nip dup node-link cb-best-fit
] with-side ;
GENERIC: cb-update ( value parent/f node -- node created? )
M: f cb-update
2drop current-key get swap <node> t ;
: attach-node ( value side cb-node -- cb-node )
swap [
[ current-key get swap <node> ] dip
[ set-node+link ] keep
] with-side ;
M: node cb-update
dup key>> current-key get = [
current-key get >>key
nip swap >>value f
] [
cb-insert
dup key>> key>bytes key-bytes get swap
bytes-diff swap <cb-node>
attach-node t
] if ;
! Insert a node into the tree
: cb-set ( value node -- node created? )
[ dup (cb-set) ] [ current-key get swap <node> t ] if* ;
GENERIC: cb-insert ( new-node cur-node -- node )
M: f cb-insert drop ;
M: node cb-insert
new-side get [
swap [ set-node-link ] keep
] with-side ;
M: cb-node cb-insert
2dup
[ [ [ byte#>> ] bi@ < ]
[ [ [ byte#>> ] bi@ = ]
[ [ bits>> ] bi@ <]
] 2&&
] 2|| [
! break
select-side [ set-node-link ] with-side
] [
! step down
] if
PRIVATE>
M: cb set-at ( value key cb -- )
[ swap [ cb-set ] with-key swap ] change-root
[ swap
[ ! ( value root -- new created? root )
[ f swap cb-best-fit cb-update ] keep swap
[ cb-insert t ] [ 2nip f ] if
] with-key swap ] change-root
swap [ dup inc-count ] when drop ;
! ** Deletion