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

math.extras: two versions of search-sorted.

db4
John Benediktsson 2013-09-04 19:01:25 -07:00
parent 71ca448ff2
commit 5eb9d4532d
2 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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