From 1005e5e9395aa3406f1742c404fa318c75b79158 Mon Sep 17 00:00:00 2001
From: Daniel Ehrenberg <microdan@gmail.com>
Date: Fri, 9 May 2008 15:42:02 -0500
Subject: [PATCH] Minor refactoring in lcs and interval-maps

---
 extra/interval-maps/interval-maps.factor | 22 ++++++++++------------
 extra/lcs/lcs.factor                     |  9 ++++-----
 2 files changed, 14 insertions(+), 17 deletions(-)

diff --git a/extra/interval-maps/interval-maps.factor b/extra/interval-maps/interval-maps.factor
index bc46fd986b..904b76ce94 100755
--- a/extra/interval-maps/interval-maps.factor
+++ b/extra/interval-maps/interval-maps.factor
@@ -1,4 +1,4 @@
-USING: kernel sequences arrays accessors
+USING: kernel sequences arrays accessors tuple-arrays
 math.order sorting math assocs locals namespaces ;
 IN: interval-maps
 
@@ -6,7 +6,6 @@ TUPLE: interval-map array ;
 
 <PRIVATE
 TUPLE: interval-node from to value ;
-: range ( node -- from to ) [ from>> ] [ to>> ] bi ;
 
 : fixup-value ( value ? -- value/f ? )
     [ drop f f ] unless* ;
@@ -14,12 +13,12 @@ TUPLE: interval-node from to value ;
 : find-interval ( key interval-map -- i )
     [ from>> <=> ] binsearch ;
 
-GENERIC: >interval ( object -- 2array )
-M: number >interval dup 2array ;
-M: sequence >interval ;
+: interval-contains? ( object interval-node -- ? )
+    [ from>> ] [ to>> ] bi between? ;
 
 : all-intervals ( sequence -- intervals )
-    [ >r >interval r> ] assoc-map ;
+    [ >r dup number? [ dup 2array ] when r> ] assoc-map
+    { } assoc-like ;
 
 : disjoint? ( node1 node2 -- ? )
     [ to>> ] [ from>> ] bi* < ;
@@ -28,8 +27,8 @@ M: sequence >interval ;
     dup [ disjoint? ] monotonic?
     [ "Intervals are not disjoint" throw ] unless ;
 
-: interval-contains? ( object interval-node -- ? )
-    range between? ;
+: >intervals ( specification -- intervals )
+    [ >r first2 r> interval-node boa ] { } assoc>map ;
 PRIVATE>
 
 : interval-at* ( key map -- value ? )
@@ -41,10 +40,9 @@ PRIVATE>
 : interval-key? ( key map -- ? ) interval-at* nip ;
 
 : <interval-map> ( specification -- map )
-    all-intervals { } assoc-like
-    [ [ first second ] compare ] sort
-    [ >r first2 r> interval-node boa ] { } assoc>map
-    ensure-disjoint interval-map boa ;
+    all-intervals [ [ first second ] compare ] sort
+    >intervals ensure-disjoint >tuple-array
+    interval-map boa ;
 
 :: coalesce ( alist -- specification )
     ! Only works with integer keys, because they're discrete
diff --git a/extra/lcs/lcs.factor b/extra/lcs/lcs.factor
index cdebfc4325..e5155a786e 100755
--- a/extra/lcs/lcs.factor
+++ b/extra/lcs/lcs.factor
@@ -7,7 +7,7 @@ IN: lcs
     0 1 ? + >r [ 1+ ] bi@ r> min min ;
 
 : lcs-step ( insert delete change same? -- next )
-    1 -9999 ? + max max ; ! Replace -9999 with -inf when added
+    1 -1./0. ? + max max ; ! -1./0. is -inf (float)
 
 :: loop-step ( i j matrix old new step -- )
     i j 1+ matrix nth nth ! insertion
@@ -25,10 +25,9 @@ IN: lcs
 
 :: run-lcs ( old new init step -- matrix )
     [let | matrix [ old length 1+ new length 1+ init call ] |
-        old length [0,b) [| i |
-            new length [0,b)
-            [| j | i j matrix old new step loop-step ]
-            each
+        old length [| i |
+            new length
+            [| j | i j matrix old new step loop-step ] each
         ] each matrix ] ; inline
 PRIVATE>