1
0
Fork 0
critbit/cb/cb.factor

90 lines
2.5 KiB
Factor
Raw Normal View History

! Copyright (C) 2020 Michael Raitza
! See http://factorcode.org/license.txt for BSD license.
!
! * Crit-bit trees
! ** Rationale
! Critbit trees are described in [[https://cr.yp.to/critbit.html][djb's crit-bit tree]]. They are an evolution of
! PATRICIA trees showing that fast insertion, deletion, exact searching and suffix
! searching is possible with this data structure.
! The strength of this data structure, according to its author, lies in its
! simple design and its optimisation to be machine parsable using machine
! word-sized operations where possible. Like PATRICIA trees, crit-bit trees are
! prefix-compressed, with internal nodes storing next decision point (the
! critical bit) in a length field (encoded as an integer and a mask) and two
! successor pointers. Arbitrary data objects make up its leaves.
USING: accessors arrays assocs kernel math namespaces sequences serialize trees
trees.private ;
IN: trees.cb;
TUPLE: cb < tree ;
: <cb> ( -- tree ) cb new-tree ; inline
<PRIVATE
TUPLE: cb-node < node { byte# integer } { bits integer } ;
: <cb-node> ( byte# bits key value -- node )
cb-node new-node
swap >>bits
swap >>byte# ; inline
! 0 = left
! 1 = right
: direction ( n n -- direction )
bitor 1 + -8 shift ; inline
: key-side ( bits byte -- side )
direction 0 = -1 1 ? ;
: get-byte-at ( byte# key -- byte/0 )
object>bytes ?nth [ 0 ] unless* ;
! Keep the byte sequence of the current key in =key-bytes= and provide a working
! environment for it with =with-key=.
SYMBOL: key-bytes
SYMBOL: current-key
: with-key ( key quot -- )
[
{ current-key key-bytes }
[ dup object>bytes 2array ] dip zip
] dip with-variables ; inline
: byte-at ( byte# -- byte/0 )
key-bytes get ?nth [ 0 ] unless* ;
! ** Insertion
! Explain...
DEFER: cb-set
: cb-insert ( value key node -- node taller? 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
! traversing the tree.
: (cb-set) ( value key node -- node taller? created? )
drop
dup key>> current-key get = [
current-key get >>key swap >>value f f
] [ current-key get swap cb-insert ] if ;
! Insert a node into the tree
: cb-set ( value key node -- node taller? created? )
[ (cb-set) ] [ [ 0 byte-at 0xfe ] 2dip swap <cb-node> t t ] if* ;
PRIVATE>
M: cb set-at ( value key cb -- )
[ cb-set nip swap ] change-root
swap [ dup inc-count ] when drop ;