From 5cd4054ec7410c6c11389c8c1cddfdf613145881 Mon Sep 17 00:00:00 2001 From: Alex Chapman Date: Mon, 1 Oct 2007 15:08:44 +1000 Subject: [PATCH] additions to math.ranges, including range-min, range-max, clamp-to-range, and sequence-index-range --- extra/math/ranges/ranges-tests.factor | 11 +++++++++++ extra/math/ranges/ranges.factor | 23 ++++++++++++++++++++++- 2 files changed, 33 insertions(+), 1 deletion(-) diff --git a/extra/math/ranges/ranges-tests.factor b/extra/math/ranges/ranges-tests.factor index 98a7525910..09416814bd 100644 --- a/extra/math/ranges/ranges-tests.factor +++ b/extra/math/ranges/ranges-tests.factor @@ -21,3 +21,14 @@ IN: temporary [ { 0 1/3 2/3 1 } ] [ 0 1 1/3 >array ] unit-test [ { 0 1/3 2/3 1 } ] [ 1 0 -1/3 >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 diff --git a/extra/math/ranges/ranges.factor b/extra/math/ranges/ranges.factor index b84773b7d4..83a95c312d 100644 --- a/extra/math/ranges/ranges.factor +++ b/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) ;