Minor refactoring in lcs and interval-maps

db4
Daniel Ehrenberg 2008-05-09 15:42:02 -05:00
parent c04da7bdfb
commit 1005e5e939
2 changed files with 14 additions and 17 deletions
extra

View File

@ -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

View File

@ -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>