diff options
Diffstat (limited to 'randinex.scm')
| -rw-r--r-- | randinex.scm | 44 |
1 files changed, 20 insertions, 24 deletions
diff --git a/randinex.scm b/randinex.scm index 1c2b702..e6dc48b 100644 --- a/randinex.scm +++ b/randinex.scm @@ -22,28 +22,26 @@ ;;; Fixed sphere and normal functions from: Harald Hanche-Olsen -(define random:float-radix - (+ 1 (exact->inexact random:MASK))) - -;;; This determines how many chunks will be neccessary to completely -;;; fill up an inexact real. -(define (random:size-float l x) - (cond ((= 1.0 (+ 1 x)) l) - ((= 4 l) l) - (else (random:size-float (+ l 1) (/ x random:float-radix))))) -(define random:chunks/float (random:size-float 0 1.0)) - -(define (random:uniform-chunk n state) - (if (= 1 n) - (/ (exact->inexact (random:chunk state)) - random:float-radix) - (/ (+ (random:uniform-chunk (- n 1) state) - (exact->inexact (random:chunk state))) - random:float-radix))) - ;;; Generate an inexact real between 0 and 1. -(define (random:uniform state) - (random:uniform-chunk random:chunks/float state)) +(define random:uniform + (letrec ((random:chunks/float ; how many chunks fill an inexact? + (letrec ((random:size-float + (lambda (l x) + (cond ((= 1.0 (+ 1 x)) l) + ((= 4 l) l) + (else (random:size-float (+ l 1) (/ x 256.0))))))) + (random:size-float 0 1.0))) + + (random:uniform-chunk + (lambda (n state) + (if (= 1 n) + (/ (exact->inexact (random:chunk state)) + 256.0) + (/ (+ (random:uniform-chunk (- n 1) state) + (exact->inexact (random:chunk state))) + 256.0))))) + (lambda (state) + (random:uniform-chunk random:chunks/float state)))) ;;; If x and y are independent standard normal variables, then with ;;; x=r*cos(t), y=r*sin(t), we find that t is uniformly distributed @@ -81,7 +79,7 @@ ;;; For the uniform distribution on the solid sphere, note that in ;;; this distribution the length r of the vector has cumulative -;;; distribution r^n; i.e., u=r^n is uniform [0,1], so r kan be +;;; distribution r^n; i.e., u=r^n is uniform [0,1], so r can be ;;; generated as r=u^(1/n). (define (random:solid-sphere! vect . args) @@ -95,5 +93,3 @@ (define (random:exp . args) (let ((state (if (null? args) *random-state* (car args)))) (- (log (random:uniform state))))) - -(require 'random) |