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

lcs: performance improvements.

db4
John Benediktsson 2013-03-21 17:55:09 -07:00
parent 5b9805fcfd
commit 657bef5818
1 changed files with 20 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
basis/lcs/lcs.factor
View File

@ -1,22 +1,22 @@
USING: sequences kernel math locals math.order math.ranges USING: accessors arrays combinators combinators.short-circuit
accessors arrays namespaces make combinators kernel locals make math math.order sequences sequences.private ;
combinators.short-circuit ;
IN: lcs IN: lcs
<PRIVATE <PRIVATE
: levenshtein-step ( insert delete change same? -- next ) : levenshtein-step ( insert delete change same? -- next )
0 1 ? + [ [ 1 + ] bi@ ] dip min min ; [ [ 1 + ] bi@ ] 2dip [ 1 + ] unless min min ;
: lcs-step ( insert delete change same? -- next ) : lcs-step ( insert delete change same? -- next )
1 -1/0. ? + max max ; ! -1/0. is -inf (float) 1 -1/0. ? + max max ; ! -1/0. is -inf (float)
:: loop-step ( i j matrix old new step -- ) :: loop-step ( i j matrix old new step -- )
i j 1 + matrix nth nth ! insertion i j 1 + matrix nth-unsafe nth-unsafe ! insertion
i 1 + j matrix nth nth ! deletion i 1 + j matrix nth-unsafe nth-unsafe ! deletion
i j matrix nth nth ! replace/retain i j matrix nth-unsafe nth-unsafe ! replace/retain
i old nth j new nth = ! same? i old nth-unsafe j new nth-unsafe = ! same?
step call step call
i 1 + j 1 + matrix nth set-nth ; inline i 1 + j 1 + matrix nth-unsafe set-nth-unsafe ; inline
: lcs-initialize ( |str1| |str2| -- matrix ) : lcs-initialize ( |str1| |str2| -- matrix )
iota [ drop 0 <array> ] with map ; iota [ drop 0 <array> ] with map ;
@ -27,9 +27,11 @@ IN: lcs
:: run-lcs ( old new init step -- matrix ) :: run-lcs ( old new init step -- matrix )
old length 1 + new length 1 + init call :> matrix old length 1 + new length 1 + init call :> matrix
old length iota [| i | old length iota [| i |
new length iota new length iota [| j |
[| j | i j matrix old new step loop-step ] each i j matrix old new step loop-step
] each
] each matrix ; inline ] each matrix ; inline
PRIVATE> PRIVATE>
: levenshtein ( old new -- n ) : levenshtein ( old new -- n )
@ -41,17 +43,18 @@ TUPLE: delete item ;
TUPLE: insert item ; TUPLE: insert item ;
<PRIVATE <PRIVATE
TUPLE: trace-state old new table i j ; TUPLE: trace-state old new table i j ;
: old-nth ( state -- elt ) : old-nth ( state -- elt )
[ i>> 1 - ] [ old>> ] bi nth ; [ i>> 1 - ] [ old>> ] bi nth-unsafe ;
: new-nth ( state -- elt ) : new-nth ( state -- elt )
[ j>> 1 - ] [ new>> ] bi nth ; [ j>> 1 - ] [ new>> ] bi nth-unsafe ;
: top-beats-side? ( state -- ? ) : top-beats-side? ( state -- ? )
[ [ i>> ] [ j>> 1 - ] [ table>> ] tri nth nth ] [ [ i>> ] [ j>> 1 - ] [ table>> ] tri nth-unsafe nth-unsafe ]
[ [ i>> 1 - ] [ j>> ] [ table>> ] tri nth nth ] bi > ; [ [ i>> 1 - ] [ j>> ] [ table>> ] tri nth-unsafe nth-unsafe ] bi > ;
: retained? ( state -- ? ) : retained? ( state -- ? )
{ {
@ -91,7 +94,8 @@ TUPLE: trace-state old new table i j ;
: trace-diff ( old new table -- diff ) : trace-diff ( old new table -- diff )
[ ] [ first length 1 - ] [ length 1 - ] tri trace-state boa [ ] [ first length 1 - ] [ length 1 - ] tri trace-state boa
[ (trace-diff) ] { } make reverse ; [ (trace-diff) ] { } make reverse! ;
PRIVATE> PRIVATE>
: diff ( old new -- diff ) : diff ( old new -- diff )