diff --git a/extra/math/extras/extras-tests.factor b/extra/math/extras/extras-tests.factor index d5232cb4dee..d55c1494c11 100644 --- 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 index 343ef902228..22c22bbcac1 100644 --- 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 ;