spacefrogg
/
critbit
1
0
Fork 0
Code Releases Activity

Implement deletion; break insertion as it is still wrong

master
Michael Raitza 2020-02-10 23:24:56 +01:00
parent 41c4a51d64
commit 8400602c06
2 changed files with 49 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

0
cb/cb-test.factor → trees/cb/cb-test.factor
View File

55
cb/cb.factor → trees/cb/cb.factor
View File

@ -82,8 +82,13 @@ SYMBOL: current-key
: byte-at ( byte# -- byte/0 ) : byte-at ( byte# -- byte/0 )
key-bytes get ?nth [ 0 ] unless* ; key-bytes get ?nth [ 0 ] unless* ;
! For the current key and cb-node determin which side to go next
: select-side ( node -- node side )
dup [ bits>> ] [ byte#>> ] bi
byte-at key-side ;
! ** Insertion ! ** Insertion
!
! Tree insertion must be done by traversing the tree from the root, as it is ! Tree insertion must be done by traversing the tree from the root, as it is
! ordered. ! ordered.
@ -102,11 +107,10 @@ SYMBOL: current-key
DEFER: cb-set DEFER: cb-set
! Insert a node into a non-empty tree. ! Insert a node into a non-empty tree.
: (cb-set) ( value node -- node created? ) : (cb-set) ( value parent node -- parent node created? )
dup cb-node? [ dup cb-node? [
dup [ bits>> ] [ byte#>> ] bi select-side [
byte-at key-side [ [ node-link (cb-set) ] keep
[ node-link cb-set ] keep
swap [ [ set-node-link ] keep ] dip swap [ [ set-node-link ] keep ] dip
] with-side ] with-side
] [ ] [
@ -115,10 +119,49 @@ DEFER: cb-set
! Insert a node into the tree ! Insert a node into the tree
: cb-set ( value node -- node created? ) : cb-set ( value node -- node created? )
[ (cb-set) ] [ current-key get swap <node> t ] if* ; [ dup (cb-set) ] [ current-key get swap <node> t ] if* ;
PRIVATE> PRIVATE>
M: cb set-at ( value key cb -- ) M: cb set-at ( value key cb -- )
[ swap [ cb-set ] with-key swap ] change-root [ swap [ cb-set ] with-key swap ] change-root
swap [ dup inc-count ] when drop ; swap [ dup inc-count ] when drop ;
! ** Deletion
<PRIVATE
GENERIC: cb-delete ( node -- node deleted? )
M: f cb-delete f ;
M: node cb-delete
dup key>> current-key get = [ drop f t ] [ f ] if ;
M: cb-node cb-delete ( node -- node deleted? )
select-side [
dup node-link dup cb-delete [
! ( node old-child new-child -- )
[
! ( node old new )
! Deleted a split node (received some node)
tuck eq? [
drop t
] [
swap tuck set-node-link
t
] if
] [
! Deleted a leaf node return other child.
drop
node+link t
] if*
f
] when drop
] with-side ;
PRIVATE>
M: cb delete-at ( key cb -- )
[ swap [ cb-delete ] with-key swap ] change-root
swap [ dup dec-count ] when drop ;