lcs: performance improvements.

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