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

suffix-arrays: simplify a bit.

locals-and-roots
John Benediktsson 2016-04-15 13:20:11 -07:00
parent 1a7547f33a
commit 97e87f4a05
1 changed files with 15 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
basis/suffix-arrays/suffix-arrays.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2008 Marc Fauconneau. ! Copyright (C) 2008 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors binary-search fry kernel math math.order USING: accessors binary-search fry kernel math math.order parser
parser sequences sets sorting ; sequences sets sorting ;
IN: suffix-arrays IN: suffix-arrays
<PRIVATE <PRIVATE
@ -15,26 +15,24 @@ IN: suffix-arrays
: find-index ( begin suffix-array -- index/f ) : find-index ( begin suffix-array -- index/f )
[ prefix<=> ] with search drop ; [ prefix<=> ] with search drop ;
: from-to ( index begin suffix-array -- from/f to/f ) : query-from ( index begin suffix-array -- from )
swap '[ _ head? not ] swap '[ _ head? not ] find-last-from drop [ 1 + ] [ 0 ] if* ;
[ find-last-from drop dup [ 1 + ] when ]
[ find-from drop ] 3bi ;
: <funky-slice> ( from/f to/f seq -- slice ) : query-to ( index begin suffix-array -- to )
[ [ swap '[ _ head? not ] find-from drop ] [ length or ] bi ;
[ drop 0 or ] [ length or ] bi-curry bi*
[ min ] keep : query-range ( index begin suffix-array -- from to )
] keep <slice> ; inline [ query-from ] [ query-to ] 3bi [ min ] keep ;
: (query) ( index begin suffix-array -- matches )
[ query-range ] keep <slice> [ seq>> ] map members ;
PRIVATE> PRIVATE>
: >suffix-array ( seq -- array ) : >suffix-array ( seq -- suffix-array )
members members [ suffixes ] map concat natural-sort ;
[ suffixes ] map concat natural-sort ;
SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ; SYNTAX: SA{ \ } [ >suffix-array ] parse-literal ;
: query ( begin suffix-array -- matches ) : query ( begin suffix-array -- matches )
2dup find-index dup [ find-index ] 2keep '[ _ _ (query) ] [ { } ] if* ;
[ -rot [ from-to ] keep <funky-slice> [ seq>> ] map members ]
[ 3drop { } ] if ;