additions to math.ranges, including range-min, range-max, clamp-to-range, and sequence-index-range

extra/math/ranges/ranges-tests.factor

@@ -21,3 +21,14 @@ IN: temporary
 
 [ { 0 1/3 2/3 1 } ] [ 0 1 1/3 <range> >array ] unit-test
 [ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 <range> >array reverse ] unit-test
+
+[ t ] [ 5 [0,b] range-increasing? ] unit-test
+[ f ] [ 5 [0,b] range-decreasing? ] unit-test
+[ f ] [ -5 [0,b] range-increasing? ] unit-test
+[ t ] [ -5 [0,b] range-decreasing? ] unit-test
+[ 0 ] [ 5 [0,b] range-min ] unit-test
+[ 5 ] [ 5 [0,b] range-max ] unit-test
+[ 3 ] [ 3 5 [0,b] clamp-to-range ] unit-test
+[ 0 ] [ -1 5 [0,b] clamp-to-range ] unit-test
+[ 5 ] [ 6 5 [0,b] clamp-to-range ] unit-test
+[ { 0 1 2 3 4 } ] [ 5 sequence-index-range >array ] unit-test

extra/math/ranges/ranges.factor

@@ -38,4 +38,25 @@ INSTANCE: range immutable-sequence
 
 : [1,b] 1 swap [a,b] ;
 
-: [0,b) 0 swap (a,b] ;
+: [0,b) 0 swap [a,b) ;
+
+: range-increasing? ( range -- ? )
+    range-step 0 > ;
+
+: range-decreasing? ( range -- ? )
+    range-step 0 < ;
+
+: first-or-peek ( seq head? -- elt )
+    [ first ] [ peek ] if ;
+
+: range-min ( range -- min )
+    dup range-increasing? first-or-peek ;
+
+: range-max ( range -- max )
+    dup range-decreasing? first-or-peek ;
+
+: clamp-to-range ( n range -- n )
+    tuck range-min max swap range-max min ;
+
+: sequence-index-range  ( seq -- range )
+    length [0,b) ;