;;;; srfi-27-binomials.scm ;;;; Kon Lovett, Dec '17 ;;;; Kon Lovett, Jun '17 ;;;; Kon Lovett, May '06 ; Chicken Generic Arithmetic! (could use fp routines) (module srfi-27-binomials (;export *make-random-binomials make-random-binomials) (import scheme chicken) (use (only type-errors error-argument-type) (only type-checks define-check+error-type check-procedure check-cardinal-integer check-real check-open-interval check-closed-interval) srfi-27 srfi-27-distributions-support srfi-27-bernoullis) ;;; Binomial distribution (define (*make-random-binomials t p randoms) (let ((bernoullis (*make-random-bernoullis p randoms))) ;FIXME O(t) but O(log(t)) desired for >> t (if (fixnum? t) (lambda () (do ((i 0 (fx+ 1 i)) (n 0 (if (bernoullis) (fx+ 1 n) n))) ((fx<= t i) n))) (lambda () (do ((i 0 (add1 i)) (n 0 (if (bernoullis) (add1 n) n))) ((<= t i) n))))) ) (define (make-random-binomials #!key (t 1) (p 0.5) (randoms (random-real/current))) (check-cardinal-integer 'make-random-binomials t 't) (check-real-unit 'make-random-binomials p 'p) (check-procedure 'make-random-binomials randoms 'randoms) (values (*make-random-binomials t p randoms) (lambda () (values t p randoms))) ) ) ;module srfi-27-binomials