Interval sets library

db4
Daniel Ehrenberg 2009-03-26 18:15:22 -05:00 committed by John Benediktsson
parent 491bb6aa4c
commit deea270b57
3 changed files with 249 additions and 0 deletions

View File

@ -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." } ;

View File

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

View File

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