Coalesce function for interval maps
parent
fdc9d554e4
commit
e82fb3b6dc
|
@ -11,3 +11,8 @@ SYMBOL: test
|
|||
[ 2 ] [ 1 test get interval-at ] unit-test
|
||||
[ f ] [ 2 test get interval-at ] unit-test
|
||||
[ f ] [ 0 test get interval-at ] unit-test
|
||||
|
||||
[ { { { 1 4 } 3 } { { 4 8 } 6 } } <interval-map> ] must-fail
|
||||
|
||||
[ { { { 1 3 } 2 } { { 4 5 } 4 } { { 7 8 } 4 } } ]
|
||||
[ { { 1 2 } { 2 2 } { 3 2 } { 4 4 } { 5 4 } { 7 4 } { 8 4 } } coalesce ] unit-test
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
USING: kernel sequences arrays math.intervals accessors
|
||||
math.order sorting math assocs ;
|
||||
math.order sorting math assocs locals namespaces ;
|
||||
IN: interval-maps
|
||||
|
||||
TUPLE: interval-map array ;
|
||||
|
@ -24,6 +24,8 @@ M: interval >interval ;
|
|||
: ensure-disjoint ( intervals -- intervals )
|
||||
dup keys [ interval-intersect not ] monotonic?
|
||||
[ "Intervals are not disjoint" throw ] unless ;
|
||||
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: interval-at* ( key map -- value ? )
|
||||
|
@ -35,7 +37,20 @@ PRIVATE>
|
|||
: interval-key? ( key map -- ? ) interval-at* nip ;
|
||||
|
||||
: <interval-map> ( specification -- map )
|
||||
all-intervals ensure-disjoint
|
||||
[ [ first to>> ] compare ] sort
|
||||
all-intervals { } assoc-like
|
||||
[ [ first to>> ] compare ] sort ensure-disjoint
|
||||
[ interval-node boa ] { } assoc>map
|
||||
interval-map boa ;
|
||||
|
||||
:: coalesce ( assoc -- specification )
|
||||
! Only works with integer keys, because they're discrete
|
||||
! Makes 2array keys
|
||||
[
|
||||
assoc sort-keys unclip first2 dupd roll
|
||||
[| oldkey oldval key val | ! Underneath is start
|
||||
oldkey 1+ key =
|
||||
oldval val = and
|
||||
[ oldkey 2array oldval 2array , key ] unless
|
||||
key val
|
||||
] assoc-each [ 2array ] bi@ ,
|
||||
] { } make ;
|
||||
|
|
Loading…
Reference in New Issue