Replacing interval trees with interval maps, which are sound

db4
Daniel Ehrenberg 2008-05-05 17:38:44 -05:00
parent 4a9b5d2127
commit fdc9d554e4
9 changed files with 85 additions and 64 deletions

View File

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

View File

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

View File

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

View File

@ -0,0 +1 @@
Interval maps for disjoint closed ranges

1
extra/interval-maps/tags.txt Executable file
View File

@ -0,0 +1 @@
collections

View File

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

View File

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

View File

@ -1 +0,0 @@
Interval trees for disjoint closed ranges