math.extras: implement "search-sorted" and "weighted-random".

factor · Oct 5, 2012 · 5f4bf45 · 5f4bf45
1 parent 9dafa32
commit 5f4bf45
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 5 deletions.
diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: math math.extras math.ranges tools.test ;
+USING: math math.extras math.ranges sequences tools.test ;
 
 IN: math.extras.test
 
@@ -68,3 +68,7 @@ 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
+
+{ { 0 5 1 2 2 } } [
+    { -10 10 2 2.5 3 } [ { 1 2 3 4 5 } search-sorted ] map
+] unit-test
diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor
@@ -1,10 +1,10 @@
 ! Copyright (C) 2012 John Benediktsson
 ! See http://factorcode.org/license.txt for BSD license
 
-USING: combinators.short-circuit grouping kernel locals math
-math.combinatorics math.constants math.functions math.order
-math.primes math.ranges math.statistics math.vectors memoize
-sequences sequences.extras sorting assocs fry ;
+USING: assocs combinators.short-circuit fry grouping kernel
+locals math math.combinatorics math.constants math.functions
+math.order math.primes math.ranges math.statistics math.vectors
+memoize random sequences sequences.extras sorting ;
 
 IN: math.extras
 
@@ -188,3 +188,9 @@ PRIVATE>
 
 : exponential-index ( seq -- x )
     dup sum '[ _ / dup ^ ] map-product ;
+
+: 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 ;