! Empty range
{ 0 } [ 1 0 1 <range> sum ] unit-test
+
+{ t } [ 4 4 10 2 <range> in? ] unit-test
+{ t } [ 6 4 10 2 <range> in? ] unit-test
+{ t } [ 10 4 10 2 <range> in? ] unit-test
+{ t } [ -6 4 -10 -2 <range> in? ] unit-test
+{ t } [ 6 10 4 -1 <range> in? ] unit-test
+
+{ f } [ 5 4 10 2 <range> in? ] unit-test
+{ f } [ 3 4 10 2 <range> in? ] unit-test
+{ f } [ 4.0 4 10 2 <range> in? ] unit-test
+{ f } [ 6.0 4 10 2 <range> in? ] unit-test
+{ f } [ 10.0 4 10 2 <range> in? ] unit-test
+
+{ { } } [ 1 8 2 <range> 2 9 2 <range> intersect >array ] unit-test
+{ { } } [ 1 8 2 <range> 8 1 -2 <range> intersect >array ] unit-test
+{ { } } [ 1 -9 1 <range> 1 8 1 <range> intersect >array ] unit-test
+{ { 13 19 25 31 37 43 49 } } [
+ 1 100 3 <range> 11 50 2 <range> intersect >array ] unit-test
+{ { 6 } } [
+ 6 7 1 <range> 6 -20 -4 <range> intersect >array ] unit-test
+
+{ f } [ 1 8 2 <range> 2 9 2 <range> intersects? ] unit-test
+{ f } [ 1 8 2 <range> 8 1 -2 <range> intersects? ] unit-test
+{ f } [ 1 -9 1 <range> 1 8 1 <range> intersects? ] unit-test
+{ t } [ 1 100 3 <range> 11 50 2 <range> intersects? ] unit-test
+{ t } [ 6 7 1 <range> 6 -20 -4 <range> intersects? ] unit-test
+
+{ t } [ 6 9 2 <range> 6 8 2 <range> set= ] unit-test
+{ t } [ 2 9 2 <range> 8 1 -2 <range> set= ] unit-test
+{ t } [ 9 0 3 <range> 4 8 -2 <range> set= ] unit-test
+{ f } [ 1 8 1 <range> 1 8 2 <range> set= ] unit-test
+
+{ t } [ 3 10 4 <range> 1 10 2 <range> subset? ] unit-test
+{ t } [ 1 0 1 <range> 10 2 1 <range> subset? ] unit-test
+{ f } [ 1 10 2 <range> 3 10 4 <range> subset? ] unit-test
\ No newline at end of file
! Copyright (C) 2008, 2010 Slava Pestov.
! See https://factorcode.org/license.txt for BSD license.
-USING: accessors classes.tuple kernel math math.order sequences
-sequences.private ;
+USING: accessors classes.algebra classes.tuple kernel locals
+math nath.functions math.order sequences sequences.private
+sets sorting ;
IN: ranges
TUPLE: range
: [0..b) ( b -- range ) 0 swap [a..b) ; inline
: [1..b) ( b -- range ) 1 swap [a..b) ; inline
+
+
+! Some methods can be much faster for ranges
+M: range in?
+ over number?
+ [ [ from>> ] [ step>> ] [ length>> 1 - ] tri
+ [ * over + sort-pair between? ] 4keep
+ drop 3dup [ - ] dip /i * + = and
+ ] [ 2drop f ] if ;
+
+M: range cardinality length>> ;
+
+M: range all-unique? drop t ;
+
+M: range duplicates drop f ;
+
+<PRIVATE
+
+: start-stop-step>> ( range -- start stop step )
+ [ from>> ] [ step>> ]
+ [ length>> 1 - 2over swapd * + ] tri swap ;
+
+: rev-range ( range -- range' )
+ start-stop-step>> neg swapd <range> ;
+
+: abs-step ( range -- range' )
+ dup step>> neg? [ rev-range ] when ; inline
+
+: empty-range ( -- range ) 1 0 1 <range> ;
+
+! https://github.com/JuliaLang/julia/blob/8e14322b5aa344639dd86bf9eabb84afe831fcba/base/range.jl#L1185
+:: (intersect) ( range1 range2 -- range' )
+ range1 empty? range2 empty? or [ empty-range ] [
+
+ range1 abs-step start-stop-step>> :> ( start1 stop1 step1 )
+ range2 abs-step start-stop-step>> :> ( start2 stop2 step2 )
+
+ step1 step2 lcm :> a
+ step1 step2 gcd :> ( x g )
+
+ start1 start2 - g /mod :> ( z y )
+
+ y zero? not [ empty-range ] [
+
+ start1 x z step1 * * - :> b
+
+ start1 start2 [ b over - a rem + ] bi@ max :> m
+ stop1 stop2 [ dup b - a rem - ] bi@ min :> n
+
+ m n a <range>
+ ] if ] if ;
+
+PRIVATE>
+
+M: range intersect
+ over range? [ (intersect) ] [ call-next-method ] if ;
+
+M: range intersects?
+ over range?
+ [ intersect length>> zero? not ]
+ [ call-next-method ] if ;
+
+M: range set=
+ over range?
+ [ [ abs-step ] bi@ = ]
+ [ call-next-method ] if ;
+
+M: range subset?
+ swap [ drop t ] [ swap over range?
+ [ dupd (intersect) = ] [ call-next-method ] if
+ ] if-empty ;
\ No newline at end of file