source: project/release/4/srfi-27/trunk/srfi-27-normals.scm @ 35456

Last change on this file since 35456 was 35456, checked in by Kon Lovett, 17 months ago

begin typing, dep /

File size: 1.5 KB
Line 
1;;;; srfi-27-normals.scm
2;;;; Kon Lovett, Dec '17
3;;;; Kon Lovett, Jun '17
4;;;; Kon Lovett, May '06
5
6; Chicken Generic Arithmetic! (could use fp routines)
7
8(module srfi-27-normals
9
10(;export
11  *make-random-normals
12  make-random-normals)
13
14(import scheme chicken)
15
16(use
17  (only type-errors error-argument-type)
18  (only type-checks
19    define-check+error-type
20    check-procedure
21    check-cardinal-integer
22    check-real
23    check-open-interval
24    check-closed-interval)
25  srfi-27
26  srfi-27-distributions-support)
27
28;;; Normal distribution
29
30;; Knuth's "The Art of Computer Programming", Vol. II, 2nd ed.,
31;; Algorithm P of Section 3.4.1.C.
32
33(define (*make-random-normals mu sigma randoms)
34  (let ((next #f))
35    (lambda ()
36      (if next
37        (let ((result next))
38          (set! next #f)
39          (+ mu (* sigma result)))
40        (let loop ()
41          (let* (
42            (v1 (- (* 2.0 (randoms)) 1.0) )
43            (v2 (- (* 2.0 (randoms)) 1.0) )
44            (s (+ (* v1 v1) (* v2 v2)) ) )
45            ;
46            (if (<= 1.0 s)
47              (loop)
48              (let ((scale (sqrt (/ (* -2.0 (log s)) s))))
49                (set! next (* scale v2))
50                (+ mu (* sigma scale v1))))))))) )
51
52(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
53  (check-real 'make-random-normals mu 'mu)
54  (check-nonzero-real 'make-random-normals sigma 'sigma)
55  (check-procedure 'make-random-normals randoms 'randoms)
56  (values
57    (*make-random-normals mu sigma randoms)
58    (lambda () (values mu sigma randoms))) )
59
60) ;module srfi-27-normals
Note: See TracBrowser for help on using the repository browser.