Interval trees

extra/trees/interval/authors.txt

@@ -0,0 +1 @@
+Daniel Ehrenberg

extra/trees/interval/interval-tests.factor

@@ -0,0 +1,21 @@
+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

extra/trees/interval/interval.factor

@@ -0,0 +1,42 @@
+! 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 ;

extra/trees/interval/summary.txt

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