steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

release
Alex Chapman 2007-10-01 15:08:44 +10:00
parent f4540c0697
commit 5cd4054ec7
2 changed files with 33 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
extra/math/ranges/ranges-tests.factor
View File

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

23
extra/math/ranges/ranges.factor
View File

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