Changeset 35477 in project


Ignore:
Timestamp:
04/29/18 18:31:42 (4 weeks ago)
Author:
kon
Message:

fix distribution generator type

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

Legend:

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

    r34967 r35477  
    88
    99(import (except scheme <= inexact->exact exact->inexact number?))
    10 
    1110(import chicken foreign)
    1211
    13 (import
     12(use
    1413  srfi-4
    1514  (only numbers <= inexact->exact exact->inexact number?)
     
    2019    random-large-integer random-large-real
    2120    native-real-precision?))
    22 (require-library
    23   srfi-4
    24   numbers
    25   random-source entropy-source
    26   srfi-27-numbers)
    2721
    2822(declare
  • release/4/srfi-27/trunk/mrg32k3a.scm

    r35385 r35477  
    1818
    1919(import (except scheme <= inexact->exact exact->inexact number?))
    20 
    2120(import chicken foreign)
    2221
  • release/4/srfi-27/trunk/mwc.scm

    r34780 r35477  
    88
    99(import (except scheme <= inexact->exact exact->inexact number?))
    10 
    1110(import chicken foreign)
    1211
    13 (import
     12(use
    1413  srfi-4
    1514  (only numbers <= inexact->exact exact->inexact number?)
     
    2120    random-large-integer random-large-real
    2221    native-real-precision?))
    23 (require-library
    24   srfi-4
    25   numbers
    26   type-errors
    27   random-source entropy-source srfi-27-numbers)
    2822
    2923(declare
  • release/4/srfi-27/trunk/srfi-27-bernoullis.scm

    r35475 r35477  
    4040    (else      (lambda () (<= (randoms) p)))) )
    4141
    42 (: make-random-bernoullis (#!rest (list-of *) --> boolean-function procedure))
     42(: make-random-bernoullis (#!rest --> boolean-function procedure))
    4343;
    4444(define (make-random-bernoullis #!key (p 0.5) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-binomials.scm

    r35475 r35477  
    4848            ((<= t i) n))))) )
    4949
    50 (: make-random-binomials (#!rest (list-of *) --> number-function procedure))
     50(: make-random-binomials (#!rest --> number-function procedure))
    5151;
    5252(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-cauchys.scm

    r35475 r35477  
    3838    (+ median (* sigma (tan (* *pi* (- (randoms) 0.5)))))) )
    3939
    40 (: make-random-cauchys (#!rest (list-of *) --> number-function procedure))
     40(: make-random-cauchys (#!rest --> number-function procedure))
    4141;
    4242(define (make-random-cauchys #!key (median 0.0) (sigma 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-common-types.scm

    r35475 r35477  
    1515(define-type random-source-state list)
    1616
    17 (define-type random-integer-function (fixnum --> number))
     17(define-type random-integer-function (number --> number))
    1818
    1919(define-type random-real-function (--> float))
  • release/4/srfi-27/trunk/srfi-27-erlangs.scm

    r35475 r35477  
    3838  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
    3939
    40 (: make-random-erlangs (#!rest (list-of *) --> number-function procedure))
     40(: make-random-erlangs (#!rest --> number-function procedure))
    4141;
    4242(define (make-random-erlangs #!key (alpha 1) (theta 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-exponentials.scm

    r35475 r35477  
    4242    (lambda () (* mu (- (log (randoms)))))) )
    4343
    44 (: make-random-exponentials (#!rest (list-of *) --> number-function procedure))
     44(: make-random-exponentials (#!rest --> number-function procedure))
    4545;
    4646(define (make-random-exponentials #!key (mu 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-gammas.scm

    r35475 r35477  
    7979                   (loop) ) ) ) ) ) ) ) ) )
    8080
    81 (: make-random-gammas (#!rest (list-of *) --> number-function procedure))
     81(: make-random-gammas (#!rest --> number-function procedure))
    8282;
    8383(define (make-random-gammas #!key (alpha 1.0) (theta 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-geometrics.scm

    r35475 r35477  
    3939      (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
    4040
    41 (: make-random-geometrics (#!rest (list-of *) --> number-function procedure))
     41(: make-random-geometrics (#!rest --> number-function procedure))
    4242;
    4343(define (make-random-geometrics #!key (p 0.5) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-levys.scm

    r35475 r35477  
    4141    (lambda () (let ((r (randoms))) (+ delta (* gamma (*reciprocal (* r r))))))) )
    4242
    43 (: make-random-levys (#!rest (list-of *) --> number-function procedure))
     43(: make-random-levys (#!rest --> number-function procedure))
    4444;
    4545(define (make-random-levys #!key (gamma 1.0) (delta 0.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-lognormals.scm

    r35475 r35477  
    4444      (exp (+ nmu (* (normals) nsigma))))) )
    4545
    46 (: make-random-lognormals (#!rest (list-of *) --> number-function procedure))
     46(: make-random-lognormals (#!rest --> number-function procedure))
    4747;
    4848(define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-normals.scm

    r35475 r35477  
    5656                (+ mu (* sigma scale v1))))))))) )
    5757
    58 (: make-random-normals (#!rest (list-of *) --> number-function procedure))
     58(: make-random-normals (#!rest --> number-function procedure))
    5959;
    6060(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-numbers.scm

    r34780 r35477  
    3333    exact->inexact inexact->exact
    3434    floor))
    35 
    3635(import chicken)
    3736
    38 (import
     37(use
    3938  (only numbers
    4039    <= < zero? positive? negative?
     
    4342    exact->inexact inexact->exact
    4443    floor))
    45 (require-library numbers)
    46 
    47 (import
     44(use
    4845  (only type-checks
    4946    define-check+error-type
     
    5249    error-argument-type
    5350    error-open-interval error-closed-interval))
    54 (require-library type-checks type-errors)
    5551
    5652(declare
  • release/4/srfi-27/trunk/srfi-27-paretos.scm

    r35475 r35477  
    4040    (*make-random-exponentials 1.0 (lambda () (*reciprocal (+ xmin (gammas)))))) )
    4141
    42 (: make-random-paretos (#!rest (list-of *) --> number-function procedure))
     42(: make-random-paretos (#!rest --> number-function procedure))
    4343;
    4444(define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-poissons.scm

    r35475 r35477  
    4242          ((<= prod emu) m)))) )
    4343
    44 (: make-random-poissons (#!rest (list-of *) --> number-function procedure))
     44(: make-random-poissons (#!rest --> number-function procedure))
    4545;
    4646(define (make-random-poissons #!key (mu 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-triangles.scm

    r35475 r35477  
    5151            (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
    5252
    53 (: make-random-triangles (#!rest (list-of *) --> number-function procedure))
     53(: make-random-triangles (#!rest --> number-function procedure))
    5454;
    5555(define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) (randoms (current-random-real)))
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r34865 r35477  
    1111
    1212(import (except scheme + - * quotient = < abs))
    13 
    1413(import chicken)
    1514
    16 (use data-structures)
    17 
    18 (import (only numbers + - * quotient = < abs))
    19 (require-library numbers)
    20 
    21 (import (only miscmacros exchange!))
    22 (require-library miscmacros)
    23 
    24 (use vector-lib)
    25 
    26 (import (only srfi-27 current-random-source))
    27 (require-library srfi-27)
    28 
    29 (use random-source)
    30 
    31 (import
     15(use (only numbers + - * quotient = < abs))
     16(use
     17  data-structures
     18  (only miscmacros exchange!)
     19  vector-lib
     20  (only srfi-27 current-random-source)
     21  random-source
    3222  (only srfi-27-numbers
    3323    check-integer check-positive-integer
    3424    check-real-precision))
    35 (require-library srfi-27-numbers)
    3625
    3726(declare
     
    3928    + - * quotient = <))
    4029
     30;;;
     31
     32(include "srfi-27-common-types")
     33
    4134;; Uniform random integers in [low high] by precision
    4235
     36;; Support
     37
     38(: *make-uniform-random-integers (number number number random-integer-function --> number-function))
     39;
     40(define (*make-uniform-random-integers low high prec rndint)
     41  (let ((dist (abs (- high low))))
     42    (if (< dist prec)
     43      (constantly low)
     44      (let (
     45        (rng (quotient (+ dist 1) prec)) )
     46        (cond
     47          ((= 0 rng)
     48            (constantly low) )
     49          ((= 0 low)
     50            (if (= 1 prec)
     51              (lambda ()
     52                (rndint rng) )
     53              (lambda ()
     54                (* (rndint rng) prec) ) ) )
     55          (else
     56            (lambda ()
     57              (+ low (* (rndint rng) prec) ) ) ) ) ) ) ) )
     58
     59(: make-uniform-random-integers (#!rest --> number-function procedure))
     60;
    4361(define (make-uniform-random-integers #!key high (low 0) (precision 1) (source (current-random-source)))
    4462  (check-random-source 'make-uniform-random-integers source 'source)
     
    5674;; Uniform random reals in (0.0 1.0) by precision
    5775
     76(: make-uniform-random-reals (#!rest --> number-function procedure))
     77;
    5878(define (make-uniform-random-reals #!key (precision #f) (source (current-random-source)))
    5979  (check-random-source 'make-uniform-random-reals source 'source)
     
    6585      (values precision source)) ) )
    6686
    67 ;; Support
    68 
    69 (define (*make-uniform-random-integers low high prec rndint)
    70   (let ((dist (abs (- high low))))
    71     (if (< dist prec)
    72       (constantly low)
    73       (let ((rng (quotient (+ dist 1) prec)))
    74         (cond
    75           ((= 0 rng)
    76             (constantly low) )
    77           ((= 0 low)
    78             (if (= 1 prec)
    79               (lambda ()
    80                 (rndint rng) )
    81               (lambda ()
    82                 (* (rndint rng) prec) ) ) )
    83           (else
    84             (lambda ()
    85               (+ low (* (rndint rng) prec) ) ) ) ) ) ) ) )
    86 
    8787) ;module srfi-27-uniform-random
  • release/4/srfi-27/trunk/srfi-27-vector-support.scm

    r34865 r35477  
    2323  vector%-sum-squares)
    2424
    25 (import scheme)
     25(import scheme chicken)
    2626
    27 (import chicken)
    28 
    29 (import
     27(use
    3028  (only srfi-4
    3129    u8vector-length u8vector-ref u8vector-set!
     
    3432  (only vector-lib vector-map! vector-fold)
    3533  (only type-errors error-vector))
    36 (require-library srfi-4 vector-lib type-errors)
    3734
    3835;;;
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r35456 r35477  
    1818  random-solid-sphere!)
    1919
    20 (import scheme)
    21 
    22 (import chicken)
    23 
    24 (import
    25   (only type-checks check-cardinal-integer check-vector check-procedure)
    26   (only type-errors error-vector))
    27 (require-library type-checks type-errors)
     20(import scheme chicken)
    2821
    2922(use
     23  (only type-checks check-cardinal-integer check-vector check-procedure)
     24  (only type-errors error-vector)
    3025  random-source
    3126  srfi-27-distributions
    3227  srfi-27-vector-support
    33   srfi-27)
     28  srfi-27
     29  srfi-27-distributions-support)
    3430
    3531;;;
    3632
    37 ; (in case special processing needed near limits TBD)
    38 (define (*reciprocal n) (/ 1.0 n))
    39 (define (*-reciprocal n) (/ -1.0 n))
     33#;
     34(define (vector-iota n)
     35  (import (only vector-lib vector-unfold))
     36  (vector-unfold values n) )
    4037
    41 (define (vector-iota-set! vec n)
    42   #;(list->vector (iota n))
     38(define (vector-iota! vec n)
    4339  (do ((i 0 (fx+ i 1)))
    4440      ((fx= i n) vec)
     
    5450(define (*random-permutation! vec rndint)
    5551  (let ((n (vector-length vec)))
    56     (vector-iota-set! vec n)
     52    (vector-iota! vec n)
    5753    (do ((k n (fx- k 1)))
    5854        ((fx= k 1)
    5955          vec )
    60       (let* ((i (fx- k 1))
    61              (j (rndint n))
    62              (xi (vector-ref vec i))
    63              (xj (vector-ref vec j)) )
     56      ;random-swap
     57      (let* (
     58        (i (fx- k 1))
     59        (j (rndint n))
     60        (xi (vector-ref vec i))
     61        (xj (vector-ref vec j)) )
    6462        (vector-set! vec i xj)
    6563        (vector-set! vec j xi) ) ) ) )
  • release/4/srfi-27/trunk/srfi-27-weibulls.scm

    r35475 r35477  
    4040    (lambda () (expt (* invscale (log (- 1.0 (randoms)))) invshape)) ) )
    4141
    42 (: make-random-weibulls (#!rest (list-of *) --> number-function procedure))
     42(: make-random-weibulls (#!rest --> number-function procedure))
    4343;
    4444(define (make-random-weibulls #!key (shape 1.0) (scale 1.0) (randoms (current-random-real)))
Note: See TracChangeset for help on using the changeset viewer.