Minor refactoring in lcs and interval-maps
parent
c04da7bdfb
commit
1005e5e939
extra
interval-maps
lcs
|
@ -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
|
||||
|
|
|
@ -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>
|
||||
|
||||
|
|
Loading…
Reference in New Issue