steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

math.transforms.bwt: slightly faster, remove suffixes because it seems buggy.

db4
John Benediktsson 2015-05-05 17:20:04 -07:00
parent e62da0bc64
commit 52043e60d5
2 changed files with 13 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
extra/math/transforms/bwt/bwt-tests.factor
View File

@ -1,8 +1,13 @@
! Copyright (C) 2012 John Benediktsson ! Copyright (C) 2012 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: kernel tools.test ; USING: tools.test ;
IN: math.transforms.bwt IN: math.transforms.bwt
{ "asdf" } [ "asdf" bwt ibwt ] unit-test { "asdf" } [ "asdf" bwt ibwt ] unit-test
{ t } [ "hello" [ bwt nip ] [ bwt* ] bi = ] unit-test {
29
"TEXYDST.E.IXIXIXXSSMPPS.B..E.S.EUSFXDIIOIIIT"
} [
"SIX.MIXED.PIXIES.SIFT.SIXTY.PIXIE.DUST.BOXES" bwt
] unit-test

18
extra/math/transforms/bwt/bwt.factor
View File

@ -1,21 +1,15 @@
! Copyright (C) 2012 John Benediktsson ! Copyright (C) 2012 John Benediktsson
! See http://factorcode.org/license.txt for BSD license ! See http://factorcode.org/license.txt for BSD license
USING: accessors assocs fry kernel math sequences USING: accessors assocs fry kernel locals sequences
sequences.rotated sorting suffix-arrays.private ; sequences.rotated sorting ;
IN: math.transforms.bwt IN: math.transforms.bwt
! Semi-efficient versions of Burrows-Wheeler Transform ! Semi-efficient versions of Burrows-Wheeler Transform
: bwt* ( seq -- newseq ) :: bwt ( seq -- i newseq )
[ seq all-rotations natural-sort
dup suffixes natural-sort [ [ n>> 0 = ] find drop ] keep
[ dup from>> [ to>> ] [ nip ] if-zero 1 - over nth ] [ last ] seq map-as ;
] [ map-as ] bi nip ;
: bwt ( seq -- i newseq )
dup all-rotations natural-sort
[ [ sequence= ] with find drop ]
[ [ last ] rot map-as ] 2bi ;
: ibwt ( i newseq -- seq ) : ibwt ( i newseq -- seq )
[ length ] [ length ]