Coalesce function for interval maps
parent
fdc9d554e4
commit
e82fb3b6dc
|
@ -11,3 +11,8 @@ SYMBOL: test
|
||||||
[ 2 ] [ 1 test get interval-at ] unit-test
|
[ 2 ] [ 1 test get interval-at ] unit-test
|
||||||
[ f ] [ 2 test get interval-at ] unit-test
|
[ f ] [ 2 test get interval-at ] unit-test
|
||||||
[ f ] [ 0 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
|
USING: kernel sequences arrays math.intervals accessors
|
||||||
math.order sorting math assocs ;
|
math.order sorting math assocs locals namespaces ;
|
||||||
IN: interval-maps
|
IN: interval-maps
|
||||||
|
|
||||||
TUPLE: interval-map array ;
|
TUPLE: interval-map array ;
|
||||||
|
@ -24,6 +24,8 @@ M: interval >interval ;
|
||||||
: ensure-disjoint ( intervals -- intervals )
|
: ensure-disjoint ( intervals -- intervals )
|
||||||
dup keys [ interval-intersect not ] monotonic?
|
dup keys [ interval-intersect not ] monotonic?
|
||||||
[ "Intervals are not disjoint" throw ] unless ;
|
[ "Intervals are not disjoint" throw ] unless ;
|
||||||
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: interval-at* ( key map -- value ? )
|
: interval-at* ( key map -- value ? )
|
||||||
|
@ -35,7 +37,20 @@ PRIVATE>
|
||||||
: interval-key? ( key map -- ? ) interval-at* nip ;
|
: interval-key? ( key map -- ? ) interval-at* nip ;
|
||||||
|
|
||||||
: <interval-map> ( specification -- map )
|
: <interval-map> ( specification -- map )
|
||||||
all-intervals ensure-disjoint
|
all-intervals { } assoc-like
|
||||||
[ [ first to>> ] compare ] sort
|
[ [ first to>> ] compare ] sort ensure-disjoint
|
||||||
[ interval-node boa ] { } assoc>map
|
[ interval-node boa ] { } assoc>map
|
||||||
interval-map boa ;
|
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