From f61bf2f4c4d81ad4142da4b27eb03a19e30e4347 Mon Sep 17 00:00:00 2001 From: John Benediktsson Date: Wed, 4 Sep 2013 21:31:34 -0700 Subject: [PATCH] math.extras: faster search-sorted by bisecting. --- extra/math/extras/extras.factor | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/extra/math/extras/extras.factor b/extra/math/extras/extras.factor index b02d1a28f5..5003d2129b 100644 --- a/extra/math/extras/extras.factor +++ b/extra/math/extras/extras.factor @@ -6,7 +6,7 @@ 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 sets sorting ; +sequences sequences.extras sequences.private sets sorting ; IN: math.extras @@ -197,11 +197,17 @@ PRIVATE> : exponential-index ( seq -- x ) dup sum '[ _ / dup ^ ] map-product ; -: search-sorted] ( obj seq -- i ) - swap '[ [ _ >= ] find drop dup ] [ length ] bi ? ; +:: 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 ) - swap '[ [ _ > ] find drop dup ] [ length ] bi ? ; +:: 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 ;