69 lines
2.7 KiB
Racket
69 lines
2.7 KiB
Racket
#lang typed/racket/base
|
|
|
|
;; Return random samples from a normal distribution using the Box-Muller transform
|
|
|
|
(require racket/fixnum
|
|
"../../../flonum.rkt"
|
|
"../../../base.rkt"
|
|
"../../unsafe.rkt")
|
|
|
|
(provide flnormal-sample)
|
|
|
|
;; Leaving these in, in case we discover in the future that it's actually important for them
|
|
;; to be accurate
|
|
#|
|
|
(: flsin2pix (Flonum -> Flonum))
|
|
;; Computes sin(2*pi*x) accurately in the range [0,1]
|
|
(define (flsin2pix x)
|
|
(let*-values ([(x s) (if (x . fl> . 0.5) (values (fl- x 0.5) -1.0) (values x 1.0))]
|
|
[(x) (if (x . fl> . 0.25) (fl- 0.5 x) x)])
|
|
(fl* s (flsin (fl* (fl* 2.0 pi) x)))))
|
|
|
|
(: flcos2pix (Flonum -> Flonum))
|
|
;; Computes cos(2*pi*x) accurately in the range [0,1]
|
|
(define (flcos2pix x)
|
|
(let*-values ([(x) (if (x . fl> . 0.5) (fl- 1.0 x) x)]
|
|
[(x s) (if (x . fl> . 0.25) (values (fl- 0.5 x) 1.0) (values x -1.0))])
|
|
(fl* s (flsin (fl* (fl* 2.0 pi) (fl- x 0.25))))))
|
|
|#
|
|
|
|
(: nonzero-random (-> Flonum))
|
|
(define (nonzero-random)
|
|
(let ([u (random)])
|
|
(if (fl= u 0.0) (nonzero-random) u)))
|
|
|
|
(: flnormal-sample (Flonum Flonum Integer -> FlVector))
|
|
;; The Box-Muller method has an bad reputation, but undeservedly:
|
|
;; 1. There's nothing unstable about the floating-point implementation of the transform
|
|
;; 2. It has good tail behavior (i.e. it can return very unlikely numbers)
|
|
;; 3. With today's FPUs, there's no need to worry about computing `log' and `sin' (sheesh)
|
|
;; Points in favor: it's simple and fast
|
|
(define (flnormal-sample c s n)
|
|
(cond [(not (index? n)) (raise-argument-error 'flnormal-sample "Natural" 2 c s n)]
|
|
[else
|
|
(define xs (make-flvector n))
|
|
(cond
|
|
[(fx= n 0) xs]
|
|
[else
|
|
(define n-1 (fx- n 1))
|
|
(let loop ([#{i : Nonnegative-Fixnum} 0])
|
|
(cond [(i . fx< . n-1)
|
|
(define u1 (nonzero-random))
|
|
(define u2 (random))
|
|
(define t (flsqrt (fl* -2.0 (fllog u1))))
|
|
(define z (fl* (fl* 2.0 pi) u2))
|
|
(define x (fl* t (flcos z)))
|
|
(define y (fl* t (flsin z)))
|
|
(unsafe-flvector-set! xs i (fl+ c (fl* s x)))
|
|
(unsafe-flvector-set! xs (fx+ i 1) (fl+ c (fl* s y)))
|
|
(loop (fx+ i 2))]
|
|
[(i . fx= . n-1)
|
|
(define u1 (nonzero-random))
|
|
(define u2 (random))
|
|
(define x (fl* (flsqrt (fl* -2.0 (fllog u1)))
|
|
(flsin (fl* (fl* 2.0 pi) u2))))
|
|
(unsafe-flvector-set! xs i (fl+ c (fl* s x)))
|
|
xs]
|
|
[else
|
|
xs]))])]))
|