Interval sets library

diff --git a/basis/interval-sets/interval-sets-docs.factor b/basis/interval-sets/interval-sets-docs.factor
new file mode 100644 (file)
index 0000000..b85f320
--- /dev/null
+++ b/basis/interval-sets/interval-sets-docs.factor
@@ -0,0 +1,39 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: help.syntax help.markup math ;
+IN: interval-sets
+
+ABOUT: "interval-sets"
+
+ARTICLE: "interval-sets" "Interval sets"
+"The " { $vocab-link "interval-sets" } " vocabulary implements an efficient data structure for sets of positive, machine word-sized integers, specified by ranges. The space taken by the data structure is proportional to the number of intervals contained. Membership testing is O(log n), and creation is O(n log n), where n is the number of ranges. Boolean operations are O(n). Interval sets are immutable."
+{ $subsection interval-set }
+{ $subsection <interval-set> }
+{ $subsection in? }
+{ $subsection <interval-not> }
+{ $subsection <interval-and> }
+{ $subsection <interval-or> } ;
+
+HELP: interval-set
+{ $class-description "The class of interval sets." }
+{ $see-also "interval-sets" } ;
+
+HELP: <interval-set>
+{ $values { "specification" "a sequence of numbers and pairs of numbers" } { "interval-set" interval-set } }
+{ $description "Creates an interval set based on the specification. Pairs of numers are interpreted as intervals which include their endpoints, and individual numbers are interpreted to be in the set, in a singleton range." } ;
+
+HELP: in?
+{ $values { "key" integer } { "set" interval-set } { "?" { { $link t } " or " { $link f } } } }
+{ $description "Tests whether an integer is in an interval set. This takes O(log n) time for an interval map composed of n intervals." } ;
+
+HELP: <interval-and>
+{ $values { "set1" interval-set } { "set2" interval-set } { "set" interval-set } }
+{ $description "Calculates the intersection of two interval sets. This takes O(n+m) time, where the input interval maps have n and m intervals in them." } ;
+
+HELP: <interval-or>
+{ $values { "set1" interval-set } { "set2" interval-set } { "set" interval-set } }
+{ $description "Calculates the union of two interval sets. This takes O(n+m) time, where the input interval maps have n and m intervals in them." } ;
+
+HELP: <interval-not>
+{ $values { "set" interval-set } { "maximum" integer } { "set'" interval-set } }
+{ $description "Calculates the complement of an interval set. Because interval sets are finite, this takes an argument for the maximum integer in the domain considered. This takes time proportional to the size of the input." } ;

diff --git a/basis/interval-sets/interval-sets-tests.factor b/basis/interval-sets/interval-sets-tests.factor
new file mode 100644 (file)
index 0000000..6e2adde
--- /dev/null
+++ b/basis/interval-sets/interval-sets-tests.factor
@@ -0,0 +1,100 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: tools.test interval-sets math grouping sequences accessors
+combinators.short-circuit ;
+IN: interval-sets.tests
+
+[ f ] [ 0 T{ interval-set } in? ] unit-test
+[ f ] [ 2 T{ interval-set } in? ] unit-test
+
+: i1 ( n -- ? )
+    { { 3 4 } } <interval-set> ;
+
+[ f ] [ 2 i1 in? ] unit-test
+[ t ] [ 3 i1 in? ] unit-test
+[ t ] [ 4 i1 in? ] unit-test
+[ f ] [ 5 i1 in? ] unit-test
+
+CONSTANT: unicode-max HEX: 10FFFF
+
+: i2 ( n -- ? )
+    { { 3 4 } } <interval-set>
+    unicode-max <interval-not> ;
+
+[ t ] [ 2 i2 in? ] unit-test
+[ f ] [ 3 i2 in? ] unit-test
+[ f ] [ 4 i2 in? ] unit-test
+[ t ] [ 5 i2 in? ] unit-test
+
+: i3 ( n -- ? )
+    { { 2 4 } } <interval-set>
+    { { 6 8 } } <interval-set>
+    <interval-or> ;
+
+[ f ] [ 1 i3 in? ] unit-test
+[ t ] [ 2 i3 in? ] unit-test
+[ t ] [ 3 i3 in? ] unit-test
+[ t ] [ 4 i3 in? ] unit-test
+[ f ] [ 5 i3 in? ] unit-test
+[ t ] [ 6 i3 in? ] unit-test
+[ t ] [ 7 i3 in? ] unit-test
+[ t ] [ 8 i3 in? ] unit-test
+[ f ] [ 9 i3 in? ] unit-test
+
+: i4 ( n -- ? )
+    { { 2 4 } } <interval-set>
+    { { 6 8 } } <interval-set>
+    <interval-and> ;
+
+[ f ] [ 1 i4 in? ] unit-test
+[ f ] [ 2 i4 in? ] unit-test
+[ f ] [ 3 i4 in? ] unit-test
+[ f ] [ 4 i4 in? ] unit-test
+[ f ] [ 5 i4 in? ] unit-test
+[ f ] [ 6 i4 in? ] unit-test
+[ f ] [ 7 i4 in? ] unit-test
+[ f ] [ 8 i4 in? ] unit-test
+[ f ] [ 9 i4 in? ] unit-test
+
+: i5 ( n -- ? )
+    { { 2 5 } } <interval-set>
+    { { 4 8 } } <interval-set>
+    <interval-or> ;
+
+[ f ] [ 1 i5 in? ] unit-test
+[ t ] [ 2 i5 in? ] unit-test
+[ t ] [ 3 i5 in? ] unit-test
+[ t ] [ 4 i5 in? ] unit-test
+[ t ] [ 5 i5 in? ] unit-test
+[ t ] [ 6 i5 in? ] unit-test
+[ t ] [ 7 i5 in? ] unit-test
+[ t ] [ 8 i5 in? ] unit-test
+[ f ] [ 9 i5 in? ] unit-test
+
+: i6 ( n -- ? )
+    { { 2 5 } } <interval-set>
+    { { 4 8 } } <interval-set>
+    <interval-and> ;
+
+[ f ] [ 1 i6 in? ] unit-test
+[ f ] [ 2 i6 in? ] unit-test
+[ f ] [ 3 i6 in? ] unit-test
+[ t ] [ 4 i6 in? ] unit-test
+[ t ] [ 5 i6 in? ] unit-test
+[ f ] [ 6 i6 in? ] unit-test
+[ f ] [ 7 i6 in? ] unit-test
+[ f ] [ 8 i6 in? ] unit-test
+[ f ] [ 9 i6 in? ] unit-test
+
+: criterion ( interval-set -- ? )
+    array>> {
+        [ [ < ] monotonic? ]
+        [ length even? ]
+    } 1&& ;
+
+[ t ] [ i1 criterion ] unit-test
+[ t ] [ i2 criterion ] unit-test
+[ t ] [ i3 criterion ] unit-test
+[ t ] [ i4 criterion ] unit-test
+[ t ] [ i5 criterion ] unit-test
+[ t ] [ i6 criterion ] unit-test

