97 lines
2.6 KiB
Factor
97 lines
2.6 KiB
Factor
! 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 { byte# integer } { bits integer } left right ;
|
|
|
|
: new-node ( byte# bits class -- node )
|
|
new
|
|
swap >>bits
|
|
swap >>byte# ; inline
|
|
|
|
: <cb-node> ( byte# bits -- node )
|
|
cb-node new-node ;
|
|
|
|
! 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 } swap
|
|
dup object>bytes 2array zip
|
|
] dip with-variables ; inline
|
|
|
|
: byte-at ( byte# -- byte/0 )
|
|
key-bytes get ?nth [ 0 ] unless* ;
|
|
|
|
! ** Insertion
|
|
! Explain...
|
|
|
|
DEFER: cb-set
|
|
|
|
: cb-insert ( value node -- node created? )
|
|
;
|
|
|
|
! Implement this and cb-insert using SYMBOL for current key bytes while
|
|
! traversing the tree.
|
|
: (cb-set) ( value node -- created? )
|
|
dup cb-node? [
|
|
dup [ bits>> ] [ byte#>> ] bi
|
|
byte-at key-side [
|
|
[ 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
|
|
: cb-set ( value node -- node created? )
|
|
[ [ (cb-set) ] keep ] [ current-key get swap <node> t ] if* ;
|
|
|
|
PRIVATE>
|
|
|
|
M: cb set-at ( value key cb -- )
|
|
[ swap [ cb-set ] with-key ] change-root
|
|
swap [ dup inc-count ] when drop ;
|