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

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

db4
John Benediktsson 2012-10-05 14:48:05 -07:00
parent 9dafa325a5
commit 5f4bf4513b
2 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
extra/math/extras/extras-tests.factor
View File

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

14
extra/math/extras/extras.factor
View File

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