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

math.extras: switch to using sorting.extras.

db4
John Benediktsson 2013-09-05 21:09:32 -07:00
parent 13db93639f
commit 4797dae4f2
2 changed files with 5 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -73,14 +73,6 @@ 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 } digitize]
] unit-test

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

@ -6,7 +6,8 @@ combinators combinators.short-circuit compression.zlib fry
grouping kernel locals math math.combinatorics math.constants
math.functions math.order math.primes math.ranges
math.ranges.private math.statistics math.vectors memoize random
sequences sequences.extras sequences.private sets sorting ;
sequences sequences.extras sequences.private sets sorting
sorting.extras ;
IN: math.extras
@ -197,29 +198,17 @@ PRIVATE>
: exponential-index ( seq -- x )
dup sum '[ _ / dup ^ ] map-product ;
:: search-sorted] ( obj seq -- i )
0 seq length [ 2dup < ] [
2dup + 2/ dup seq nth-unsafe obj before?
[ swap [ nip 1 + ] dip ] [ nip ] if
] while drop ;
:: search-sorted) ( obj seq -- i )
0 seq length [ 2dup < ] [
2dup + 2/ dup seq nth-unsafe obj after?
[ nip ] [ swap [ nip 1 + ] dip ] if
] while drop ;
: weighted-random ( histogram -- obj )
unzip cum-sum [ last random ] [ search-sorted] ] bi swap nth ;
unzip cum-sum [ last random ] [ bisect-left ] 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 ;
'[ _ bisect-left ] map ;
: digitize) ( seq bins -- seq' )
'[ _ search-sorted) ] map ;
'[ _ bisect-right ] map ;
<PRIVATE