Replacing interval trees with interval maps, which are sound
Daniel Ehrenberg
parent
4a9b5d2127
commit
fdc9d554e4
|
|
@ -0,0 +1,29 @@
|
|||
USING: help.markup help.syntax ;
|
||||
IN: interval-maps
|
||||
|
||||
HELP: interval-at*
|
||||
{ $values { "key" "an object" } { "map" "an interval map" } { "value" "the value for the key, or f" } { "?" "whether the key is present" } }
|
||||
{ $description "Looks up a key in an interval map, returning the corresponding value if the item is in an interval in the map, and a boolean flag. The operation takes O(log n) time." } ;
|
||||
|
||||
HELP: interval-at
|
||||
{ $values { "key" "an object" } { "map" "an interval map" } { "value" "the value for the key, or f" } }
|
||||
{ $description "Looks up a key in an interval map, returning the value of the corresponding interval, or f if the interval is not present in the map." } ;
|
||||
|
||||
HELP: interval-key?
|
||||
{ $values { "key" "an object" } { "map" "an interval map" } { "?" "a boolean" } }
|
||||
{ $description "Tests whether an object is in an interval in the interval map, returning t if the object is present." } ;
|
||||
|
||||
HELP: <interval-map>
|
||||
{ $values { "specification" "an assoc" } { "map" "an interval map" } }
|
||||
{ $description "From a specification, produce an interval tree. The specification is an assoc where the keys are intervals, or pairs of numbers to represent intervals, or individual numbers to represent singleton intervals. The values are the values int he interval map. Construction time is O(n log n)." } ;
|
||||
|
||||
ARTICLE: "interval-maps" "Interval maps"
|
||||
"Interval maps are a mechanism, similar to assocs, where a set of closed intervals of keys are associated with values. As such, interval maps do not conform to the assoc protocol, because intervals of floats, for example, can be used, and it is impossible to get a list of keys in between."
|
||||
"The following operations are used to query interval maps:"
|
||||
{ $subsection interval-at* }
|
||||
{ $subsection interval-at }
|
||||
{ $subsection interval-key? }
|
||||
"Use the following to construct interval maps"
|
||||
{ $subsection <interval-map> } ;
|
||||
|
||||
ABOUT: "interval-maps"
|
||||
|
|
@ -0,0 +1,13 @@
|
|||
USING: kernel namespaces interval-maps tools.test ;
|
||||
IN: interval-maps.test
|
||||
|
||||
SYMBOL: test
|
||||
|
||||
[ ] [ { { { 4 8 } 3 } { 1 2 } } <interval-map> test set ] unit-test
|
||||
[ 3 ] [ 5 test get interval-at ] unit-test
|
||||
[ 3 ] [ 8 test get interval-at ] unit-test
|
||||
[ 3 ] [ 4 test get interval-at ] unit-test
|
||||
[ f ] [ 9 test get interval-at ] unit-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
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
USING: kernel sequences arrays math.intervals accessors
|
||||
math.order sorting math assocs ;
|
||||
IN: interval-maps
|
||||
|
||||
TUPLE: interval-map array ;
|
||||
|
||||
<PRIVATE
|
||||
TUPLE: interval-node interval value ;
|
||||
|
||||
: fixup-value ( value ? -- value/f ? )
|
||||
[ drop f f ] unless* ;
|
||||
|
||||
: find-interval ( key interval-map -- i )
|
||||
[ interval>> from>> first <=> ] binsearch ;
|
||||
|
||||
GENERIC: >interval ( object -- interval )
|
||||
M: number >interval [a,a] ;
|
||||
M: sequence >interval first2 [a,b] ;
|
||||
M: interval >interval ;
|
||||
|
||||
: all-intervals ( sequence -- intervals )
|
||||
[ >r >interval r> ] assoc-map ;
|
||||
|
||||
: ensure-disjoint ( intervals -- intervals )
|
||||
dup keys [ interval-intersect not ] monotonic?
|
||||
[ "Intervals are not disjoint" throw ] unless ;
|
||||
PRIVATE>
|
||||
|
||||
: interval-at* ( key map -- value ? )
|
||||
array>> [ find-interval ] 2keep swapd nth
|
||||
[ nip value>> ] [ interval>> interval-contains? ] 2bi
|
||||
fixup-value ;
|
||||
|
||||
: interval-at ( key map -- value ) interval-at* drop ;
|
||||
: interval-key? ( key map -- ? ) interval-at* nip ;
|
||||
|
||||
: <interval-map> ( specification -- map )
|
||||
all-intervals ensure-disjoint
|
||||
[ [ first to>> ] compare ] sort
|
||||
[ interval-node boa ] { } assoc>map
|
||||
interval-map boa ;
|
||||
|
|
@ -0,0 +1 @@
|
|||
Interval maps for disjoint closed ranges
|
||||
|
|
@ -0,0 +1 @@
|
|||
collections
|
||||
|
|
@ -1,21 +0,0 @@
|
|||
USING: kernel namespaces trees.avl trees.interval tools.test ;
|
||||
IN: trees.interval.test
|
||||
|
||||
SYMBOL: test
|
||||
|
||||
<avl> test set
|
||||
|
||||
[ f ] [ 2 test get interval-at ] unit-test
|
||||
[ ] [ 2 1 test get add-single ] unit-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
|
||||
|
||||
[ ] [ 3 4 8 test get add-range ] unit-test
|
||||
[ 3 ] [ 5 test get interval-at ] unit-test
|
||||
[ 3 ] [ 8 test get interval-at ] unit-test
|
||||
[ 3 ] [ 4 test get interval-at ] unit-test
|
||||
[ f ] [ 9 test get interval-at ] unit-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,42 +0,0 @@
|
|||
! Copyright (c) 2008 Daniel Ehrenberg
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: trees trees.avl kernel math accessors math.intervals
|
||||
math.order assocs ;
|
||||
IN: trees.interval
|
||||
|
||||
TUPLE: int-node interval max-under value ;
|
||||
: <int-node> ( value start end -- int-node )
|
||||
[ [a,b] ] keep rot int-node boa ;
|
||||
|
||||
: interval-choose-branch ( key node -- key left/right )
|
||||
dup left>> [
|
||||
max-under>> pick >= [ left>> ] [ right>> ] if
|
||||
] [ right>> ] if* ;
|
||||
|
||||
: (interval-at*) ( key node -- value ? )
|
||||
[
|
||||
2dup value>> interval>> interval-contains?
|
||||
[ nip value>> value>> t ]
|
||||
[ interval-choose-branch (interval-at*) ] if
|
||||
] [ drop f f ] if* ;
|
||||
|
||||
: interval-at* ( key tree -- value ? )
|
||||
root>> (interval-at*) ;
|
||||
|
||||
: interval-at ( key tree -- value ) interval-at* drop ;
|
||||
: interval-key? ( key tree -- ? ) interval-at* nip ;
|
||||
|
||||
: update-max-under ( max key node -- )
|
||||
! The outer conditional shouldn't be necessary
|
||||
[
|
||||
2dup key>> = [ 3drop ] [
|
||||
[ nip value>> [ max ] change-max-under drop ]
|
||||
[ choose-branch update-max-under ] 3bi
|
||||
] if
|
||||
] [ 2drop ] if* ;
|
||||
|
||||
: add-range ( value start end tree -- )
|
||||
[ >r over >r <int-node> r> r> set-at ]
|
||||
[ root>> swapd update-max-under ] 3bi ;
|
||||
|
||||
: add-single ( value key tree -- ) dupd add-range ;
|
||||
|
|
@ -1 +0,0 @@
|
|||
Interval trees for disjoint closed ranges
|
||||
Loading…
Reference in New Issue