diff --git a/extra/trees/interval/authors.txt b/extra/trees/interval/authors.txt new file mode 100755 index 0000000000..504363d316 --- /dev/null +++ b/extra/trees/interval/authors.txt @@ -0,0 +1 @@ +Daniel Ehrenberg diff --git a/extra/trees/interval/interval-tests.factor b/extra/trees/interval/interval-tests.factor new file mode 100755 index 0000000000..ef3cf08895 --- /dev/null +++ b/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 + + 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 diff --git a/extra/trees/interval/interval.factor b/extra/trees/interval/interval.factor new file mode 100755 index 0000000000..9b3b4a4c6c --- /dev/null +++ b/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 ; +: ( 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 r> r> set-at ] + [ root>> swapd update-max-under ] 3bi ; + +: add-single ( value key tree -- ) dupd add-range ; diff --git a/extra/trees/interval/summary.txt b/extra/trees/interval/summary.txt new file mode 100755 index 0000000000..e4f4ad152f --- /dev/null +++ b/extra/trees/interval/summary.txt @@ -0,0 +1 @@ +Interval trees for disjoint closed ranges