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

math.transforms.bwt: faster versions of Burrows-Wheeler Transform.

db4
John Benediktsson 2015-04-28 19:28:14 -07:00
parent 16213f8779
commit 6f3f4e8fb8
2 changed files with 12 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1,6 +1,6 @@
! 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: strings tools.test ; USING: tools.test ;
IN: math.transforms.bwt IN: math.transforms.bwt
{ "asdf" } [ "asdf" bwt ibwt >string ] unit-test { "asdf" } [ "asdf" bwt ibwt ] unit-test

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

@ -1,15 +1,16 @@
! 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: arrays fry kernel math sequences sequences.extras USING: assocs fry kernel sequences sequences.rotated sorting ;
sorting ;
IN: math.transforms.bwt IN: math.transforms.bwt
! Inefficient versions of Burrows-Wheeler Transform ! Semi-efficient versions of Burrows-Wheeler Transform
: bwt ( seq -- newseq ) : bwt ( seq -- i newseq )
0 suffix all-rotations natural-sort [ last ] map ; dup all-rotations natural-sort
[ [ sequence= ] with find drop ]
[ [ last ] rot map-as ] 2bi ;
: ibwt ( newseq -- seq ) : ibwt ( i newseq -- seq )
[ length [ { } <array> ] keep ] keep [ length ]
'[ _ [ prefix ] 2map natural-sort ] times [ <enum> sort-values '[ _ nth first2 ] ]
[ last 0 = ] find nip but-last ; [ replicate-as ] tri nip ;