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

random: support "random" on floats (uses uniform-random-float).

db4
John Benediktsson 2012-10-05 14:47:40 -07:00
parent f7d58fff90
commit 9dafa325a5
1 changed files with 9 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
basis/random/random.factor
View File

@ -1,11 +1,12 @@
! Copyright (C) 2008 Doug Coleman. ! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.data arrays assocs USING: accessors alien.data arrays assocs byte-arrays
byte-arrays byte-vectors combinators combinators.short-circuit byte-vectors combinators combinators.short-circuit fry
fry hashtables hashtables.private hints io.backend io.binary hashtables hashtables.private hints io.backend io.binary
kernel locals math math.bitwise math.constants math.functions kernel locals math math.bitwise math.constants math.functions
math.order math.ranges namespaces sequences sequences.private math.order math.ranges namespaces sequences sequences.private
sets summary system typed vocabs ; sets summary system typed vocabs ;
QUALIFIED-WITH: alien.c-types c
IN: random IN: random
SYMBOL: system-random-generator SYMBOL: system-random-generator
@ -18,10 +19,10 @@ GENERIC: random-bytes* ( n tuple -- byte-array )
M: object random-bytes* ( n tuple -- byte-array ) M: object random-bytes* ( n tuple -- byte-array )
[ [ <byte-vector> ] keep 4 /mod ] dip [ [ <byte-vector> ] keep 4 /mod ] dip
[ pick '[ _ random-32* int <ref> _ push-all ] times ] [ pick '[ _ random-32* c:int <ref> _ push-all ] times ]
[ [
over zero? over zero?
[ 2drop ] [ random-32* int <ref> swap head append! ] if [ 2drop ] [ random-32* c:int <ref> swap head append! ] if
] bi-curry bi* B{ } like ; ] bi-curry bi* B{ } like ;
HINTS: M\ object random-bytes* { fixnum object } ; HINTS: M\ object random-bytes* { fixnum object } ;
@ -112,7 +113,7 @@ ERROR: too-many-samples seq n ;
<PRIVATE <PRIVATE
: (uniform-random-float) ( min max obj -- n ) : (uniform-random-float) ( min max obj -- n )
[ 4 4 ] dip [ random-bytes* uint deref >float ] curry bi@ [ 4 4 ] dip [ random-bytes* c:uint deref >float ] curry bi@
2.0 32 ^ * + 2.0 32 ^ * +
[ over - 2.0 -64 ^ * ] dip [ over - 2.0 -64 ^ * ] dip
* + ; inline * + ; inline
@ -122,6 +123,8 @@ PRIVATE>
: uniform-random-float ( min max -- n ) : uniform-random-float ( min max -- n )
random-generator get (uniform-random-float) ; inline random-generator get (uniform-random-float) ; inline
M: float random [ f ] [ 0.0 swap uniform-random-float ] if-zero ;
: random-unit ( -- n ) : random-unit ( -- n )
0.0 1.0 uniform-random-float ; inline 0.0 1.0 uniform-random-float ; inline