Changeset 34035 in project for release/4


Ignore:
Timestamp:
04/26/17 03:34:04 (3 years ago)
Author:
Kon Lovett
Message:

rmv stupid

Location:
release/4/srfi-27
Files:
10 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/srfi-27/tags/3.2.8/srfi-27-distributions.scm

    r34023 r34035  
    3232    check-real
    3333    check-open-interval
    34     check-closed-interval)
    35   (only srfi-27-uniform-random
    36     make-uniform-random-reals))
     34    check-closed-interval))
    3735(require-library
    38   type-errors type-checks
    39   srfi-27-uniform-random)
     36  type-errors type-checks)
    4037
    4138(use srfi-27)
     
    110107                (+ mu (* sigma scale v1))))))))) )
    111108
    112 (define (make-random-normals #!key (mu 0.0) (sigma 1.0) randoms)
    113   (let ((randoms (or randoms (random-real/current))))
    114     (check-real 'make-random-normals mu 'mu)
    115     (check-nonzero-real 'make-random-normals sigma 'sigma)
    116     (check-procedure 'make-random-normals randoms 'randoms)
    117     (values
    118       (*make-random-normals mu sigma randoms)
    119       (lambda () (values mu sigma randoms))) ) )
     109(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     110  (check-real 'make-random-normals mu 'mu)
     111  (check-nonzero-real 'make-random-normals sigma 'sigma)
     112  (check-procedure 'make-random-normals randoms 'randoms)
     113  (values
     114    (*make-random-normals mu sigma randoms)
     115    (lambda () (values mu sigma randoms))) )
    120116
    121117;;; Exponential distribution
     
    129125    (lambda () (* mu (- (log (randoms)))))) )
    130126
    131 (define (make-random-exponentials #!key (mu 1.0) randoms)
    132   (let ((randoms (or randoms (random-real/current))))
    133     (check-real-unit 'make-random-exponentials mu 'mu)
    134     (check-procedure 'make-random-exponentials randoms 'randoms)
    135     (values
    136       (*make-random-exponentials mu randoms)
    137       (lambda () (values mu randoms))) ) )
     127(define (make-random-exponentials #!key (mu 1.0) (randoms (random-real/current)))
     128  (check-real-unit 'make-random-exponentials mu 'mu)
     129  (check-procedure 'make-random-exponentials randoms 'randoms)
     130  (values
     131    (*make-random-exponentials mu randoms)
     132    (lambda () (values mu randoms))) )
    138133
    139134;;; Triangle distribution
     
    153148            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    154149
    155 (define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) randoms)
    156   (let ((randoms (or randoms (random-real/current))))
    157     (check-real 'make-random-triangles s 's)
    158     (check-real 'make-random-triangles m 'm)
    159     (check-real 'make-random-triangles l 'l)
    160     (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
    161     (check-real-closed-interval 'make-random-triangles m s l 'm)
    162     (check-procedure 'make-random-triangles randoms 'randoms)
    163     (values
    164       (*make-random-triangles s m l randoms)
    165       (lambda () (values s m l randoms))) ) )
     150(define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) (randoms (random-real/current)))
     151  (check-real 'make-random-triangles s 's)
     152  (check-real 'make-random-triangles m 'm)
     153  (check-real 'make-random-triangles l 'l)
     154  (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
     155  (check-real-closed-interval 'make-random-triangles m s l 'm)
     156  (check-procedure 'make-random-triangles randoms 'randoms)
     157  (values
     158    (*make-random-triangles s m l randoms)
     159    (lambda () (values s m l randoms))) )
    166160
    167161;;; Poisson distribution
     
    175169          ((<= prod emu) m)))) )
    176170
    177 (define (make-random-poissons #!key (mu 1.0) randoms)
    178   (let ((randoms (or randoms (random-real/current))))
    179     (check-nonnegative-real 'make-random-poissons mu 'mu)
    180     (check-procedure 'make-random-poissons randoms 'randoms)
    181     (values
    182       (*make-random-poissons mu randoms)
    183       (lambda () (values mu randoms))) ) )
     171(define (make-random-poissons #!key (mu 1.0) (randoms (random-real/current)))
     172  (check-nonnegative-real 'make-random-poissons mu 'mu)
     173  (check-procedure 'make-random-poissons randoms 'randoms)
     174  (values
     175    (*make-random-poissons mu randoms)
     176    (lambda () (values mu randoms))) )
    184177
    185178;;; Bernoulli distribution
     
    192185
    193186(define (make-random-bernoullis #!key (p 0.5) randoms)
    194   (let ((randoms (or randoms (random-real/current))))
    195     (check-real-unit 'make-random-bernoullis p 'p)
    196     (check-procedure 'make-random-bernoullis randoms 'randoms)
    197     (values
    198       (*make-random-bernoullis p randoms)
    199       (lambda () (values p randoms))) ) )
     187  (check-real-unit 'make-random-bernoullis p 'p)
     188  (check-procedure 'make-random-bernoullis randoms 'randoms)
     189  (values
     190    (*make-random-bernoullis p randoms)
     191    (lambda () (values p randoms))) )
    200192
    201193;;; Binomial distribution
     
    214206            ((<= t i) n))))) )
    215207
    216 (define (make-random-binomials #!key (t 1) (p 0.5) randoms)
    217   (let ((randoms (or randoms (random-real/current))))
    218     (check-cardinal-integer 'make-random-binomials t 't)
    219     (check-real-unit 'make-random-binomials p 'p)
    220     (check-procedure 'make-random-binomials randoms 'randoms)
    221     (values
    222       (*make-random-binomials t p randoms)
    223       (lambda () (values t p randoms))) ) )
     208(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (random-real/current)))
     209  (check-cardinal-integer 'make-random-binomials t 't)
     210  (check-real-unit 'make-random-binomials p 'p)
     211  (check-procedure 'make-random-binomials randoms 'randoms)
     212  (values
     213    (*make-random-binomials t p randoms)
     214    (lambda () (values t p randoms))) )
    224215
    225216;;; Geometric distribution
     
    230221      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    231222
    232 (define (make-random-geometrics #!key (p 0.5) randoms)
    233   (let ((randoms (or randoms (random-real/current))))
    234     (check-real-unit 'make-random-geometrics p 'p)
    235     (check-procedure 'make-random-geometrics randoms 'randoms)
    236     (values
    237       (*make-random-geometrics p randoms)
    238       (lambda () (values p randoms))) ) )
     223(define (make-random-geometrics #!key (p 0.5) (randoms (random-real/current)))
     224  (check-real-unit 'make-random-geometrics p 'p)
     225  (check-procedure 'make-random-geometrics randoms 'randoms)
     226  (values
     227    (*make-random-geometrics p randoms)
     228    (lambda () (values p randoms))) )
    239229
    240230;;; Lognormal distribution
     
    247237      (exp (+ nmu (* (normals) nsigma))))) )
    248238
    249 (define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) randoms)
    250   (let ((randoms (or randoms (random-real/current))))
    251     (check-nonzero-real 'make-random-lognormals mu 'mu)
    252     (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
    253     (check-procedure 'make-random-lognormals randoms 'randoms)
    254     (values
    255       (*make-random-lognormals mu sigma randoms)
    256       (lambda () (values mu sigma randoms))) ) )
     239(define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) (randoms (random-real/current)))
     240  (check-nonzero-real 'make-random-lognormals mu 'mu)
     241  (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
     242  (check-procedure 'make-random-lognormals randoms 'randoms)
     243  (values
     244    (*make-random-lognormals mu sigma randoms)
     245    (lambda () (values mu sigma randoms))) )
    257246
    258247;;; Cauchy distribution
     
    262251    (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
    263252
    264 (define (make-random-cauchys #!key (median 0.0) (sigma 1.0) randoms)
    265   (let ((randoms (or randoms (random-real/current))))
    266     (check-real 'make-random-cauchys median 'median)
    267     (check-positive-real 'make-random-cauchys sigma 'sigma)
    268     (check-procedure 'make-random-cauchys randoms 'randoms)
    269     (values
    270       (*make-random-cauchys median sigma randoms)
    271       (lambda () (values median sigma randoms))) ) )
     253(define (make-random-cauchys #!key (median 0.0) (sigma 1.0) (randoms (random-real/current)))
     254  (check-real 'make-random-cauchys median 'median)
     255  (check-positive-real 'make-random-cauchys sigma 'sigma)
     256  (check-procedure 'make-random-cauchys randoms 'randoms)
     257  (values
     258    (*make-random-cauchys median sigma randoms)
     259    (lambda () (values median sigma randoms))) )
    272260
    273261;;; Gamma distribution
     
    306294                   (loop) ) ) ) ) ) ) ) ) )
    307295
    308 (define (make-random-gammas #!key (alpha 1.0) (theta 1.0) randoms)
    309   (let ((randoms (or randoms (random-real/current))))
    310     (check-positive-real 'make-random-gammas alpha 'alpha)
    311     (check-positive-real 'make-random-gammas theta 'theta)
    312     (check-procedure 'make-random-gammas randoms 'randoms)
    313     (values
    314       (*make-random-gammas alpha theta randoms)
    315       (lambda () (values alpha theta randoms))) ) )
     296(define (make-random-gammas #!key (alpha 1.0) (theta 1.0) (randoms (random-real/current)))
     297  (check-positive-real 'make-random-gammas alpha 'alpha)
     298  (check-positive-real 'make-random-gammas theta 'theta)
     299  (check-procedure 'make-random-gammas randoms 'randoms)
     300  (values
     301    (*make-random-gammas alpha theta randoms)
     302    (lambda () (values alpha theta randoms))) )
    316303
    317304;;; Erlang distribution
     
    320307  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    321308
    322 (define (make-random-erlangs #!key (alpha 1) (theta 1.0) randoms)
    323   (let ((randoms (or randoms (random-real/current))))
    324     (check-positive-real 'make-random-erlangs alpha 'alpha)
    325     (check-positive-real 'make-random-erlangs theta 'theta)
    326     (check-procedure 'make-random-erlangs randoms 'randoms)
    327     (values
    328       (*make-random-erlangs alpha theta randoms)
    329       (lambda () (values alpha theta randoms))) ) )
     309(define (make-random-erlangs #!key (alpha 1) (theta 1.0) (randoms (random-real/current)))
     310  (check-positive-real 'make-random-erlangs alpha 'alpha)
     311  (check-positive-real 'make-random-erlangs theta 'theta)
     312  (check-procedure 'make-random-erlangs randoms 'randoms)
     313  (values
     314    (*make-random-erlangs alpha theta randoms)
     315    (lambda () (values alpha theta randoms))) )
    330316
    331317;;; Pareto distribution
     
    335321    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    336322
    337 (define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) randoms)
    338   (let ((randoms (or randoms (random-real/current))))
    339     (check-positive-real 'make-random-paretos alpha 'alpha)
    340     (check-positive-real 'make-random-paretos xmin 'xmin)
    341     (check-procedure 'make-random-paretos randoms 'randoms)
    342     (values
    343       (*make-random-paretos alpha xmin randoms)
    344       (lambda () (values alpha xmin randoms))) ) )
     323(define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) (randoms (random-real/current)))
     324  (check-positive-real 'make-random-paretos alpha 'alpha)
     325  (check-positive-real 'make-random-paretos xmin 'xmin)
     326  (check-procedure 'make-random-paretos randoms 'randoms)
     327  (values
     328    (*make-random-paretos alpha xmin randoms)
     329    (lambda () (values alpha xmin randoms))) )
    345330
    346331;;; Levy distribution
     
    353338    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    354339
    355 (define (make-random-levys #!key (gamma 1.0) (delta 0.0) randoms)
    356   (let ((randoms (or randoms (random-real/current))))
    357     (check-nonnegative-real 'make-random-levys delta 'delta)
    358     (check-positive-real 'make-random-levys gamma 'gamma)
    359     (check-procedure 'make-random-levys randoms 'randoms)
    360     (values
    361       (*make-random-levys gamma delta randoms)
    362       (lambda () (values gamma delta randoms))) ) )
     340(define (make-random-levys #!key (gamma 1.0) (delta 0.0) (randoms (random-real/current)))
     341  (check-nonnegative-real 'make-random-levys delta 'delta)
     342  (check-positive-real 'make-random-levys gamma 'gamma)
     343  (check-procedure 'make-random-levys randoms 'randoms)
     344  (values
     345    (*make-random-levys gamma delta randoms)
     346    (lambda () (values gamma delta randoms))) )
    363347
    364348;;; Weibull distribution
     
    369353    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    370354
    371 (define (make-random-weibulls #!key (shape 1.0) (scale 1.0) randoms)
    372   (let ((randoms (or randoms (random-real/current))))
    373     (check-positive-real 'make-random-weibulls shape 'shape)
    374     (check-positive-real 'make-random-weibulls scale 'scale)
    375     (check-procedure 'make-random-weibulls randoms 'randoms)
    376     (values
    377       (*make-random-weibulls shape scale randoms)
    378       (lambda () (values shape scale randoms))) ) )
     355(define (make-random-weibulls #!key (shape 1.0) (scale 1.0) (randoms (random-real/current)))
     356  (check-positive-real 'make-random-weibulls shape 'shape)
     357  (check-positive-real 'make-random-weibulls scale 'scale)
     358  (check-procedure 'make-random-weibulls randoms 'randoms)
     359  (values
     360    (*make-random-weibulls shape scale randoms)
     361    (lambda () (values shape scale randoms))) )
    379362
    380363) ;module srfi-27-distributions
  • release/4/srfi-27/tags/3.2.8/srfi-27-uniform-random.scm

    r34023 r34035  
    55
    66(;export
    7   *make-uniform-random-integers
    87  make-uniform-random-integers
    9   make-uniform-random-reals)
     8  make-uniform-random-reals
     9  *make-uniform-random-integers)
    1010
    1111(import
     
    3535    + - * quotient = <))
    3636
    37 ;;; Uniform random integers in [low high] by precision
     37;; Uniform random integers in [low high] by precision
     38
     39(define (make-uniform-random-integers #!key high (low 0) (precision 1) (source (current-random-source)))
     40  (check-random-source 'make-uniform-random-integers source 'source)
     41  (let ((high (or high (- (*random-source-maximum-range source) 1))))
     42    (check-integer 'make-uniform-random-integers high 'high)
     43    (check-integer 'make-uniform-random-integers low 'low)
     44    (check-positive-integer 'make-uniform-random-integers precision 'precision)
     45    (values
     46      (*make-uniform-random-integers
     47        low high precision
     48        ((@random-source-make-integers source)))
     49      (lambda ()
     50        (values high low precision source)) ) ) )
     51
     52;; Uniform random reals in (0.0 1.0) by precision
     53
     54(define (make-uniform-random-reals #!key (precision #f) (source (current-random-source)))
     55  (check-random-source 'make-uniform-random-reals source 'source)
     56  (when precision
     57    (check-real-precision 'make-uniform-random-reals precision 'precision) )
     58  (values
     59    ((@random-source-make-reals source) precision)
     60    (lambda ()
     61      (values precision source)) ) )
     62
     63;; Support
    3864
    3965(define (*make-uniform-random-integers low high prec rndint)
     
    5581              (+ low (* (rndint rng) prec) ) ) ) ) ) ) ) )
    5682
    57 (define (make-uniform-random-integers
    58           #!key
    59             high (low 0) (precision 1)
    60             (source (current-random-source)))
    61   (check-random-source 'make-uniform-random-integers source 'source)
    62   (let ((high (or high (- (*random-source-maximum-range source) 1))))
    63     (check-integer 'make-uniform-random-integers high 'high)
    64     (check-integer 'make-uniform-random-integers low 'low)
    65     (check-positive-integer 'make-uniform-random-integers precision 'precision)
    66     (values
    67       (*make-uniform-random-integers
    68         low high precision
    69         ((@random-source-make-integers source)))
    70       (lambda ()
    71         (values high low precision source)) ) ) )
    72 
    73 ;;; Uniform random reals in (0.0 1.0) by precision
    74 
    75 (define (make-uniform-random-reals
    76           #!key
    77             (precision #f)
    78             (source (current-random-source)))
    79   (check-random-source 'make-uniform-random-reals source 'source)
    80   (when precision
    81     (check-real-precision 'make-uniform-random-reals precision 'precision) )
    82   (values
    83     ((@random-source-make-reals source) precision)
    84     (lambda ()
    85       (values precision source)) ) )
    86 
    8783) ;module srfi-27-uniform-random
  • release/4/srfi-27/tags/3.2.8/srfi-27-vector.scm

    r34023 r34035  
    6363        (vector-set! vec j xi) ) ) ) )
    6464
    65 (define (make-random-permutations #!key randoms)
    66   (let ((randoms (or randoms (random-integer/current))))
    67     (lambda (n)
    68       (*random-permutation!
    69         (make-vector
    70           (check-cardinal-integer 'make-random-permutations n 'length)
    71           0)
    72         (check-procedure 'make-random-permutations randoms 'randoms))) ) )
     65(define (make-random-permutations #!key (randoms (random-integer/current)))
     66  (lambda (n)
     67    (*random-permutation!
     68      (make-vector
     69        (check-cardinal-integer 'make-random-permutations n 'length)
     70        0)
     71      (check-procedure 'make-random-permutations randoms 'randoms))) )
    7372
    74 (define (random-permutation! vec #!key randoms)
    75   (let ((randoms (or randoms (random-integer/current))))
    76     (*random-permutation!
    77       (check-vector 'random-permutation! vec)
    78       (check-procedure 'random-permutation! randoms 'randoms)) ) )
     73(define (random-permutation! vec #!key (randoms (random-integer/current)))
     74  (*random-permutation!
     75    (check-vector 'random-permutation! vec)
     76    (check-procedure 'random-permutation! randoms 'randoms)) )
    7977
    8078;;
    8179
    82 (define (make-random-vector #!key randoms)
    83   (let ((randoms (or randoms (random-real/current))))
    84     (lambda (n)
    85       (vector-filled!
    86         (make-vector
    87           (check-cardinal-integer 'random-vector n 'length))
    88         (check-procedure 'make-random-vector randoms 'randoms))) ) )
     80(define (make-random-vector #!key (randoms (random-real/current)))
     81  (lambda (n)
     82    (vector-filled!
     83      (make-vector
     84        (check-cardinal-integer 'random-vector n 'length))
     85      (check-procedure 'make-random-vector randoms 'randoms))) )
    8986
    90 (define (random-vector! vec #!key randoms)
    91   (let ((randoms (or randoms (random-real/current))))
    92     (vector%-filled!
    93       (check-vector% 'random-vector! vec)
    94       (check-procedure 'random-vector! randoms 'randoms)) ) )
     87(define (random-vector! vec #!key (randoms (random-real/current)))
     88  (vector%-filled!
     89    (check-vector% 'random-vector! vec)
     90    (check-procedure 'random-vector! randoms 'randoms)) )
    9591
    9692;;; Normal vectors
     
    114110    (**random-hollow-sphere! vec norms) ) )
    115111
    116 (define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) randoms)
    117   (let ((randoms (or randoms (random-real/current))))
    118     (let-values (
    119         ((norms pl)
    120           (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    121       (lambda (n)
    122         (**random-hollow-sphere!
    123           (make-vector (check-cardinal-integer 'random-hollow-sphere n 'length))
    124           norms) ) ) ) )
     112(define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     113  (let-values (
     114      ((norms pl)
     115        (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     116    (lambda (n)
     117      (**random-hollow-sphere!
     118        (make-vector (check-cardinal-integer 'random-hollow-sphere n 'length))
     119        norms) ) ) )
    125120
    126 (define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) randoms)
    127   (let ((randoms (or randoms (random-real/current))))
    128     (*random-hollow-sphere!
    129       (check-vector% 'random-hollow-sphere! vec)
    130       mu sigma randoms) ) )
     121(define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     122  (*random-hollow-sphere!
     123    (check-vector% 'random-hollow-sphere! vec)
     124    mu sigma randoms) )
    131125
    132126;;
     
    148142    (**random-solid-sphere! vec randoms norms) ) )
    149143
    150 (define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) randoms)
    151   (let ((randoms (or randoms (random-real/current))))
    152     (let-values (
    153         ((norms pl)
    154           (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    155       (lambda (n)
    156         (**random-solid-sphere!
    157           (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
    158           randoms norms) ) ) ) )
     144(define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     145  (let-values (
     146      ((norms pl)
     147        (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     148    (lambda (n)
     149      (**random-solid-sphere!
     150        (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
     151        randoms norms) ) ) )
    159152
    160 (define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) randoms)
    161   (let ((randoms (or randoms (random-real/current))))
    162     (*random-solid-sphere!
    163       (check-vector% 'random-solid-sphere! vec)
    164       mu sigma randoms) ) )
     153(define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     154  (*random-solid-sphere!
     155    (check-vector% 'random-solid-sphere! vec)
     156    mu sigma randoms) )
    165157
    166158) ;module srfi-27-vector
  • release/4/srfi-27/tags/3.2.8/srfi-27.setup

    r34030 r34035  
    1717#;(define publoptn '())
    1818
    19 (setup-shared-extension-module 'fp-extn (extension-version "3.2.7")
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.8")
    2020  #:inline? #t
    2121  #:types? #t
    2222  #:compile-options `(-scrutinize ,@utiloptn) )
    2323
    24 (setup-shared-extension-module 'source-registration (extension-version "3.2.7")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.8")
    2525  #:inline? #t
    2626  #:types? #t
    2727  #:compile-options `(-scrutinize ,@utiloptn) )
    2828
    29 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.7")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.8")
    3030  #:inline? #t
    3131  #:types? #t
    3232  #:compile-options `(-scrutinize ,@utiloptn) )
    3333
    34 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.7")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.8")
    3535  #:inline? #t
    3636  #:types? #t
     
    3939;; Entropy Source Modules
    4040
    41 (setup-shared-extension-module 'entropy-source (extension-version "3.2.7")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.8")
    4242  #:inline? #t
    4343  #:types? #t
    4444  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.7")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.8")
    4747  #:inline? #t
    4848  #:types? #t
    4949  #:compile-options `(-scrutinize ,@utiloptn) )
    5050
    51 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.7")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.8")
    5252  #:inline? #t
    5353  #:types? #t
    5454  #:compile-options `(-scrutinize ,@publoptn) )
    5555
    56 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.7")
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.8")
    5757  #:inline? #t
    5858  #:types? #t
     
    6161    -no-procedure-checks) )
    6262
    63 (setup-shared-extension-module 'entropy-port (extension-version "3.2.7")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.8")
    6464  #:inline? #t
    6565  #:types? #t
     
    6767
    6868#+unix
    69 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.7")
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.8")
    7070  #:inline? #t
    7171  #:types? #t
     
    7373
    7474#+windows
    75 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.7")
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.8")
    7676  #:inline? #t
    7777  #:types? #t
     
    7979
    8080#;
    81 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.7")
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.8")
    8282  #:inline? #t
    8383  #:types? #t
     
    8686;; Random Source Modules
    8787
    88 (setup-shared-extension-module 'random-source (extension-version "3.2.7")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.8")
    8989  #:inline? #t
    9090  #:types? #t
    9191  #:compile-options `(-scrutinize ,@utiloptn) )
    9292
    93 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.7")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.8")
    9494  #:inline? #t
    9595  #:types? #t
    9696  #:compile-options `(-scrutinize ,@utiloptn) )
    9797
    98 (setup-shared-extension-module 'mwc (extension-version "3.2.7")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.8")
    9999  #:inline? #t
    100100  #:types? #t
    101101  #:compile-options `(-scrutinize ,@utiloptn) )
    102102
    103 (setup-shared-extension-module 'moa (extension-version "3.2.7")
     103(setup-shared-extension-module 'moa (extension-version "3.2.8")
    104104  #:inline? #t
    105105  #:types? #t
     
    107107
    108108#;
    109 (setup-shared-extension-module 'bsdrnd (extension-version "3.2.7")
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.8")
    110110  #:inline? #t
    111111  #:types? #t
     
    113113
    114114#;
    115 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.7")
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.8")
    116116  #:inline? #t
    117117  #:types? #t
     
    120120;; Main Modules
    121121
    122 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.7")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.8")
    123123  #:inline? #t
    124124  #:types? #t
    125125  #:compile-options `(-scrutinize ,@publoptn) )
    126126
    127 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.7")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.8")
    128128  #:inline? #t
    129129  #:types? #t
    130130  #:compile-options `(-scrutinize ,@publoptn) )
    131131
    132 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.7")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.8")
    133133  #:inline? #t
    134134  #:types? #t
    135135  #:compile-options `(-scrutinize ,@publoptn) )
    136136
    137 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.7")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.8")
    138138  #:inline? #t
    139139  #:types? #t
  • release/4/srfi-27/tags/3.2.8/tests/run.scm

    r34021 r34035  
    188188;(system* "csi -n -s test-diehard") ;errors
    189189
    190 (newline)
     190;;
    191191
    192192(test-exit)
  • release/4/srfi-27/trunk/srfi-27-distributions.scm

    r34023 r34035  
    3232    check-real
    3333    check-open-interval
    34     check-closed-interval)
    35   (only srfi-27-uniform-random
    36     make-uniform-random-reals))
     34    check-closed-interval))
    3735(require-library
    38   type-errors type-checks
    39   srfi-27-uniform-random)
     36  type-errors type-checks)
    4037
    4138(use srfi-27)
     
    110107                (+ mu (* sigma scale v1))))))))) )
    111108
    112 (define (make-random-normals #!key (mu 0.0) (sigma 1.0) randoms)
    113   (let ((randoms (or randoms (random-real/current))))
    114     (check-real 'make-random-normals mu 'mu)
    115     (check-nonzero-real 'make-random-normals sigma 'sigma)
    116     (check-procedure 'make-random-normals randoms 'randoms)
    117     (values
    118       (*make-random-normals mu sigma randoms)
    119       (lambda () (values mu sigma randoms))) ) )
     109(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     110  (check-real 'make-random-normals mu 'mu)
     111  (check-nonzero-real 'make-random-normals sigma 'sigma)
     112  (check-procedure 'make-random-normals randoms 'randoms)
     113  (values
     114    (*make-random-normals mu sigma randoms)
     115    (lambda () (values mu sigma randoms))) )
    120116
    121117;;; Exponential distribution
     
    129125    (lambda () (* mu (- (log (randoms)))))) )
    130126
    131 (define (make-random-exponentials #!key (mu 1.0) randoms)
    132   (let ((randoms (or randoms (random-real/current))))
    133     (check-real-unit 'make-random-exponentials mu 'mu)
    134     (check-procedure 'make-random-exponentials randoms 'randoms)
    135     (values
    136       (*make-random-exponentials mu randoms)
    137       (lambda () (values mu randoms))) ) )
     127(define (make-random-exponentials #!key (mu 1.0) (randoms (random-real/current)))
     128  (check-real-unit 'make-random-exponentials mu 'mu)
     129  (check-procedure 'make-random-exponentials randoms 'randoms)
     130  (values
     131    (*make-random-exponentials mu randoms)
     132    (lambda () (values mu randoms))) )
    138133
    139134;;; Triangle distribution
     
    153148            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    154149
    155 (define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) randoms)
    156   (let ((randoms (or randoms (random-real/current))))
    157     (check-real 'make-random-triangles s 's)
    158     (check-real 'make-random-triangles m 'm)
    159     (check-real 'make-random-triangles l 'l)
    160     (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
    161     (check-real-closed-interval 'make-random-triangles m s l 'm)
    162     (check-procedure 'make-random-triangles randoms 'randoms)
    163     (values
    164       (*make-random-triangles s m l randoms)
    165       (lambda () (values s m l randoms))) ) )
     150(define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) (randoms (random-real/current)))
     151  (check-real 'make-random-triangles s 's)
     152  (check-real 'make-random-triangles m 'm)
     153  (check-real 'make-random-triangles l 'l)
     154  (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
     155  (check-real-closed-interval 'make-random-triangles m s l 'm)
     156  (check-procedure 'make-random-triangles randoms 'randoms)
     157  (values
     158    (*make-random-triangles s m l randoms)
     159    (lambda () (values s m l randoms))) )
    166160
    167161;;; Poisson distribution
     
    175169          ((<= prod emu) m)))) )
    176170
    177 (define (make-random-poissons #!key (mu 1.0) randoms)
    178   (let ((randoms (or randoms (random-real/current))))
    179     (check-nonnegative-real 'make-random-poissons mu 'mu)
    180     (check-procedure 'make-random-poissons randoms 'randoms)
    181     (values
    182       (*make-random-poissons mu randoms)
    183       (lambda () (values mu randoms))) ) )
     171(define (make-random-poissons #!key (mu 1.0) (randoms (random-real/current)))
     172  (check-nonnegative-real 'make-random-poissons mu 'mu)
     173  (check-procedure 'make-random-poissons randoms 'randoms)
     174  (values
     175    (*make-random-poissons mu randoms)
     176    (lambda () (values mu randoms))) )
    184177
    185178;;; Bernoulli distribution
     
    192185
    193186(define (make-random-bernoullis #!key (p 0.5) randoms)
    194   (let ((randoms (or randoms (random-real/current))))
    195     (check-real-unit 'make-random-bernoullis p 'p)
    196     (check-procedure 'make-random-bernoullis randoms 'randoms)
    197     (values
    198       (*make-random-bernoullis p randoms)
    199       (lambda () (values p randoms))) ) )
     187  (check-real-unit 'make-random-bernoullis p 'p)
     188  (check-procedure 'make-random-bernoullis randoms 'randoms)
     189  (values
     190    (*make-random-bernoullis p randoms)
     191    (lambda () (values p randoms))) )
    200192
    201193;;; Binomial distribution
     
    214206            ((<= t i) n))))) )
    215207
    216 (define (make-random-binomials #!key (t 1) (p 0.5) randoms)
    217   (let ((randoms (or randoms (random-real/current))))
    218     (check-cardinal-integer 'make-random-binomials t 't)
    219     (check-real-unit 'make-random-binomials p 'p)
    220     (check-procedure 'make-random-binomials randoms 'randoms)
    221     (values
    222       (*make-random-binomials t p randoms)
    223       (lambda () (values t p randoms))) ) )
     208(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (random-real/current)))
     209  (check-cardinal-integer 'make-random-binomials t 't)
     210  (check-real-unit 'make-random-binomials p 'p)
     211  (check-procedure 'make-random-binomials randoms 'randoms)
     212  (values
     213    (*make-random-binomials t p randoms)
     214    (lambda () (values t p randoms))) )
    224215
    225216;;; Geometric distribution
     
    230221      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    231222
    232 (define (make-random-geometrics #!key (p 0.5) randoms)
    233   (let ((randoms (or randoms (random-real/current))))
    234     (check-real-unit 'make-random-geometrics p 'p)
    235     (check-procedure 'make-random-geometrics randoms 'randoms)
    236     (values
    237       (*make-random-geometrics p randoms)
    238       (lambda () (values p randoms))) ) )
     223(define (make-random-geometrics #!key (p 0.5) (randoms (random-real/current)))
     224  (check-real-unit 'make-random-geometrics p 'p)
     225  (check-procedure 'make-random-geometrics randoms 'randoms)
     226  (values
     227    (*make-random-geometrics p randoms)
     228    (lambda () (values p randoms))) )
    239229
    240230;;; Lognormal distribution
     
    247237      (exp (+ nmu (* (normals) nsigma))))) )
    248238
    249 (define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) randoms)
    250   (let ((randoms (or randoms (random-real/current))))
    251     (check-nonzero-real 'make-random-lognormals mu 'mu)
    252     (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
    253     (check-procedure 'make-random-lognormals randoms 'randoms)
    254     (values
    255       (*make-random-lognormals mu sigma randoms)
    256       (lambda () (values mu sigma randoms))) ) )
     239(define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) (randoms (random-real/current)))
     240  (check-nonzero-real 'make-random-lognormals mu 'mu)
     241  (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
     242  (check-procedure 'make-random-lognormals randoms 'randoms)
     243  (values
     244    (*make-random-lognormals mu sigma randoms)
     245    (lambda () (values mu sigma randoms))) )
    257246
    258247;;; Cauchy distribution
     
    262251    (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
    263252
    264 (define (make-random-cauchys #!key (median 0.0) (sigma 1.0) randoms)
    265   (let ((randoms (or randoms (random-real/current))))
    266     (check-real 'make-random-cauchys median 'median)
    267     (check-positive-real 'make-random-cauchys sigma 'sigma)
    268     (check-procedure 'make-random-cauchys randoms 'randoms)
    269     (values
    270       (*make-random-cauchys median sigma randoms)
    271       (lambda () (values median sigma randoms))) ) )
     253(define (make-random-cauchys #!key (median 0.0) (sigma 1.0) (randoms (random-real/current)))
     254  (check-real 'make-random-cauchys median 'median)
     255  (check-positive-real 'make-random-cauchys sigma 'sigma)
     256  (check-procedure 'make-random-cauchys randoms 'randoms)
     257  (values
     258    (*make-random-cauchys median sigma randoms)
     259    (lambda () (values median sigma randoms))) )
    272260
    273261;;; Gamma distribution
     
    306294                   (loop) ) ) ) ) ) ) ) ) )
    307295
    308 (define (make-random-gammas #!key (alpha 1.0) (theta 1.0) randoms)
    309   (let ((randoms (or randoms (random-real/current))))
    310     (check-positive-real 'make-random-gammas alpha 'alpha)
    311     (check-positive-real 'make-random-gammas theta 'theta)
    312     (check-procedure 'make-random-gammas randoms 'randoms)
    313     (values
    314       (*make-random-gammas alpha theta randoms)
    315       (lambda () (values alpha theta randoms))) ) )
     296(define (make-random-gammas #!key (alpha 1.0) (theta 1.0) (randoms (random-real/current)))
     297  (check-positive-real 'make-random-gammas alpha 'alpha)
     298  (check-positive-real 'make-random-gammas theta 'theta)
     299  (check-procedure 'make-random-gammas randoms 'randoms)
     300  (values
     301    (*make-random-gammas alpha theta randoms)
     302    (lambda () (values alpha theta randoms))) )
    316303
    317304;;; Erlang distribution
     
    320307  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    321308
    322 (define (make-random-erlangs #!key (alpha 1) (theta 1.0) randoms)
    323   (let ((randoms (or randoms (random-real/current))))
    324     (check-positive-real 'make-random-erlangs alpha 'alpha)
    325     (check-positive-real 'make-random-erlangs theta 'theta)
    326     (check-procedure 'make-random-erlangs randoms 'randoms)
    327     (values
    328       (*make-random-erlangs alpha theta randoms)
    329       (lambda () (values alpha theta randoms))) ) )
     309(define (make-random-erlangs #!key (alpha 1) (theta 1.0) (randoms (random-real/current)))
     310  (check-positive-real 'make-random-erlangs alpha 'alpha)
     311  (check-positive-real 'make-random-erlangs theta 'theta)
     312  (check-procedure 'make-random-erlangs randoms 'randoms)
     313  (values
     314    (*make-random-erlangs alpha theta randoms)
     315    (lambda () (values alpha theta randoms))) )
    330316
    331317;;; Pareto distribution
     
    335321    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    336322
    337 (define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) randoms)
    338   (let ((randoms (or randoms (random-real/current))))
    339     (check-positive-real 'make-random-paretos alpha 'alpha)
    340     (check-positive-real 'make-random-paretos xmin 'xmin)
    341     (check-procedure 'make-random-paretos randoms 'randoms)
    342     (values
    343       (*make-random-paretos alpha xmin randoms)
    344       (lambda () (values alpha xmin randoms))) ) )
     323(define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) (randoms (random-real/current)))
     324  (check-positive-real 'make-random-paretos alpha 'alpha)
     325  (check-positive-real 'make-random-paretos xmin 'xmin)
     326  (check-procedure 'make-random-paretos randoms 'randoms)
     327  (values
     328    (*make-random-paretos alpha xmin randoms)
     329    (lambda () (values alpha xmin randoms))) )
    345330
    346331;;; Levy distribution
     
    353338    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    354339
    355 (define (make-random-levys #!key (gamma 1.0) (delta 0.0) randoms)
    356   (let ((randoms (or randoms (random-real/current))))
    357     (check-nonnegative-real 'make-random-levys delta 'delta)
    358     (check-positive-real 'make-random-levys gamma 'gamma)
    359     (check-procedure 'make-random-levys randoms 'randoms)
    360     (values
    361       (*make-random-levys gamma delta randoms)
    362       (lambda () (values gamma delta randoms))) ) )
     340(define (make-random-levys #!key (gamma 1.0) (delta 0.0) (randoms (random-real/current)))
     341  (check-nonnegative-real 'make-random-levys delta 'delta)
     342  (check-positive-real 'make-random-levys gamma 'gamma)
     343  (check-procedure 'make-random-levys randoms 'randoms)
     344  (values
     345    (*make-random-levys gamma delta randoms)
     346    (lambda () (values gamma delta randoms))) )
    363347
    364348;;; Weibull distribution
     
    369353    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    370354
    371 (define (make-random-weibulls #!key (shape 1.0) (scale 1.0) randoms)
    372   (let ((randoms (or randoms (random-real/current))))
    373     (check-positive-real 'make-random-weibulls shape 'shape)
    374     (check-positive-real 'make-random-weibulls scale 'scale)
    375     (check-procedure 'make-random-weibulls randoms 'randoms)
    376     (values
    377       (*make-random-weibulls shape scale randoms)
    378       (lambda () (values shape scale randoms))) ) )
     355(define (make-random-weibulls #!key (shape 1.0) (scale 1.0) (randoms (random-real/current)))
     356  (check-positive-real 'make-random-weibulls shape 'shape)
     357  (check-positive-real 'make-random-weibulls scale 'scale)
     358  (check-procedure 'make-random-weibulls randoms 'randoms)
     359  (values
     360    (*make-random-weibulls shape scale randoms)
     361    (lambda () (values shape scale randoms))) )
    379362
    380363) ;module srfi-27-distributions
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r34023 r34035  
    55
    66(;export
    7   *make-uniform-random-integers
    87  make-uniform-random-integers
    9   make-uniform-random-reals)
     8  make-uniform-random-reals
     9  *make-uniform-random-integers)
    1010
    1111(import
     
    3535    + - * quotient = <))
    3636
    37 ;;; Uniform random integers in [low high] by precision
     37;; Uniform random integers in [low high] by precision
     38
     39(define (make-uniform-random-integers #!key high (low 0) (precision 1) (source (current-random-source)))
     40  (check-random-source 'make-uniform-random-integers source 'source)
     41  (let ((high (or high (- (*random-source-maximum-range source) 1))))
     42    (check-integer 'make-uniform-random-integers high 'high)
     43    (check-integer 'make-uniform-random-integers low 'low)
     44    (check-positive-integer 'make-uniform-random-integers precision 'precision)
     45    (values
     46      (*make-uniform-random-integers
     47        low high precision
     48        ((@random-source-make-integers source)))
     49      (lambda ()
     50        (values high low precision source)) ) ) )
     51
     52;; Uniform random reals in (0.0 1.0) by precision
     53
     54(define (make-uniform-random-reals #!key (precision #f) (source (current-random-source)))
     55  (check-random-source 'make-uniform-random-reals source 'source)
     56  (when precision
     57    (check-real-precision 'make-uniform-random-reals precision 'precision) )
     58  (values
     59    ((@random-source-make-reals source) precision)
     60    (lambda ()
     61      (values precision source)) ) )
     62
     63;; Support
    3864
    3965(define (*make-uniform-random-integers low high prec rndint)
     
    5581              (+ low (* (rndint rng) prec) ) ) ) ) ) ) ) )
    5682
    57 (define (make-uniform-random-integers
    58           #!key
    59             high (low 0) (precision 1)
    60             (source (current-random-source)))
    61   (check-random-source 'make-uniform-random-integers source 'source)
    62   (let ((high (or high (- (*random-source-maximum-range source) 1))))
    63     (check-integer 'make-uniform-random-integers high 'high)
    64     (check-integer 'make-uniform-random-integers low 'low)
    65     (check-positive-integer 'make-uniform-random-integers precision 'precision)
    66     (values
    67       (*make-uniform-random-integers
    68         low high precision
    69         ((@random-source-make-integers source)))
    70       (lambda ()
    71         (values high low precision source)) ) ) )
    72 
    73 ;;; Uniform random reals in (0.0 1.0) by precision
    74 
    75 (define (make-uniform-random-reals
    76           #!key
    77             (precision #f)
    78             (source (current-random-source)))
    79   (check-random-source 'make-uniform-random-reals source 'source)
    80   (when precision
    81     (check-real-precision 'make-uniform-random-reals precision 'precision) )
    82   (values
    83     ((@random-source-make-reals source) precision)
    84     (lambda ()
    85       (values precision source)) ) )
    86 
    8783) ;module srfi-27-uniform-random
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r34023 r34035  
    6363        (vector-set! vec j xi) ) ) ) )
    6464
    65 (define (make-random-permutations #!key randoms)
    66   (let ((randoms (or randoms (random-integer/current))))
    67     (lambda (n)
    68       (*random-permutation!
    69         (make-vector
    70           (check-cardinal-integer 'make-random-permutations n 'length)
    71           0)
    72         (check-procedure 'make-random-permutations randoms 'randoms))) ) )
     65(define (make-random-permutations #!key (randoms (random-integer/current)))
     66  (lambda (n)
     67    (*random-permutation!
     68      (make-vector
     69        (check-cardinal-integer 'make-random-permutations n 'length)
     70        0)
     71      (check-procedure 'make-random-permutations randoms 'randoms))) )
    7372
    74 (define (random-permutation! vec #!key randoms)
    75   (let ((randoms (or randoms (random-integer/current))))
    76     (*random-permutation!
    77       (check-vector 'random-permutation! vec)
    78       (check-procedure 'random-permutation! randoms 'randoms)) ) )
     73(define (random-permutation! vec #!key (randoms (random-integer/current)))
     74  (*random-permutation!
     75    (check-vector 'random-permutation! vec)
     76    (check-procedure 'random-permutation! randoms 'randoms)) )
    7977
    8078;;
    8179
    82 (define (make-random-vector #!key randoms)
    83   (let ((randoms (or randoms (random-real/current))))
    84     (lambda (n)
    85       (vector-filled!
    86         (make-vector
    87           (check-cardinal-integer 'random-vector n 'length))
    88         (check-procedure 'make-random-vector randoms 'randoms))) ) )
     80(define (make-random-vector #!key (randoms (random-real/current)))
     81  (lambda (n)
     82    (vector-filled!
     83      (make-vector
     84        (check-cardinal-integer 'random-vector n 'length))
     85      (check-procedure 'make-random-vector randoms 'randoms))) )
    8986
    90 (define (random-vector! vec #!key randoms)
    91   (let ((randoms (or randoms (random-real/current))))
    92     (vector%-filled!
    93       (check-vector% 'random-vector! vec)
    94       (check-procedure 'random-vector! randoms 'randoms)) ) )
     87(define (random-vector! vec #!key (randoms (random-real/current)))
     88  (vector%-filled!
     89    (check-vector% 'random-vector! vec)
     90    (check-procedure 'random-vector! randoms 'randoms)) )
    9591
    9692;;; Normal vectors
     
    114110    (**random-hollow-sphere! vec norms) ) )
    115111
    116 (define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) randoms)
    117   (let ((randoms (or randoms (random-real/current))))
    118     (let-values (
    119         ((norms pl)
    120           (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    121       (lambda (n)
    122         (**random-hollow-sphere!
    123           (make-vector (check-cardinal-integer 'random-hollow-sphere n 'length))
    124           norms) ) ) ) )
     112(define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     113  (let-values (
     114      ((norms pl)
     115        (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     116    (lambda (n)
     117      (**random-hollow-sphere!
     118        (make-vector (check-cardinal-integer 'random-hollow-sphere n 'length))
     119        norms) ) ) )
    125120
    126 (define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) randoms)
    127   (let ((randoms (or randoms (random-real/current))))
    128     (*random-hollow-sphere!
    129       (check-vector% 'random-hollow-sphere! vec)
    130       mu sigma randoms) ) )
     121(define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     122  (*random-hollow-sphere!
     123    (check-vector% 'random-hollow-sphere! vec)
     124    mu sigma randoms) )
    131125
    132126;;
     
    148142    (**random-solid-sphere! vec randoms norms) ) )
    149143
    150 (define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) randoms)
    151   (let ((randoms (or randoms (random-real/current))))
    152     (let-values (
    153         ((norms pl)
    154           (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    155       (lambda (n)
    156         (**random-solid-sphere!
    157           (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
    158           randoms norms) ) ) ) )
     144(define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     145  (let-values (
     146      ((norms pl)
     147        (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     148    (lambda (n)
     149      (**random-solid-sphere!
     150        (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
     151        randoms norms) ) ) )
    159152
    160 (define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) randoms)
    161   (let ((randoms (or randoms (random-real/current))))
    162     (*random-solid-sphere!
    163       (check-vector% 'random-solid-sphere! vec)
    164       mu sigma randoms) ) )
     153(define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (random-real/current)))
     154  (*random-solid-sphere!
     155    (check-vector% 'random-solid-sphere! vec)
     156    mu sigma randoms) )
    165157
    166158) ;module srfi-27-vector
  • release/4/srfi-27/trunk/srfi-27.setup

    r34030 r34035  
    1717#;(define publoptn '())
    1818
    19 (setup-shared-extension-module 'fp-extn (extension-version "3.2.7")
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.8")
    2020  #:inline? #t
    2121  #:types? #t
    2222  #:compile-options `(-scrutinize ,@utiloptn) )
    2323
    24 (setup-shared-extension-module 'source-registration (extension-version "3.2.7")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.8")
    2525  #:inline? #t
    2626  #:types? #t
    2727  #:compile-options `(-scrutinize ,@utiloptn) )
    2828
    29 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.7")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.8")
    3030  #:inline? #t
    3131  #:types? #t
    3232  #:compile-options `(-scrutinize ,@utiloptn) )
    3333
    34 (setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.7")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.8")
    3535  #:inline? #t
    3636  #:types? #t
     
    3939;; Entropy Source Modules
    4040
    41 (setup-shared-extension-module 'entropy-source (extension-version "3.2.7")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.8")
    4242  #:inline? #t
    4343  #:types? #t
    4444  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.7")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.8")
    4747  #:inline? #t
    4848  #:types? #t
    4949  #:compile-options `(-scrutinize ,@utiloptn) )
    5050
    51 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.7")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.8")
    5252  #:inline? #t
    5353  #:types? #t
    5454  #:compile-options `(-scrutinize ,@publoptn) )
    5555
    56 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.7")
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.8")
    5757  #:inline? #t
    5858  #:types? #t
     
    6161    -no-procedure-checks) )
    6262
    63 (setup-shared-extension-module 'entropy-port (extension-version "3.2.7")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.8")
    6464  #:inline? #t
    6565  #:types? #t
     
    6767
    6868#+unix
    69 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.7")
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.8")
    7070  #:inline? #t
    7171  #:types? #t
     
    7373
    7474#+windows
    75 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.7")
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.8")
    7676  #:inline? #t
    7777  #:types? #t
     
    7979
    8080#;
    81 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.7")
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.8")
    8282  #:inline? #t
    8383  #:types? #t
     
    8686;; Random Source Modules
    8787
    88 (setup-shared-extension-module 'random-source (extension-version "3.2.7")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.8")
    8989  #:inline? #t
    9090  #:types? #t
    9191  #:compile-options `(-scrutinize ,@utiloptn) )
    9292
    93 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.7")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.8")
    9494  #:inline? #t
    9595  #:types? #t
    9696  #:compile-options `(-scrutinize ,@utiloptn) )
    9797
    98 (setup-shared-extension-module 'mwc (extension-version "3.2.7")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.8")
    9999  #:inline? #t
    100100  #:types? #t
    101101  #:compile-options `(-scrutinize ,@utiloptn) )
    102102
    103 (setup-shared-extension-module 'moa (extension-version "3.2.7")
     103(setup-shared-extension-module 'moa (extension-version "3.2.8")
    104104  #:inline? #t
    105105  #:types? #t
     
    107107
    108108#;
    109 (setup-shared-extension-module 'bsdrnd (extension-version "3.2.7")
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.8")
    110110  #:inline? #t
    111111  #:types? #t
     
    113113
    114114#;
    115 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.7")
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.8")
    116116  #:inline? #t
    117117  #:types? #t
     
    120120;; Main Modules
    121121
    122 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.7")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.8")
    123123  #:inline? #t
    124124  #:types? #t
    125125  #:compile-options `(-scrutinize ,@publoptn) )
    126126
    127 (setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.7")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.8")
    128128  #:inline? #t
    129129  #:types? #t
    130130  #:compile-options `(-scrutinize ,@publoptn) )
    131131
    132 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.7")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.8")
    133133  #:inline? #t
    134134  #:types? #t
    135135  #:compile-options `(-scrutinize ,@publoptn) )
    136136
    137 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.7")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.8")
    138138  #:inline? #t
    139139  #:types? #t
  • release/4/srfi-27/trunk/tests/run.scm

    r34021 r34035  
    188188;(system* "csi -n -s test-diehard") ;errors
    189189
    190 (newline)
     190;;
    191191
    192192(test-exit)
Note: See TracChangeset for help on using the changeset viewer.