source: project/release/4/srfi-27/trunk/srfi-27-binomials.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.3 KB
Line 
1;;;; srfi-27-binomials.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-binomials
9
10(;export
11  *make-random-binomials
12  make-random-binomials)
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  srfi-27-bernoullis)
28
29;;; Binomial distribution
30
31(define (*make-random-binomials t p randoms)
32  (let ((bernoullis (*make-random-bernoullis p randoms)))
33    ;FIXME O(t) but O(log(t)) desired for >> t
34    (if (fixnum? t)
35      (lambda ()
36        (do ((i 0 (fx+ 1 i))
37             (n 0 (if (bernoullis) (fx+ 1 n) n)))
38            ((fx<= t i) n)))
39      (lambda ()
40        (do ((i 0 (add1 i))
41             (n 0 (if (bernoullis) (add1 n) n)))
42            ((<= t i) n))))) )
43
44(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (current-random-real)))
45  (check-cardinal-integer 'make-random-binomials t 't)
46  (check-real-unit 'make-random-binomials p 'p)
47  (check-procedure 'make-random-binomials randoms 'randoms)
48  (values
49    (*make-random-binomials t p randoms)
50    (lambda () (values t p randoms))) )
51
52) ;module srfi-27-binomials
Note: See TracBrowser for help on using the repository browser.