From 5eb9d4532d773e133d7173da9bcb1f98ba6244dc Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Wed, 4 Sep 2013 19:01:25 -0700
Subject: [PATCH] math.extras: two versions of search-sorted.

---
 extra/math/extras/extras-tests.factor | 17 ++++++++++++++++-
 extra/math/extras/extras.factor       | 13 +++++++++++--
 2 files changed, 27 insertions(+), 3 deletions(-)

diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
index 24d978c231..4348e3342e 100644
--- a/extra/math/extras/extras-tests.factor
+++ b/extra/math/extras/extras-tests.factor
@@ -73,8 +73,20 @@ IN: math.extras.test
 { 57/200 } [ { 80 60 10 20 30 } herfindahl ] unit-test
 { 17/160 } [ { 80 60 10 20 30 } normalized-herfindahl ] unit-test
 
+{ 1 } [ 1   5 iota search-sorted] ] unit-test
+{ 2 } [ 1.5 5 iota search-sorted] ] unit-test
+{ 2 } [ 2   5 iota search-sorted] ] unit-test
+
+{ 2 } [ 1   5 iota search-sorted) ] unit-test
+{ 2 } [ 1.5 5 iota search-sorted) ] unit-test
+{ 3 } [ 2   5 iota search-sorted) ] unit-test
+
 { { 0 5 1 2 2 } } [
-    { -10 10 2 2.5 3 } [ { 1 2 3 4 5 } search-sorted ] map
+    { -10 10 2 2.5 3 } { 1 2 3 4 5 } digitize]
+] unit-test
+
+{ { 0 5 2 2 3 } } [
+    { -10 10 2 2.5 3 } { 1 2 3 4 5 } digitize)
 ] unit-test
 
 {
@@ -138,3 +150,6 @@ IN: math.extras.test
 
 { { 0 1 2 3 0 0 1 } } [ { 1 2 3 3 2 1 2 } [ <= ] monotonic-count ] unit-test
 { 4 } [ { 1 2 3 1 2 3 4 5 } [ < ] max-monotonic-count ] unit-test
+
+{ 1.0 0.5 } [ 1.5 modf ] unit-test
+{ -1.0 -0.5 } [ -1.5 modf ] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
index 427c55caec..b02d1a28f5 100644
--- a/extra/math/extras/extras.factor
+++ b/extra/math/extras/extras.factor
@@ -197,15 +197,24 @@ PRIVATE>
 : exponential-index ( seq -- x )
     dup sum '[ _ / dup ^ ] map-product ;
 
-: search-sorted ( obj seq -- i )
+: search-sorted] ( obj seq -- i )
     swap '[ [ _ >= ] find drop dup ] [ length ] bi ? ;
 
+: search-sorted) ( obj seq -- i )
+    swap '[ [ _ > ] find drop dup ] [ length ] bi ? ;
+
 : weighted-random ( histogram -- obj )
-    unzip cum-sum [ last random ] [ search-sorted ] bi swap nth ;
+    unzip cum-sum [ last random ] [ search-sorted] ] bi swap nth ;
 
 : unique-indices ( seq -- unique indices )
     [ members ] keep over dup length iota H{ } zip-as '[ _ at ] map ;
 
+: digitize] ( seq bins -- seq' )
+    '[ _ search-sorted] ] map ;
+
+: digitize) ( seq bins -- seq' )
+    '[ _ search-sorted) ] map ;
+
 <PRIVATE
 
 : steps ( a b length -- a b step )