Changeset 35475 in project


Ignore:
Timestamp:
04/29/18 17:52:26 (4 weeks ago)
Author:
kon
Message:

add types for distributions

Location:
release/4/srfi-27/trunk
Files:
16 edited

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/trunk/srfi-27-bernoullis.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-bernoullis
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Bernoulli distribution
    2933
     34(: *make-random-bernoullis (number random-real-function --> boolean-function))
     35;
    3036(define (*make-random-bernoullis p randoms)
    3137  (cond
     
    3440    (else      (lambda () (<= (randoms) p)))) )
    3541
     42(: make-random-bernoullis (#!rest (list-of *) --> boolean-function procedure))
     43;
    3644(define (make-random-bernoullis #!key (p 0.5) (randoms (current-random-real)))
    3745  (check-real-unit 'make-random-bernoullis p 'p)
  • release/4/srfi-27/trunk/srfi-27-binomials.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-binomials
     
    2727  srfi-27-bernoullis)
    2828
     29;;;
     30
     31(include "srfi-27-common-types")
     32
    2933;;; Binomial distribution
    3034
     35(: *make-random-binomials (number number random-real-function --> number-function))
     36;
    3137(define (*make-random-binomials t p randoms)
    3238  (let ((bernoullis (*make-random-bernoullis p randoms)))
     
    4248            ((<= t i) n))))) )
    4349
     50(: make-random-binomials (#!rest (list-of *) --> number-function procedure))
     51;
    4452(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (current-random-real)))
    4553  (check-cardinal-integer 'make-random-binomials t 't)
  • release/4/srfi-27/trunk/srfi-27-cauchys.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-cauchys
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Cauchy distribution
    2933
     34(: *make-random-cauchys (number number random-real-function --> number-function))
     35;
    3036(define (*make-random-cauchys median sigma randoms)
    3137  (lambda ()
    3238    (+ median (* sigma (tan (* *pi* (- (randoms) 0.5)))))) )
    3339
     40(: make-random-cauchys (#!rest (list-of *) --> number-function procedure))
     41;
    3442(define (make-random-cauchys #!key (median 0.0) (sigma 1.0) (randoms (current-random-real)))
    3543  (check-real 'make-random-cauchys median 'median)
  • release/4/srfi-27/trunk/srfi-27-common-types.scm

    r35456 r35475  
    2626
    2727(define-type random-f64-function  (--> float))
     28
     29(define-type boolean-function (--> boolean))
     30
     31(define-type number-function (--> number))
  • release/4/srfi-27/trunk/srfi-27-distributions-support.scm

    r34967 r35475  
    88
    99(;export
    10   ;(use (only mathh mathh-consts))
    1110  *pi* *one-third*
    1211  ;
     
    2322
    2423(use
     24  (only mathh-consts pi)
    2525  (only type-errors error-argument-type)
    2626  (only type-checks
     
    3535;;; Constants
    3636
    37 (define *pi* 3.1415926535897932384626433832795028841972)
    38 (define *one-third* 0.3333333333333333333333333333333333333333)
     37(define *pi* pi)
     38
     39(define *one-third* (fp/ 1.0 3.0))
    3940
    4041;;; Chicken Generic Arithmetic Argument Checks
     
    7273;;; Mathh
    7374
    74 ;; (in case special processing needed near limits TBD)
     75;TODO in case special processing needed near limits
    7576
    76 (define (*reciprocal n)
    77   (/ 1.0 n) )
     77(define-syntax *reciprocal
     78  (syntax-rules ()
     79    ((_ ?n)
     80      (let ((n ?n)) (/ 1.0 n)) ) ) )
    7881
    79 (define (*-reciprocal n)
    80   (/ -1.0 n) )
     82(define-syntax *-reciprocal
     83  (syntax-rules ()
     84    ((_ ?n)
     85      (let ((n ?n)) (/ -1.0 n)) ) ) )
    8186
    8287) ;module srfi-27-distributions-support
  • release/4/srfi-27/trunk/srfi-27-erlangs.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-erlangs
     
    2727  srfi-27-gammas)
    2828
     29;;;
     30
     31(include "srfi-27-common-types")
     32
    2933;;; Erlang distribution
    3034
     35(: *make-random-erlangs (number number random-real-function --> number-function))
     36;
    3137(define (*make-random-erlangs alpha theta randoms)
    3238  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    3339
     40(: make-random-erlangs (#!rest (list-of *) --> number-function procedure))
     41;
    3442(define (make-random-erlangs #!key (alpha 1) (theta 1.0) (randoms (current-random-real)))
    3543  (check-positive-real 'make-random-erlangs alpha 'alpha)
  • release/4/srfi-27/trunk/srfi-27-exponentials.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-exponentials
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Exponential distribution
    2933
     
    3135;; Section 3.4.1.D.
    3236
     37(: *make-random-exponentials (number random-real-function --> number-function))
     38;
    3339(define (*make-random-exponentials mu randoms)
    3440  (if (= 1.0 mu)
     
    3642    (lambda () (* mu (- (log (randoms)))))) )
    3743
     44(: make-random-exponentials (#!rest (list-of *) --> number-function procedure))
     45;
    3846(define (make-random-exponentials #!key (mu 1.0) (randoms (current-random-real)))
    3947  (check-real-unit 'make-random-exponentials mu 'mu)
  • release/4/srfi-27/trunk/srfi-27-gammas.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-gammas
     
    2727  srfi-27-normals)
    2828
     29;;;
     30
     31(include "srfi-27-common-types")
     32
    2933;;; Gamma distribution
    3034
     
    3236;; ACM Transactions on Mathematical Software, Vol. 26, No. 3, September 2000, Pages 363 372.
    3337
     38(: *make-random-gammas (number number random-real-function --> number-function))
     39;
    3440(define (*make-random-gammas alpha theta randoms)
    3541  (if (= 1.0 alpha)
     
    7379                   (loop) ) ) ) ) ) ) ) ) )
    7480
     81(: make-random-gammas (#!rest (list-of *) --> number-function procedure))
     82;
    7583(define (make-random-gammas #!key (alpha 1.0) (theta 1.0) (randoms (current-random-real)))
    7684  (check-positive-real 'make-random-gammas alpha 'alpha)
  • release/4/srfi-27/trunk/srfi-27-geometrics.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-geometrics
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Geometric distribution
    2933
     34(: *make-random-geometrics  (number random-real-function --> number-function))
     35;
    3036(define (*make-random-geometrics p randoms)
    3137  (let ((log-p (log p)))
     
    3339      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    3440
     41(: make-random-geometrics (#!rest (list-of *) --> number-function procedure))
     42;
    3543(define (make-random-geometrics #!key (p 0.5) (randoms (current-random-real)))
    3644  (check-real-unit 'make-random-geometrics p 'p)
  • release/4/srfi-27/trunk/srfi-27-levys.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-levys
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Levy distribution
    2933
    3034;; See Stable Distributions - John P. Nolan, Formula 1.12
    3135
     36(: *make-random-levys (number number random-real-function --> number-function))
     37;
    3238(define (*make-random-levys gamma delta randoms)
    3339  (if (and (= 1.0 gamma) (= 0.0 delta))
     
    3541    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    3642
     43(: make-random-levys (#!rest (list-of *) --> number-function procedure))
     44;
    3745(define (make-random-levys #!key (gamma 1.0) (delta 0.0) (randoms (current-random-real)))
    3846  (check-nonnegative-real 'make-random-levys delta 'delta)
  • release/4/srfi-27/trunk/srfi-27-lognormals.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-lognormals
     
    2727  srfi-27-normals)
    2828
     29;;;
     30
     31(include "srfi-27-common-types")
     32
    2933;;; Lognormal distribution
    3034
     35(: *make-random-lognormals (number number random-real-function --> number-function))
     36;
    3137(define (*make-random-lognormals mu sigma randoms)
    3238  (let (
     
    3844      (exp (+ nmu (* (normals) nsigma))))) )
    3945
     46(: make-random-lognormals (#!rest (list-of *) --> number-function procedure))
     47;
    4048(define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) (randoms (current-random-real)))
    4149  (check-nonzero-real 'make-random-lognormals mu 'mu)
  • release/4/srfi-27/trunk/srfi-27-normals.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-normals
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Normal distribution
    2933
     
    3135;; Algorithm P of Section 3.4.1.C.
    3236
     37(: *make-random-normals (number number random-real-function --> number-function))
     38;
    3339(define (*make-random-normals mu sigma randoms)
    3440  (let ((next #f))
     
    5056                (+ mu (* sigma scale v1))))))))) )
    5157
     58(: make-random-normals (#!rest (list-of *) --> number-function procedure))
     59;
    5260(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
    5361  (check-real 'make-random-normals mu 'mu)
  • release/4/srfi-27/trunk/srfi-27-paretos.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-paretos
     
    2828  srfi-27-exponentials)
    2929
     30;;;
     31
     32(include "srfi-27-common-types")
     33
    3034;;; Pareto distribution
    3135
     36(: *make-random-paretos (number number random-real-function --> number-function))
     37;
    3238(define (*make-random-paretos alpha xmin randoms)
    3339  (let ((gammas (*make-random-gammas alpha (*reciprocal xmin) randoms)))
    3440    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    3541
     42(: make-random-paretos (#!rest (list-of *) --> number-function procedure))
     43;
    3644(define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) (randoms (current-random-real)))
    3745  (check-positive-real 'make-random-paretos alpha 'alpha)
  • release/4/srfi-27/trunk/srfi-27-poissons.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-poissons
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Poisson distribution
    2933
     34(: *make-random-poissons (number random-real-function --> number-function))
     35;
    3036(define (*make-random-poissons mu randoms)
    3137  (let ((emu (exp (- mu))))
     
    3642          ((<= prod emu) m)))) )
    3743
     44(: make-random-poissons (#!rest (list-of *) --> number-function procedure))
     45;
    3846(define (make-random-poissons #!key (mu 1.0) (randoms (current-random-real)))
    3947  (check-nonnegative-real 'make-random-poissons mu 'mu)
  • release/4/srfi-27/trunk/srfi-27-triangles.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-triangles
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Triangle distribution
    2933
    3034;; s - smallest, m - most probable, l - largest
    3135
     36(: *make-random-triangles (number number number random-real-function --> number-function))
     37;
    3238(define (*make-random-triangles s m l randoms)
    33   (let ((d1 (- m s))
    34         (d2 (- l s))
    35         (d3 (sqrt (- l m))))
     39  (let (
     40    (d1 (- m s))
     41    (d2 (- l s))
     42    (d3 (sqrt (- l m))) )
    3643    (let (
    3744      (q1 (/ d1 d2) )
     
    4451            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    4552
     53(: make-random-triangles (#!rest (list-of *) --> number-function procedure))
     54;
    4655(define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) (randoms (current-random-real)))
    4756  (check-real 'make-random-triangles s 's)
  • release/4/srfi-27/trunk/srfi-27-weibulls.scm

    r35456 r35475  
    44;;;; Kon Lovett, May '06
    55
    6 ; Chicken Generic Arithmetic! (could use fp routines)
     6; Chicken Generic Arithmetic! (would use fp routines, except for the "real" constraint)
    77
    88(module srfi-27-weibulls
     
    2626  srfi-27-distributions-support)
    2727
     28;;;
     29
     30(include "srfi-27-common-types")
     31
    2832;;; Weibull distribution
    2933
     34(: *make-random-weibulls (number number random-real-function --> number-function))
     35;
    3036(define (*make-random-weibulls shape scale randoms)
    31   (let ((invscale (*-reciprocal scale))
    32         (invshape (*reciprocal shape)) )
     37  (let (
     38    (invscale (*-reciprocal scale))
     39    (invshape (*reciprocal shape)) )
    3340    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    3441
     42(: make-random-weibulls (#!rest (list-of *) --> number-function procedure))
     43;
    3544(define (make-random-weibulls #!key (shape 1.0) (scale 1.0) (randoms (current-random-real)))
    3645  (check-positive-real 'make-random-weibulls shape 'shape)
Note: See TracChangeset for help on using the changeset viewer.