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

math.extras: faster search-sorted by bisecting.

db4
John Benediktsson 2013-09-04 21:31:34 -07:00
parent 6e6adb036d
commit f61bf2f4c4
1 changed files with 11 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -6,7 +6,7 @@ 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 sets sorting ; sequences sequences.extras sequences.private sets sorting ;
IN: math.extras IN: math.extras
@ -197,11 +197,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 ) :: search-sorted] ( obj seq -- i )
swap '[ [ _ >= ] find drop dup ] [ length ] bi ? ; 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 ) :: search-sorted) ( obj seq -- i )
swap '[ [ _ > ] find drop dup ] [ length ] bi ? ; 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 ] [ search-sorted] ] bi swap nth ;