Changeset 34023 in project for release/4


Ignore:
Timestamp:
04/24/17 08:49:57 (3 years ago)
Author:
Kon Lovett
Message:

Add {{random-integer/current}}, {{random-real/current}}. Doesn't use synch, thread-utils eggs. Fix {{make-uniform-random-integers}}.

Location:
release/4/srfi-27
Files:
3 deleted
6 edited
28 copied

Legend:

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

    r34015 r34023  
    3838  type-errors type-checks
    3939  srfi-27-uniform-random)
     40
     41(use srfi-27)
    4042
    4143;;; Chicken Generic Arithmetic Argument Checks
     
    108110                (+ mu (* sigma scale v1))))))))) )
    109111
    110 (define (make-random-normals
    111           #!key
    112                                         (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    113   (check-real 'make-random-normals mu 'mu)
    114   (check-nonzero-real 'make-random-normals sigma 'sigma)
    115   (check-procedure 'make-random-normals randoms 'randoms)
    116   (values
    117     (*make-random-normals mu sigma randoms)
    118     (lambda () (values mu sigma randoms))) )
     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))) ) )
    119120
    120121;;; Exponential distribution
     
    128129    (lambda () (* mu (- (log (randoms)))))) )
    129130
    130 (define (make-random-exponentials
    131           #!key
    132                                         (mu 1.0) (randoms (make-uniform-random-reals)))
    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))) )
     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))) ) )
    138138
    139139;;; Triangle distribution
     
    153153            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    154154
    155 (define (make-random-triangles
    156           #!key
    157                                         (s 0.0) (m 0.5) (l 1.0) (randoms (make-uniform-random-reals)))
    158   (check-real 'make-random-triangles s 's)
    159   (check-real 'make-random-triangles m 'm)
    160   (check-real 'make-random-triangles l 'l)
    161   (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
    162   (check-real-closed-interval 'make-random-triangles m s l 'm)
    163   (check-procedure 'make-random-triangles randoms 'randoms)
    164   (values
    165     (*make-random-triangles s m l randoms)
    166     (lambda () (values s m l randoms))) )
     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))) ) )
    167166
    168167;;; Poisson distribution
     
    176175          ((<= prod emu) m)))) )
    177176
    178 (define (make-random-poissons
    179           #!key
    180                                         (mu 1.0) (randoms (make-uniform-random-reals)))
    181   (check-nonnegative-real 'make-random-poissons mu 'mu)
    182   (check-procedure 'make-random-poissons randoms 'randoms)
    183   (values
    184     (*make-random-poissons mu randoms)
    185     (lambda () (values mu randoms))) )
     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))) ) )
    186184
    187185;;; Bernoulli distribution
     
    193191    (else      (lambda () (<= (randoms) p)))) )
    194192
    195 (define (make-random-bernoullis
    196           #!key
    197                                         (p 0.5) (randoms (make-uniform-random-reals)))
    198   (check-real-unit 'make-random-bernoullis p 'p)
    199   (check-procedure 'make-random-bernoullis randoms 'randoms)
    200   (values
    201     (*make-random-bernoullis p randoms)
    202     (lambda () (values p randoms))) )
     193(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))) ) )
    203200
    204201;;; Binomial distribution
     
    217214            ((<= t i) n))))) )
    218215
    219 (define (make-random-binomials
    220           #!key
    221                                         (t 1) (p 0.5) (randoms (make-uniform-random-reals)))
    222   (check-cardinal-integer 'make-random-binomials t 't)
    223   (check-real-unit 'make-random-binomials p 'p)
    224   (check-procedure 'make-random-binomials randoms 'randoms)
    225   (values
    226     (*make-random-binomials t p randoms)
    227     (lambda () (values t p randoms))) )
     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))) ) )
    228224
    229225;;; Geometric distribution
     
    234230      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    235231
    236 (define (make-random-geometrics
    237           #!key
    238                                         (p 0.5) (randoms (make-uniform-random-reals)))
    239   (check-real-unit 'make-random-geometrics p 'p)
    240   (check-procedure 'make-random-geometrics randoms 'randoms)
    241   (values
    242     (*make-random-geometrics p randoms)
    243     (lambda () (values p randoms))) )
     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))) ) )
    244239
    245240;;; Lognormal distribution
     
    252247      (exp (+ nmu (* (normals) nsigma))))) )
    253248
    254 (define (make-random-lognormals
    255           #!key
    256                                         (mu 1.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    257   (check-nonzero-real 'make-random-lognormals mu 'mu)
    258   (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
    259   (check-procedure 'make-random-lognormals randoms 'randoms)
    260   (values
    261     (*make-random-lognormals mu sigma randoms)
    262     (lambda () (values mu sigma randoms))) )
     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))) ) )
    263257
    264258;;; Cauchy distribution
    265259
    266260(define (*make-random-cauchys median sigma randoms)
    267   (lambda () (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
    268 
    269 (define (make-random-cauchys
    270           #!key
    271                                         (median 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    272   (check-real 'make-random-cauchys median 'median)
    273   (check-positive-real 'make-random-cauchys sigma 'sigma)
    274   (check-procedure 'make-random-cauchys randoms 'randoms)
    275   (values
    276     (*make-random-cauchys median sigma randoms)
    277     (lambda () (values median sigma randoms))) )
     261  (lambda ()
     262    (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
     263
     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))) ) )
    278272
    279273;;; Gamma distribution
     
    312306                   (loop) ) ) ) ) ) ) ) ) )
    313307
    314 (define (make-random-gammas
    315           #!key
    316                                         (alpha 1.0) (theta 1.0) (randoms (make-uniform-random-reals)))
    317   (check-positive-real 'make-random-gammas alpha 'alpha)
    318   (check-positive-real 'make-random-gammas theta 'theta)
    319   (check-procedure 'make-random-gammas randoms 'randoms)
    320   (values
    321     (*make-random-gammas alpha theta randoms)
    322     (lambda () (values alpha theta randoms))) )
     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))) ) )
    323316
    324317;;; Erlang distribution
     
    327320  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    328321
    329 (define (make-random-erlangs
    330           #!key
    331                                         (alpha 1) (theta 1.0) (randoms (make-uniform-random-reals)))
    332   (check-positive-real 'make-random-erlangs alpha 'alpha)
    333   (check-positive-real 'make-random-erlangs theta 'theta)
    334   (check-procedure 'make-random-erlangs randoms 'randoms)
    335   (values
    336     (*make-random-erlangs alpha theta randoms)
    337     (lambda () (values alpha theta randoms))) )
     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))) ) )
    338330
    339331;;; Pareto distribution
     
    343335    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    344336
    345 (define (make-random-paretos
    346           #!key
    347                                         (alpha 1.0) (xmin 1.0) (randoms (make-uniform-random-reals)))
    348   (check-positive-real 'make-random-paretos alpha 'alpha)
    349   (check-positive-real 'make-random-paretos xmin 'xmin)
    350   (check-procedure 'make-random-paretos randoms 'randoms)
    351   (values
    352     (*make-random-paretos alpha xmin randoms)
    353     (lambda () (values alpha xmin randoms))) )
     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))) ) )
    354345
    355346;;; Levy distribution
     
    362353    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    363354
    364 (define (make-random-levys
    365           #!key
    366                                         (gamma 1.0) (delta 0.0) (randoms (make-uniform-random-reals)))
    367   (check-nonnegative-real 'make-random-levys delta 'delta)
    368   (check-positive-real 'make-random-levys gamma 'gamma)
    369   (check-procedure 'make-random-levys randoms 'randoms)
    370   (values
    371     (*make-random-levys gamma delta randoms)
    372     (lambda () (values gamma delta randoms))) )
     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))) ) )
    373363
    374364;;; Weibull distribution
     
    379369    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    380370
    381 (define (make-random-weibulls
    382           #!key
    383                                         (shape 1.0) (scale 1.0) (randoms (make-uniform-random-reals)))
    384   (check-positive-real 'make-random-weibulls shape 'shape)
    385   (check-positive-real 'make-random-weibulls scale 'scale)
    386   (check-procedure 'make-random-weibulls randoms 'randoms)
    387   (values
    388     (*make-random-weibulls shape scale randoms)
    389     (lambda () (values shape scale randoms))) )
     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))) ) )
    390379
    391380) ;module srfi-27-distributions
  • release/4/srfi-27/tags/3.2.6/srfi-27-uniform-random.scm

    r34015 r34023  
    1010
    1111(import
    12   (except scheme + - * quotient = <)
     12  (except scheme + - * quotient = < abs)
    1313  chicken)
    1414
     15(use data-structures)
     16
    1517(import
    16   data-structures
    17   (only numbers + - * quotient = <)
    18   (only miscmacros exchange!)
    19   random-source
     18  (only numbers + - * quotient = < abs)
     19  (only miscmacros exchange!))
     20(require-library numbers miscmacros)
     21
     22(use vector-lib)
     23
     24(import
    2025  (only srfi-27 current-random-source)
    2126  (only srfi-27-numbers
    2227    check-integer check-positive-integer
    23     check-real-precision)
    24   vector-lib)
    25 (require-library
    26   data-structures
    27   numbers
    28   miscmacros
    29   random-source
    30   srfi-27 srfi-27-numbers
    31   vector-lib)
     28    check-real-precision))
     29(require-library srfi-27 srfi-27-numbers)
     30
     31(use random-source)
    3232
    3333(declare
     
    3838
    3939(define (*make-uniform-random-integers low high prec rndint)
    40   (let ((dist (- high low)))
     40  (let ((dist (abs (- high low))))
    4141    (if (< dist prec)
    42       (constantly prec)
     42      (constantly low)
    4343      (let ((rng (quotient (+ dist 1) prec)))
    4444        (cond
    4545          ((= 0 rng)
    46             (constantly 0) )
     46            (constantly low) )
    4747          ((= 0 low)
    4848            (if (= 1 prec)
     
    5757(define (make-uniform-random-integers
    5858          #!key
    59           (high #f) (low 0) (precision 1)
    60           (source (current-random-source)))
     59            high (low 0) (precision 1)
     60            (source (current-random-source)))
    6161  (check-random-source 'make-uniform-random-integers source 'source)
    6262  (let ((high (or high (- (*random-source-maximum-range source) 1))))
     
    7171        (values high low precision source)) ) ) )
    7272
    73 ;;; Uniform random reals in (0.0 1.0) by precion
     73;;; Uniform random reals in (0.0 1.0) by precision
    7474
    7575(define (make-uniform-random-reals
    7676          #!key
    77           (precision #f)
    78           (source (current-random-source)))
     77            (precision #f)
     78            (source (current-random-source)))
    7979  (check-random-source 'make-uniform-random-reals source 'source)
    8080  (when precision
  • release/4/srfi-27/tags/3.2.6/srfi-27-vector.scm

    r34015 r34023  
    2222(import
    2323  (only type-checks check-cardinal-integer check-vector check-procedure)
    24   (only type-errors error-vector)
     24  (only type-errors error-vector))
     25(require-library type-checks type-errors)
     26
     27(use
    2528  random-source
    26   srfi-27-uniform-random
    2729  srfi-27-distributions
    28   srfi-27-vector-support
    29   srfi-27)
    30 (require-library
    31   type-checks type-errors
    32   random-source
    33   srfi-27-uniform-random srfi-27-distributions
    3430  srfi-27-vector-support
    3531  srfi-27)
     
    4440  #;(list->vector (iota n))
    4541  (do ((i 0 (fx+ i 1)))
    46       ((fx= i n))
     42      ((fx= i n) vec)
    4743    (vector-set! vec i i) ) )
    4844
     
    6763        (vector-set! vec j xi) ) ) ) )
    6864
    69 (define (make-random-permutations #!key (randoms random-integer))
    70   (lambda (n)
     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))) ) )
     73
     74(define (random-permutation! vec #!key randoms)
     75  (let ((randoms (or randoms (random-integer/current))))
    7176    (*random-permutation!
    72       (make-vector
    73         (check-cardinal-integer 'make-random-permutations n 'length)
    74         0)
    75       (check-procedure 'make-random-permutations randoms 'randoms))) )
    76 
    77 (define (random-permutation! vec #!key (randoms random-integer))
    78   (*random-permutation!
    79     (check-vector 'random-permutation! vec)
    80     (check-procedure 'random-permutation! randoms 'randoms)) )
     77      (check-vector 'random-permutation! vec)
     78      (check-procedure 'random-permutation! randoms 'randoms)) ) )
    8179
    8280;;
    8381
    84 (define (make-random-vector #!key (randoms random-real))
    85   (lambda (n)
    86     (vector-filled!
    87       (make-vector
    88         (check-cardinal-integer 'random-vector n 'length))
    89       (check-procedure 'make-random-vector randoms 'randoms))) )
     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))) ) )
    9089
    91 (define (random-vector! vec #!key (randoms random-real))
    92   (vector%-filled!
    93     (check-vector% 'random-vector! vec)
    94     (check-procedure 'random-vector! randoms 'randoms)) )
     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)) ) )
    9595
    9696;;; Normal vectors
     
    114114    (**random-hollow-sphere! vec norms) ) )
    115115
    116 (define (make-random-hollow-sphere
    117             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    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) ) ) )
     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) ) ) ) )
    125125
    126 (define (random-hollow-sphere!
    127             vec
    128             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    129   (*random-hollow-sphere!
    130     (check-vector% 'random-hollow-sphere! vec)
    131     mu sigma randoms) )
     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) ) )
    132131
    133132;;
     
    149148    (**random-solid-sphere! vec randoms norms) ) )
    150149
    151 (define (make-random-solid-sphere
    152             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    153   (let-values (
    154       ((norms pl)
    155         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    156     (lambda (n)
    157       (**random-solid-sphere!
    158         (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
    159         randoms norms) ) ) )
     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) ) ) ) )
    160159
    161 (define (random-solid-sphere!
    162             vec
    163             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    164   (*random-solid-sphere!
    165     (check-vector% 'random-solid-sphere! vec)
    166     mu sigma randoms) )
     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) ) )
    167165
    168166) ;module srfi-27-vector
  • release/4/srfi-27/tags/3.2.6/srfi-27.meta

    r34021 r34023  
    1111        (check-errors "1.9.0")
    1212        (timed-resource "1.0.1")
    13         (thread-utils "1.0.0")
    1413        (miscmacros "2.8")
    1514        (vector-lib "1.2")
    1615        (numbers "2.8")
    17         (synch "2.1.0")
    1816        #;(random-bsd "0.2"))
    1917 (files
  • release/4/srfi-27/tags/3.2.6/srfi-27.scm

    r34021 r34023  
    1818  random-source-make-reals
    1919  ;; Extensions
     20  ;
    2021  registered-random-sources registered-random-source
    2122  current-random-source
     23  random-integer/current random-real/current
    2224  new-random-source
    2325  random-source-name random-source-kind
     
    3032  random-u8vector
    3133  random-f64vector
     34  ;
    3235  registered-entropy-sources registered-entropy-source
    3336  current-entropy-source
     
    167170        (current-random-source) ) ) ) )
    168171
     172(define (random-integer/current)
     173  ((@random-source-make-integers (current-random-source))) )
     174
     175(define (random-real/current)
     176  ((@random-source-make-reals (current-random-source)) #f) )
     177
    169178(define (make-random-source #!optional (rs (current-random-source)))
    170179  (let ((ctor
  • release/4/srfi-27/tags/3.2.6/srfi-27.setup

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

    r34015 r34023  
    77
    88(;export
     9  make-random-normals
    910  make-random-exponentials
    10   make-random-normals
    1111  make-random-triangles
    1212  make-random-poissons
     
    3838  type-errors type-checks
    3939  srfi-27-uniform-random)
     40
     41(use srfi-27)
    4042
    4143;;; Chicken Generic Arithmetic Argument Checks
     
    108110                (+ mu (* sigma scale v1))))))))) )
    109111
    110 (define (make-random-normals
    111           #!key
    112                                         (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    113   (check-real 'make-random-normals mu 'mu)
    114   (check-nonzero-real 'make-random-normals sigma 'sigma)
    115   (check-procedure 'make-random-normals randoms 'randoms)
    116   (values
    117     (*make-random-normals mu sigma randoms)
    118     (lambda () (values mu sigma randoms))) )
     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))) ) )
    119120
    120121;;; Exponential distribution
     
    128129    (lambda () (* mu (- (log (randoms)))))) )
    129130
    130 (define (make-random-exponentials
    131           #!key
    132                                         (mu 1.0) (randoms (make-uniform-random-reals)))
    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))) )
     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))) ) )
    138138
    139139;;; Triangle distribution
     
    153153            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    154154
    155 (define (make-random-triangles
    156           #!key
    157                                         (s 0.0) (m 0.5) (l 1.0) (randoms (make-uniform-random-reals)))
    158   (check-real 'make-random-triangles s 's)
    159   (check-real 'make-random-triangles m 'm)
    160   (check-real 'make-random-triangles l 'l)
    161   (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
    162   (check-real-closed-interval 'make-random-triangles m s l 'm)
    163   (check-procedure 'make-random-triangles randoms 'randoms)
    164   (values
    165     (*make-random-triangles s m l randoms)
    166     (lambda () (values s m l randoms))) )
     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))) ) )
    167166
    168167;;; Poisson distribution
     
    176175          ((<= prod emu) m)))) )
    177176
    178 (define (make-random-poissons
    179           #!key
    180                                         (mu 1.0) (randoms (make-uniform-random-reals)))
    181   (check-nonnegative-real 'make-random-poissons mu 'mu)
    182   (check-procedure 'make-random-poissons randoms 'randoms)
    183   (values
    184     (*make-random-poissons mu randoms)
    185     (lambda () (values mu randoms))) )
     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))) ) )
    186184
    187185;;; Bernoulli distribution
     
    193191    (else      (lambda () (<= (randoms) p)))) )
    194192
    195 (define (make-random-bernoullis
    196           #!key
    197                                         (p 0.5) (randoms (make-uniform-random-reals)))
    198   (check-real-unit 'make-random-bernoullis p 'p)
    199   (check-procedure 'make-random-bernoullis randoms 'randoms)
    200   (values
    201     (*make-random-bernoullis p randoms)
    202     (lambda () (values p randoms))) )
     193(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))) ) )
    203200
    204201;;; Binomial distribution
     
    217214            ((<= t i) n))))) )
    218215
    219 (define (make-random-binomials
    220           #!key
    221                                         (t 1) (p 0.5) (randoms (make-uniform-random-reals)))
    222   (check-cardinal-integer 'make-random-binomials t 't)
    223   (check-real-unit 'make-random-binomials p 'p)
    224   (check-procedure 'make-random-binomials randoms 'randoms)
    225   (values
    226     (*make-random-binomials t p randoms)
    227     (lambda () (values t p randoms))) )
     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))) ) )
    228224
    229225;;; Geometric distribution
     
    234230      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    235231
    236 (define (make-random-geometrics
    237           #!key
    238                                         (p 0.5) (randoms (make-uniform-random-reals)))
    239   (check-real-unit 'make-random-geometrics p 'p)
    240   (check-procedure 'make-random-geometrics randoms 'randoms)
    241   (values
    242     (*make-random-geometrics p randoms)
    243     (lambda () (values p randoms))) )
     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))) ) )
    244239
    245240;;; Lognormal distribution
     
    252247      (exp (+ nmu (* (normals) nsigma))))) )
    253248
    254 (define (make-random-lognormals
    255           #!key
    256                                         (mu 1.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    257   (check-nonzero-real 'make-random-lognormals mu 'mu)
    258   (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
    259   (check-procedure 'make-random-lognormals randoms 'randoms)
    260   (values
    261     (*make-random-lognormals mu sigma randoms)
    262     (lambda () (values mu sigma randoms))) )
     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))) ) )
    263257
    264258;;; Cauchy distribution
    265259
    266260(define (*make-random-cauchys median sigma randoms)
    267   (lambda () (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
    268 
    269 (define (make-random-cauchys
    270           #!key
    271                                         (median 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    272   (check-real 'make-random-cauchys median 'median)
    273   (check-positive-real 'make-random-cauchys sigma 'sigma)
    274   (check-procedure 'make-random-cauchys randoms 'randoms)
    275   (values
    276     (*make-random-cauchys median sigma randoms)
    277     (lambda () (values median sigma randoms))) )
     261  (lambda ()
     262    (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
     263
     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))) ) )
    278272
    279273;;; Gamma distribution
     
    312306                   (loop) ) ) ) ) ) ) ) ) )
    313307
    314 (define (make-random-gammas
    315           #!key
    316                                         (alpha 1.0) (theta 1.0) (randoms (make-uniform-random-reals)))
    317   (check-positive-real 'make-random-gammas alpha 'alpha)
    318   (check-positive-real 'make-random-gammas theta 'theta)
    319   (check-procedure 'make-random-gammas randoms 'randoms)
    320   (values
    321     (*make-random-gammas alpha theta randoms)
    322     (lambda () (values alpha theta randoms))) )
     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))) ) )
    323316
    324317;;; Erlang distribution
     
    327320  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    328321
    329 (define (make-random-erlangs
    330           #!key
    331                                         (alpha 1) (theta 1.0) (randoms (make-uniform-random-reals)))
    332   (check-positive-real 'make-random-erlangs alpha 'alpha)
    333   (check-positive-real 'make-random-erlangs theta 'theta)
    334   (check-procedure 'make-random-erlangs randoms 'randoms)
    335   (values
    336     (*make-random-erlangs alpha theta randoms)
    337     (lambda () (values alpha theta randoms))) )
     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))) ) )
    338330
    339331;;; Pareto distribution
     
    343335    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    344336
    345 (define (make-random-paretos
    346           #!key
    347                                         (alpha 1.0) (xmin 1.0) (randoms (make-uniform-random-reals)))
    348   (check-positive-real 'make-random-paretos alpha 'alpha)
    349   (check-positive-real 'make-random-paretos xmin 'xmin)
    350   (check-procedure 'make-random-paretos randoms 'randoms)
    351   (values
    352     (*make-random-paretos alpha xmin randoms)
    353     (lambda () (values alpha xmin randoms))) )
     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))) ) )
    354345
    355346;;; Levy distribution
     
    362353    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    363354
    364 (define (make-random-levys
    365           #!key
    366                                         (gamma 1.0) (delta 0.0) (randoms (make-uniform-random-reals)))
    367   (check-nonnegative-real 'make-random-levys delta 'delta)
    368   (check-positive-real 'make-random-levys gamma 'gamma)
    369   (check-procedure 'make-random-levys randoms 'randoms)
    370   (values
    371     (*make-random-levys gamma delta randoms)
    372     (lambda () (values gamma delta randoms))) )
     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))) ) )
    373363
    374364;;; Weibull distribution
     
    379369    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    380370
    381 (define (make-random-weibulls
    382           #!key
    383                                         (shape 1.0) (scale 1.0) (randoms (make-uniform-random-reals)))
    384   (check-positive-real 'make-random-weibulls shape 'shape)
    385   (check-positive-real 'make-random-weibulls scale 'scale)
    386   (check-procedure 'make-random-weibulls randoms 'randoms)
    387   (values
    388     (*make-random-weibulls shape scale randoms)
    389     (lambda () (values shape scale randoms))) )
     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))) ) )
    390379
    391380) ;module srfi-27-distributions
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r34015 r34023  
    1010
    1111(import
    12   (except scheme + - * quotient = <)
     12  (except scheme + - * quotient = < abs)
    1313  chicken)
    1414
     15(use data-structures)
     16
    1517(import
    16   data-structures
    17   (only numbers + - * quotient = <)
    18   (only miscmacros exchange!)
    19   random-source
     18  (only numbers + - * quotient = < abs)
     19  (only miscmacros exchange!))
     20(require-library numbers miscmacros)
     21
     22(use vector-lib)
     23
     24(import
    2025  (only srfi-27 current-random-source)
    2126  (only srfi-27-numbers
    2227    check-integer check-positive-integer
    23     check-real-precision)
    24   vector-lib)
    25 (require-library
    26   data-structures
    27   numbers
    28   miscmacros
    29   random-source
    30   srfi-27 srfi-27-numbers
    31   vector-lib)
     28    check-real-precision))
     29(require-library srfi-27 srfi-27-numbers)
     30
     31(use random-source)
    3232
    3333(declare
     
    3838
    3939(define (*make-uniform-random-integers low high prec rndint)
    40   (let ((dist (- high low)))
     40  (let ((dist (abs (- high low))))
    4141    (if (< dist prec)
    42       (constantly prec)
     42      (constantly low)
    4343      (let ((rng (quotient (+ dist 1) prec)))
    4444        (cond
    4545          ((= 0 rng)
    46             (constantly 0) )
     46            (constantly low) )
    4747          ((= 0 low)
    4848            (if (= 1 prec)
     
    5757(define (make-uniform-random-integers
    5858          #!key
    59           (high #f) (low 0) (precision 1)
    60           (source (current-random-source)))
     59            high (low 0) (precision 1)
     60            (source (current-random-source)))
    6161  (check-random-source 'make-uniform-random-integers source 'source)
    6262  (let ((high (or high (- (*random-source-maximum-range source) 1))))
     
    7171        (values high low precision source)) ) ) )
    7272
    73 ;;; Uniform random reals in (0.0 1.0) by precion
     73;;; Uniform random reals in (0.0 1.0) by precision
    7474
    7575(define (make-uniform-random-reals
    7676          #!key
    77           (precision #f)
    78           (source (current-random-source)))
     77            (precision #f)
     78            (source (current-random-source)))
    7979  (check-random-source 'make-uniform-random-reals source 'source)
    8080  (when precision
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r34015 r34023  
    2222(import
    2323  (only type-checks check-cardinal-integer check-vector check-procedure)
    24   (only type-errors error-vector)
     24  (only type-errors error-vector))
     25(require-library type-checks type-errors)
     26
     27(use
    2528  random-source
    26   srfi-27-uniform-random
    2729  srfi-27-distributions
    28   srfi-27-vector-support
    29   srfi-27)
    30 (require-library
    31   type-checks type-errors
    32   random-source
    33   srfi-27-uniform-random srfi-27-distributions
    3430  srfi-27-vector-support
    3531  srfi-27)
     
    4440  #;(list->vector (iota n))
    4541  (do ((i 0 (fx+ i 1)))
    46       ((fx= i n))
     42      ((fx= i n) vec)
    4743    (vector-set! vec i i) ) )
    4844
     
    6763        (vector-set! vec j xi) ) ) ) )
    6864
    69 (define (make-random-permutations #!key (randoms random-integer))
    70   (lambda (n)
     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))) ) )
     73
     74(define (random-permutation! vec #!key randoms)
     75  (let ((randoms (or randoms (random-integer/current))))
    7176    (*random-permutation!
    72       (make-vector
    73         (check-cardinal-integer 'make-random-permutations n 'length)
    74         0)
    75       (check-procedure 'make-random-permutations randoms 'randoms))) )
    76 
    77 (define (random-permutation! vec #!key (randoms random-integer))
    78   (*random-permutation!
    79     (check-vector 'random-permutation! vec)
    80     (check-procedure 'random-permutation! randoms 'randoms)) )
     77      (check-vector 'random-permutation! vec)
     78      (check-procedure 'random-permutation! randoms 'randoms)) ) )
    8179
    8280;;
    8381
    84 (define (make-random-vector #!key (randoms random-real))
    85   (lambda (n)
    86     (vector-filled!
    87       (make-vector
    88         (check-cardinal-integer 'random-vector n 'length))
    89       (check-procedure 'make-random-vector randoms 'randoms))) )
     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))) ) )
    9089
    91 (define (random-vector! vec #!key (randoms random-real))
    92   (vector%-filled!
    93     (check-vector% 'random-vector! vec)
    94     (check-procedure 'random-vector! randoms 'randoms)) )
     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)) ) )
    9595
    9696;;; Normal vectors
     
    114114    (**random-hollow-sphere! vec norms) ) )
    115115
    116 (define (make-random-hollow-sphere
    117             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    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) ) ) )
     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) ) ) ) )
    125125
    126 (define (random-hollow-sphere!
    127             vec
    128             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    129   (*random-hollow-sphere!
    130     (check-vector% 'random-hollow-sphere! vec)
    131     mu sigma randoms) )
     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) ) )
    132131
    133132;;
     
    149148    (**random-solid-sphere! vec randoms norms) ) )
    150149
    151 (define (make-random-solid-sphere
    152             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    153   (let-values (
    154       ((norms pl)
    155         (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
    156     (lambda (n)
    157       (**random-solid-sphere!
    158         (make-vector (check-cardinal-integer 'random-solid-sphere n 'length))
    159         randoms norms) ) ) )
     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) ) ) ) )
    160159
    161 (define (random-solid-sphere!
    162             vec
    163             #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
    164   (*random-solid-sphere!
    165     (check-vector% 'random-solid-sphere! vec)
    166     mu sigma randoms) )
     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) ) )
    167165
    168166) ;module srfi-27-vector
  • release/4/srfi-27/trunk/srfi-27.meta

    r34021 r34023  
    1111        (check-errors "1.9.0")
    1212        (timed-resource "1.0.1")
    13         (thread-utils "1.0.0")
    1413        (miscmacros "2.8")
    1514        (vector-lib "1.2")
    1615        (numbers "2.8")
    17         (synch "2.1.0")
    1816        #;(random-bsd "0.2"))
    1917 (files
  • release/4/srfi-27/trunk/srfi-27.scm

    r34021 r34023  
    1818  random-source-make-reals
    1919  ;; Extensions
     20  ;
    2021  registered-random-sources registered-random-source
    2122  current-random-source
     23  random-integer/current random-real/current
    2224  new-random-source
    2325  random-source-name random-source-kind
     
    3032  random-u8vector
    3133  random-f64vector
     34  ;
    3235  registered-entropy-sources registered-entropy-source
    3336  current-entropy-source
     
    167170        (current-random-source) ) ) ) )
    168171
     172(define (random-integer/current)
     173  ((@random-source-make-integers (current-random-source))) )
     174
     175(define (random-real/current)
     176  ((@random-source-make-reals (current-random-source)) #f) )
     177
    169178(define (make-random-source #!optional (rs (current-random-source)))
    170179  (let ((ctor
  • release/4/srfi-27/trunk/srfi-27.setup

    r34021 r34023  
    1717#;(define publoptn '())
    1818
    19 (setup-shared-extension-module 'fp-extn (extension-version "3.2.5")
     19(setup-shared-extension-module 'fp-extn (extension-version "3.2.6")
    2020  #:inline? #t
    2121  #:types? #t
    2222  #:compile-options `(-scrutinize ,@utiloptn) )
    2323
    24 (setup-shared-extension-module 'source-registration (extension-version "3.2.5")
     24(setup-shared-extension-module 'source-registration (extension-version "3.2.6")
    2525  #:inline? #t
    2626  #:types? #t
    2727  #:compile-options `(-scrutinize ,@utiloptn) )
    2828
    29 (setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.5")
     29(setup-shared-extension-module 'srfi-27-numbers (extension-version "3.2.6")
    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.5")
     34(setup-shared-extension-module 'srfi-27-vector-support (extension-version "3.2.6")
    3535  #:inline? #t
    3636  #:types? #t
     
    3939;; Entropy Source Modules
    4040
    41 (setup-shared-extension-module 'entropy-source (extension-version "3.2.5")
     41(setup-shared-extension-module 'entropy-source (extension-version "3.2.6")
    4242  #:inline? #t
    4343  #:types? #t
    4444  #:compile-options `(-scrutinize ,@utiloptn) )
    4545
    46 (setup-shared-extension-module 'entropy-support (extension-version "3.2.5")
     46(setup-shared-extension-module 'entropy-support (extension-version "3.2.6")
    4747  #:inline? #t
    4848  #:types? #t
    4949  #:compile-options `(-scrutinize ,@utiloptn) )
    5050
    51 (setup-shared-extension-module 'entropy-clock (extension-version "3.2.5")
     51(setup-shared-extension-module 'entropy-clock (extension-version "3.2.6")
    5252  #:inline? #t
    5353  #:types? #t
    5454  #:compile-options `(-scrutinize ,@publoptn) )
    5555
    56 (setup-shared-extension-module 'entropy-procedure (extension-version "3.2.5")
     56(setup-shared-extension-module 'entropy-procedure (extension-version "3.2.6")
    5757  #:inline? #t
    5858  #:types? #t
     
    6161    -no-procedure-checks) )
    6262
    63 (setup-shared-extension-module 'entropy-port (extension-version "3.2.5")
     63(setup-shared-extension-module 'entropy-port (extension-version "3.2.6")
    6464  #:inline? #t
    6565  #:types? #t
     
    6767
    6868#+unix
    69 (setup-shared-extension-module 'entropy-unix (extension-version "3.2.5")
     69(setup-shared-extension-module 'entropy-unix (extension-version "3.2.6")
    7070  #:inline? #t
    7171  #:types? #t
     
    7373
    7474#+windows
    75 (setup-shared-extension-module 'entropy-windows (extension-version "3.2.5")
     75(setup-shared-extension-module 'entropy-windows (extension-version "3.2.6")
    7676  #:inline? #t
    7777  #:types? #t
     
    7979
    8080#;
    81 (setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.5")
     81(setup-shared-extension-module 'composite-entropy-source (extension-version "3.2.6")
    8282  #:inline? #t
    8383  #:types? #t
     
    8686;; Random Source Modules
    8787
    88 (setup-shared-extension-module 'random-source (extension-version "3.2.5")
     88(setup-shared-extension-module 'random-source (extension-version "3.2.6")
    8989  #:inline? #t
    9090  #:types? #t
    9191  #:compile-options `(-scrutinize ,@utiloptn) )
    9292
    93 (setup-shared-extension-module 'mrg32k3a (extension-version "3.2.5")
     93(setup-shared-extension-module 'mrg32k3a (extension-version "3.2.6")
    9494  #:inline? #t
    9595  #:types? #t
    9696  #:compile-options `(-scrutinize ,@utiloptn) )
    9797
    98 (setup-shared-extension-module 'mwc (extension-version "3.2.5")
     98(setup-shared-extension-module 'mwc (extension-version "3.2.6")
    9999  #:inline? #t
    100100  #:types? #t
    101101  #:compile-options `(-scrutinize ,@utiloptn) )
    102102
    103 (setup-shared-extension-module 'moa (extension-version "3.2.5")
     103(setup-shared-extension-module 'moa (extension-version "3.2.6")
    104104  #:inline? #t
    105105  #:types? #t
     
    107107
    108108#;
    109 (setup-shared-extension-module 'bsdrnd (extension-version "3.2.5")
     109(setup-shared-extension-module 'bsdrnd (extension-version "3.2.6")
    110110  #:inline? #t
    111111  #:types? #t
     
    113113
    114114#;
    115 (setup-shared-extension-module 'composite-random-source (extension-version "3.2.5")
     115(setup-shared-extension-module 'composite-random-source (extension-version "3.2.6")
    116116  #:inline? #t
    117117  #:types? #t
     
    120120;; Main Modules
    121121
    122 (setup-shared-extension-module 'srfi-27 (extension-version "3.2.5")
     122(setup-shared-extension-module 'srfi-27 (extension-version "3.2.6")
    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.5")
     127(setup-shared-extension-module 'srfi-27-uniform-random (extension-version "3.2.6")
    128128  #:inline? #t
    129129  #:types? #t
    130130  #:compile-options `(-scrutinize ,@publoptn) )
    131131
    132 (setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.5")
     132(setup-shared-extension-module 'srfi-27-distributions (extension-version "3.2.6")
    133133  #:inline? #t
    134134  #:types? #t
    135135  #:compile-options `(-scrutinize ,@publoptn) )
    136136
    137 (setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.5")
     137(setup-shared-extension-module 'srfi-27-vector (extension-version "3.2.6")
    138138  #:inline? #t
    139139  #:types? #t
Note: See TracChangeset for help on using the changeset viewer.