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 { 57/200 } [ { 80 60 10 20 30 } herfindahl ] unit-test
{ 17/160 } [ { 80 60 10 20 30 } normalized-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 } } [ { { 0 5 1 2 2 } } [
{ -10 10 2 2.5 3 } { 1 2 3 4 5 } digitize] { -10 10 2 2.5 3 } { 1 2 3 4 5 } digitize]
] unit-test ] 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 grouping kernel locals math math.combinatorics math.constants
math.functions math.order math.primes math.ranges math.functions math.order math.primes math.ranges
math.ranges.private math.statistics math.vectors memoize random 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 IN: math.extras
@ -197,29 +198,17 @@ PRIVATE>
: exponential-index ( seq -- x ) : exponential-index ( seq -- x )
dup sum '[ _ / dup ^ ] map-product ; 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 ) : 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 ) : unique-indices ( seq -- unique indices )
[ members ] keep over dup length iota H{ } zip-as '[ _ at ] map ; [ members ] keep over dup length iota H{ } zip-as '[ _ at ] map ;
: digitize] ( seq bins -- seq' ) : digitize] ( seq bins -- seq' )
'[ _ search-sorted] ] map ; '[ _ bisect-left ] map ;
: digitize) ( seq bins -- seq' ) : digitize) ( seq bins -- seq' )
'[ _ search-sorted) ] map ; '[ _ bisect-right ] map ;
<PRIVATE <PRIVATE