! 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 ;
+USING: accessors alien.c-types arrays assocs binary-search
+classes combinators kernel make math math.order sequences
+sequences.private sorting specialized-arrays ;
+SPECIALIZED-ARRAY: uint
IN: interval-sets
! Sets of positive integers
+! Intervals are a pair of { start end }
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 } ;
+: interval-in? ( key set -- ? )
+ interval-set check-instance array>>
+ dupd [ <=> ] with search swap [
+ even? [ >= ] [ 1 - <= ] if
+ ] [ 2drop f ] if* ;
<PRIVATE
[ dup number? [ dup 2array ] when ] map ;
: disjoint? ( node1 node2 -- ? )
- [ end ] [ start ] bi* < ;
+ [ second-unsafe ] [ first-unsafe ] bi* < ;
: (delete-redundancies) ( seq -- )
dup length {
drop dup first2 <
[ unclip-slice , ]
[ 2 tail-slice ] if
- (delete-redundancies)
+ (delete-redundancies)
]
} case ;
interval-set boa ;
: >intervals ( seq -- seq' )
- [ 1+ ] assoc-map concat ;
+ [ 1 + ] assoc-map concat ;
PRIVATE>
0 over ?nth zero? [ rest ] [ 0 prefix ] if ;
: interval-max ( interval-set1 interval-set2 -- n )
- [ array>> [ 0 ] [ peek ] if-empty ] bi@ max ;
+ [ array>> [ 0 ] [ last ] if-empty ] bi@ max ;
PRIVATE>