]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/interval-sets/interval-sets.factor
basis: use lint.vocabs tool to trim using lists
[factor.git] / basis / interval-sets / interval-sets.factor
index b1d49a18a8453dffa22f655fa18fb5f6764eb595..593ad17fd30ef64ae80270eccb3ba51207ce11e8 100644 (file)
@@ -1,30 +1,20 @@
 ! 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
 
@@ -32,7 +22,7 @@ HINTS: in? { integer interval-set } ;
     [ dup number? [ dup 2array ] when ] map ;
 
 : disjoint? ( node1 node2 -- ? )
-    [ end ] [ start ] bi* < ;
+    [ second-unsafe ] [ first-unsafe ] bi* < ;
 
 : (delete-redundancies) ( seq -- )
     dup length {
@@ -42,7 +32,7 @@ HINTS: in? { integer interval-set } ;
             drop dup first2 <
             [ unclip-slice , ]
             [ 2 tail-slice ] if
-            (delete-redundancies) 
+            (delete-redundancies)
         ]
     } case ;
 
@@ -56,7 +46,7 @@ HINTS: in? { integer interval-set } ;
     interval-set boa ;
 
 : >intervals ( seq -- seq' )
-    [ 1+ ] assoc-map concat ;
+    [ 1 + ] assoc-map concat ;
 
 PRIVATE>
 
@@ -97,7 +87,7 @@ 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>