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

random: Add random-unit word. 1 random-unit - is the same distribution, as Joe pointed out, so remove that. Use random-unit in librarie.

db4
Doug Coleman 2012-03-30 17:56:00 -07:00
parent b23f3f8d56
commit 6686cae347
3 changed files with 13 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
basis/combinators/random/random.factor
View File

@ -5,7 +5,7 @@ kernel macros math math.order quotations random sequences
summary ;
IN: combinators.random
: ifp ( p true false -- ) [ 0 1 uniform-random-float > ] 2dip if ; inline
: ifp ( p true false -- ) [ random-unit > ] 2dip if ; inline
: whenp ( p true -- ) [ ] ifp ; inline
: unlessp ( p false -- ) [ [ ] ] dip ifp ; inline
@ -38,7 +38,7 @@ M: bad-probabilities summary
MACRO: (casep) ( assoc -- ) (casep>quot) ;
: casep>quot ( assoc -- quot )
(casep>quot) [ 0 1 uniform-random-float ] prepend ;
(casep>quot) [ random-unit ] prepend ;
: (conditional-probabilities) ( seq i -- p )
[ dup 0 > [ head [ 1 swap - ] [ * ] map-reduce ] [ 2drop 1 ] if ] [ swap nth ] 2bi * ;
@ -66,4 +66,4 @@ MACRO: casep* ( assoc -- ) direct>conditional casep>quot ;
MACRO: call-random ( seq -- ) call-random>casep casep>quot ;
MACRO: execute-random ( seq -- )
[ 1quotation ] map call-random>casep casep>quot ;
[ 1quotation ] map call-random>casep casep>quot ;

13
basis/random/random.factor
View File

@ -102,11 +102,14 @@ ERROR: too-many-samples seq n ;
[ over - 2.0 -64 ^ * ] dip
* + ; inline
: random-unit ( -- n )
0.0 1.0 uniform-random-float ; inline
: (cos-random-float) ( -- n )
0. 2. pi * uniform-random-float cos ;
0. 2pi uniform-random-float cos ;
: (log-sqrt-random-float) ( -- n )
0. 1. uniform-random-float log -2. * sqrt ;
random-unit log -2. * sqrt ;
: normal-random-float ( mean sigma -- n )
(cos-random-float) (log-sqrt-random-float) * * + ;
@ -115,13 +118,13 @@ ERROR: too-many-samples seq n ;
normal-random-float exp ;
: exponential-random-float ( lambda -- n )
0. 1. uniform-random-float log neg swap / ;
random-unit log neg swap / ;
: weibull-random-float ( lambda k -- n )
[ 0. 1. uniform-random-float log neg ] dip 1. swap / ^ * ;
[ random-unit log neg ] dip 1. swap / ^ * ;
: pareto-random-float ( alpha -- n )
[ 0. 1. uniform-random-float ] dip [ 1. swap / ] bi@ ^ ;
[ random-unit ] dip [ 1. swap / ] bi@ ^ ;
: beta-random-float ( alpha beta -- n )
[ 1. normal-random-float ] dip over zero?

4
extra/chipmunk/demo/demo.factor
View File

@ -110,8 +110,8 @@ M:: chipmunk-world begin-game-world ( world -- )
image-height iota [| y |
image-width iota [| x |
x y get-pixel [
x image-width 2 / - 0.05 0.0 1.0 uniform-random-float * + 2 *
image-height 2 / y - 0.05 0.0 1.0 uniform-random-float * + 2 *
x image-width 2 / - 0.05 random-unit * + 2 *
image-height 2 / y - 0.05 random-unit * + 2 *
make-ball :> shape
space shape shape>> body>> cpSpaceAddBody drop
space shape cpSpaceAddShape drop