diff --git a/basis/interval-sets/interval-sets.factor b/basis/interval-sets/interval-sets.factor
new file mode 100644 (file)
index 0000000..b1d49a1
--- /dev/null
+++ b/basis/interval-sets/interval-sets.factor
@@ -0,0 +1,110 @@
+! Copyright (C) 2009 Daniel Ehrenberg.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel sequences binary-search accessors math.order
+specialized-arrays.uint make grouping math arrays
+sorting assocs locals combinators fry hints ;
+IN: interval-sets
+! Sets of positive integers
+
+TUPLE: interval-set { array uint-array read-only } ;
+
+<PRIVATE
+
+ALIAS: start first
+ALIAS: end second
+
+: find-interval ( key interval-set -- slice )
+    array>> 2 <sliced-groups>
+    [ start <=> ] with search nip ; inline
+
+PRIVATE>
+
+: in? ( key set -- ? )
+    dupd find-interval
+    [ [ start ] [ end 1- ] bi between? ]
+    [ drop f ] if* ;
+
+HINTS: in? { integer interval-set } ;
+
+<PRIVATE
+
+: spec>pairs ( sequence -- intervals )
+    [ dup number? [ dup 2array ] when ] map ;
+
+: disjoint? ( node1 node2 -- ? )
+    [ end ] [ start ] bi* < ;
+
+: (delete-redundancies) ( seq -- )
+    dup length {
+        { 0 [ drop ] }
+        { 1 [ % ] }
+        [
+            drop dup first2 <
+            [ unclip-slice , ]
+            [ 2 tail-slice ] if
+            (delete-redundancies) 
+        ]
+    } case ;
+
+: delete-redundancies ( seq -- seq' )
+    ! If the next element is >= current one, leave out both
+    [ (delete-redundancies) ] uint-array{ } make ;
+
+: make-intervals ( seq -- interval-set )
+    uint-array{ } like
+    delete-redundancies
+    interval-set boa ;
+
+: >intervals ( seq -- seq' )
+    [ 1+ ] assoc-map concat ;
+
+PRIVATE>
+
+: <interval-set> ( specification -- interval-set )
+    spec>pairs sort-keys
+    >intervals make-intervals ;
+
+<PRIVATE
+
+:: or-step ( set1 set2 -- set1' set2' )
+    set1 first ,
+    set1 second set2 first <=
+    [ set1 0 ] [ set2 2 ] if
+    [ second , ] [ set2 swap tail-slice ] bi*
+    set1 2 tail-slice ;
+
+: combine-or ( set1 set2 -- )
+    {
+        { [ over empty? ] [ % drop ] }
+        { [ dup empty? ] [ drop % ] }
+        [
+            2dup [ first ] bi@ <=
+            [ swap ] unless
+            or-step combine-or
+        ]
+    } cond ;
+
+PRIVATE>
+
+: <interval-or> ( set1 set2 -- set )
+    [ array>> ] bi@
+    [ combine-or ] uint-array{ } make
+    make-intervals ;
+
+<PRIVATE
+
+: prefix-0 ( seq -- 0seq )
+    0 over ?nth zero? [ rest ] [ 0 prefix ] if ;
+
+: interval-max ( interval-set1 interval-set2 -- n )
+    [ array>> [ 0 ] [ peek ] if-empty ] bi@ max ;
+
+PRIVATE>
+
+: <interval-not> ( set maximum -- set' )
+    [ array>> prefix-0 ] dip suffix make-intervals ;
+
+: <interval-and> ( set1 set2 -- set )
+    2dup interval-max
+    [ '[ _ <interval-not> ] bi@ <interval-or> ] keep
+    <interval-not> ;