spacefrogg
/
critbit
1
0
Fork 0
Code Releases Activity

WIP Fix difference algorithm

master
Michael Raitza 2020-12-05 13:15:50 +01:00
parent 642aaf718c
commit 1f66561cdc
1 changed files with 21 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
trees/cb/cb.factor
View File

@ -14,10 +14,11 @@
! critical bit) in a length field (encoded as an integer and a mask) and two ! critical bit) in a length field (encoded as an integer and a mask) and two
! successor pointers. Arbitrary data objects make up its leaves. ! successor pointers. Arbitrary data objects make up its leaves.
USING: accessors alien arrays assocs byte-arrays combinators.short-circuit fry USING: accessors alien arrays assocs byte-arrays combinators
io.binary io.encodings.binary io.encodings.private io.encodings.string combinators.short-circuit fry io.binary io.encodings.binary io.encodings.private
io.encodings.utf8 kernel layouts locals make math math.private namespaces parser io.encodings.string io.encodings.utf8 kernel layouts locals make math
prettyprint.custom sequences serialize strings trees trees.private vectors ; math.private namespaces parser prettyprint.custom sequences serialize strings
trees trees.private vectors ;
IN: trees.cb IN: trees.cb
TUPLE: cb < tree ; TUPLE: cb < tree ;
@ -53,17 +54,31 @@ TUPLE: cb-node { byte# integer } { bits integer } left right ;
bitxor msb0 bitxor msb0
[ key-side ] keep ; [ key-side ] keep ;
: elt-from-long-seq ( seq1 seq2 -- elt i/f )
2dup [ length ] bi@ {
{ [ 2dup > ] [ 2nip [ swap nth ] keep ] }
{ [ 2dup < ] [ drop [ drop ] 2dip [ swap nth ] keep ] }
[ 4drop 0 f ]
} cond ;
: order-by-length ( seq1 seq2 -- seq-short seq-long )
2dup [ length ] bi@ > [ swap ] when ;
! For two byte strings, calculate the critical bit, byte and direction of ! For two byte strings, calculate the critical bit, byte and direction of
! difference (0 = left, 1 = right). ! difference.
: bytes-diff ( newbytes oldbytes -- side bits byte# ) : (bytes-diff) ( newbytes oldbytes -- side bits byte# )
2dup mismatch 2dup mismatch
[ [
[ '[ _ swap nth ] bi@ byte-diff ] keep [ '[ _ swap nth ] bi@ byte-diff ] keep
] [ ] [
! Equal prefix over full (shorter) byte sequence. ! Equal prefix over full (shorter) byte sequence.
elt-from-long-seq [ [ 0 ] dip ] [ ] if* ;
[ 1 255 ] 2dip shorter length 1 - [ 1 255 ] 2dip shorter length 1 -
] if* ; ] if* ;
: bytes-diff ( newbytes oldbytes -- side bits byte#/f )
bytes-diff ;
PRIVATE> PRIVATE>
GENERIC: key>bytes* ( key -- bytes ) GENERIC: key>bytes* ( key -- bytes )