From e62da0bc64b61313a828ac8b1df118fbcdc7db29 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Tue, 5 May 2015 16:08:55 -0700
Subject: [PATCH] math.transforms.bwt: faster version of bwt if only needing
transform.
---
extra/math/transforms/bwt/bwt-tests.factor | 4 +++-
extra/math/transforms/bwt/bwt.factor | 9 ++++++++-
2 files changed, 11 insertions(+), 2 deletions(-)
diff --git a/extra/math/transforms/bwt/bwt-tests.factor b/extra/math/transforms/bwt/bwt-tests.factor
index 9491bf644e..0a02db2d65 100644
--- a/extra/math/transforms/bwt/bwt-tests.factor
+++ b/extra/math/transforms/bwt/bwt-tests.factor
@@ -1,6 +1,8 @@
! Copyright (C) 2012 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: tools.test ;
+USING: kernel tools.test ;
IN: math.transforms.bwt
{ "asdf" } [ "asdf" bwt ibwt ] unit-test
+
+{ t } [ "hello" [ bwt nip ] [ bwt* ] bi = ] unit-test
diff --git a/extra/math/transforms/bwt/bwt.factor b/extra/math/transforms/bwt/bwt.factor
index 35844580e5..d3cecea39c 100644
--- a/extra/math/transforms/bwt/bwt.factor
+++ b/extra/math/transforms/bwt/bwt.factor
@@ -1,10 +1,17 @@
! Copyright (C) 2012 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
-USING: assocs fry kernel sequences sequences.rotated sorting ;
+USING: accessors assocs fry kernel math sequences
+sequences.rotated sorting suffix-arrays.private ;
IN: math.transforms.bwt
! Semi-efficient versions of Burrows-Wheeler Transform
+: bwt* ( seq -- newseq )
+ [
+ dup suffixes natural-sort
+ [ dup from>> [ to>> ] [ nip ] if-zero 1 - over nth ]
+ ] [ map-as ] bi nip ;
+
: bwt ( seq -- i newseq )
dup all-rotations natural-sort
[ [ sequence= ] with find drop ]