Changeset 17330 in project


Ignore:
Timestamp:
02/21/10 01:03:50 (10 years ago)
Author:
Kon Lovett
Message:

Better argchck.

Location:
release/4/srfi-27/trunk
Files:
1 added
7 edited

Legend:

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

    r17320 r17330  
    1111
    1212  (;export
    13     ;
    1413    make-entropic-u8/f64
     14    entropic-u8vector-filled/f64
     15    entropic-u8vector-filled
     16    port-entropic-u8
     17    port-entropic-u8vector
    1518    make-entropic-f64/u8
    16     entropic-u8vector-filled/f64
    1719    entropic-f64vector-filled/u8
    18     entropic-u8vector-filled
    1920    entropic-f64vector-filled
    20     ;
    21     port-entropic-u8
    2221    port-entropic-f64
    23     port-entropic-u8vector
    2422    port-entropic-f64vector)
    2523
     
    3230            f64vector-set! make-f64vector f64vector-length
    3331            read-u8vector!)
    34           (only lolevel move-memory!))
     32          (only lolevel move-memory!)
     33          (only srfi-27-srfi-4 u8vector-filled! f64vector-filled!))
    3534
    36   (require-library extras srfi-4 lolevel)
     35  (require-library extras srfi-4 lolevel srfi-27-srfi-4)
    3736
    3837;; Double stuff
     
    6362#;(define BYTES/F64 (foreign-value "sizeof( double )" int))
    6463(define-constant BYTES/F64 8)
    65 
    66 ;; Vector stuff
    67 
    68 (define (u8vector-filled! u8vec u8gen #!optional (start 0) (end (u8vector-length u8vec)))
    69   (do ((idx start (fx+ idx 1)))
    70       ((fx= end idx) u8vec)
    71     (u8vector-set! u8vec idx (u8gen)) ) )
    72 
    73 (define (f64vector-filled! f64vec f64gen #!optional (start 0) (end (f64vector-length f64vec)))
    74   (do ((idx start (fx+ idx 1)))
    75       ((fx= end idx) f64vec)
    76     (f64vector-set! f64vec idx (f64gen)) ) )
    7764
    7865;; Entropy from procedure
  • release/4/srfi-27/trunk/srfi-27-distributions.scm

    r17326 r17330  
    2121
    2222  (import (except scheme
    23             number? real? integer? positive? zero? negative?
    24             = >= <= < >
    25             inexact->exact
    26             exp log sqrt floor tan expt
    27             + - * /)
     23            = < <= zero? positive?
     24            + - * / log sqrt expt exp
     25            exact->inexact)
    2826          chicken
    29           (only type-errors error-vector)
    30           type-checks
    3127          (only numbers
    32             number? real? integer? positive? zero? negative?
    33             = >= <= < >
    34             inexact->exact
    35             exp log sqrt floor tan expt
    36             + - * /)
     28            = < <= zero? positive?
     29            + - * / log sqrt expt exp
     30            exact->inexact)
     31          (only type-checks check-procedure)
    3732          random-source
    38           srfi-27)
    39 
    40   (require-library vector-lib type-errors type-checks numbers random-source srfi-27)
     33          srfi-27-uniform-random
     34          srfi-27-numbers)
     35
     36  (require-library vector-lib numbers type-checks srfi-27-uniform-random srfi-27-numbers)
    4137
    4238  (declare
    4339    (not usual-integrations
    44       number? real? integer? positive? zero? negative?
    45       = >= <= < >
    46       inexact->exact
    47       exp log sqrt floor tan expt
    48       + - * /) )
     40      = < <= zero? positive?
     41      + - * / log sqrt expt exp
     42      exact->inexact) )
    4943
    5044;;;
     
    5953(define-inline (*-inverse n) (/ -1.0 n))
    6054
    61 ;;; Exponentials
     55;;; Normal distribution
     56
     57;; Knuth's "The Art of Computer Programming", Vol. II, 2nd ed.,
     58;; Algorithm P of Section 3.4.1.C.
     59
     60(define (*make-random-normals mu sigma randoms)
     61  (let ((next #f))
     62    (lambda ()
     63      (if next
     64          (let ((result next))
     65            (set! next #f)
     66            (+ mu (* sigma result)))
     67          (let loop ()
     68            (let* ((v1 (- (* 2 (randoms)) 1.0))
     69                   (v2 (- (* 2 (randoms)) 1.0))
     70                   (s (+ (* v1 v1) (* v2 v2))))
     71              (if (<= 1.0 s)
     72                  (loop)
     73                  (let ((scale (sqrt (/ (* -2 (log s)) s))))
     74                    (set! next (* scale v2))
     75                    (+ mu (* sigma scale v1))))))))) )
     76
     77(define (make-random-normals #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     78  (check-real 'make-random-normals mu 'mu)
     79  (check-nonzero-real 'make-random-normals sigma 'sigma)
     80  (check-procedure 'make-random-normals randoms 'randoms)
     81  (values
     82    (*make-random-normals mu sigma randoms)
     83    (lambda () (values mu sigma randoms))) )
     84
     85;;; Exponential distribution
    6286
    6387;; Knuth's "The Art of Computer Programming", Vol. II, 2nd ed.,
    6488;; Section 3.4.1.D.
    6589
    66 (define (make-random-exponentials #!optional (mu 1.0) (rand (make-uniform-random-reals)))
    67   (unless (and (real? mu) (<= 0.0 mu 1.0))
    68     (error 'make-random-exponentials "bad mu argument type - must be a real in (0.0 1.0)" mu))
    69   (values
    70     (if (= 1.0 mu)
    71         (lambda () (- (log (rand))))
    72         (lambda () (* mu (- (log (rand))))))
    73     (lambda () (values mu rand))) )
    74 
    75 ;;; Normals
    76 
    77 ;; Knuth's "The Art of Computer Programming", Vol. II, 2nd ed.,
    78 ;; Algorithm P of Section 3.4.1.C.
    79 
    80 (define (make-random-normals #!optional (mu 0.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    81   (unless (real? mu)
    82     (error 'make-random-normals "mu must be a real" mu))
    83   (unless (and (real? sigma) (not (zero? sigma)))
    84     (error 'make-random-normals "sigma must be a non-zero real" sigma))
    85   (let ((next #f))
    86     (values
    87       (lambda ()
    88         (if next
    89             (let ((result next))
    90               (set! next #f)
    91               (+ mu (* sigma result)))
    92             (let loop ()
    93               (let* ((v1 (- (* 2 (rand)) 1.0))
    94                      (v2 (- (* 2 (rand)) 1.0))
    95                      (s (+ (* v1 v1) (* v2 v2))))
    96                 (if (>= s 1.0)
    97                     (loop)
    98                     (let ((scale (sqrt (/ (* -2 (log s)) s))))
    99                       (set! next (* scale v2))
    100                       (+ mu (* sigma scale v1))))))))
    101       (lambda () (values mu sigma rand)))) )
    102 
    103 ;;; Triangles
     90(define (*make-random-exponentials mu randoms)
     91  (if (= 1.0 mu)
     92      (lambda () (- (log (randoms))))
     93      (lambda () (* mu (- (log (randoms)))))) )
     94
     95(define (make-random-exponentials #!key (mu 1.0) (randoms (make-uniform-random-reals)))
     96  (check-real-unit 'make-random-exponentials mu 'mu)
     97  (check-procedure 'make-random-exponentials randoms 'randoms)
     98  (values
     99    (*make-random-exponentials mu randoms)
     100    (lambda () (values mu randoms))) )
     101
     102;;; Triangle distribution
    104103
    105104;; s - smallest, m - most probable, l - largest
    106105
    107 (define (make-random-triangles #!optional (s 0.0) (m 0.5) (l 1.0) (rand (make-uniform-random-reals)))
    108   (unless (real? s)
    109     (error 'make-random-triangles "s must be a real" s))
    110   (unless (and (real? l) (< s l))
    111     (error 'make-random-triangles "l must be a real in (s +inf)" l))
    112   (unless (and (real? m) (<= s m l))
    113     (error 'make-random-triangles "m must be a real in (s l)" m))
     106(define (*make-random-triangles s m l randoms)
    114107  (let ((d1 (- m s))
    115108        (d2 (- l s))
     
    117110    (let ((q1 (/ d1 d2))
    118111          (p1 (sqrt (* d1 d2))))
    119       (values
     112      (lambda ()
     113        (let ((u (randoms)))
     114          (if (<= u q1)
     115              (+ s (* p1 (sqrt u)))
     116              (- l (* d3 (sqrt (- (* d2 u) d1))))))))) )
     117
     118(define (make-random-triangles #!key (s 0.0) (m 0.5) (l 1.0) (randoms (make-uniform-random-reals)))
     119  (check-real 'make-random-triangles s 's)
     120  (check-real-open-interval 'make-random-triangles l s +inf.0 'l)
     121  (check-real-closed-interval 'make-random-triangles m s l 'm)
     122  (check-procedure 'make-random-triangles randoms 'randoms)
     123  (values
     124    (*make-random-triangles s m l randoms)
     125    (lambda () (values s m l randoms))) )
     126
     127;;; Poisson distribution
     128
     129(define (*make-random-poissons mu randoms)
     130  (let ((emu (exp (- mu))))
     131    (lambda ()
     132      ; FIXME O(mu) but O(log(mu)) desired for >> mu
     133      (do ((m 0 (fx+ 1 m))
     134           (prod (randoms) (* prod (randoms))))
     135          ((<= prod emu) m)))) )
     136
     137(define (make-random-poissons #!key (mu 1.0) (randoms (make-uniform-random-reals)))
     138  (check-nonnegative-real 'make-random-poissons mu 'mu)
     139  (check-procedure 'make-random-poissons randoms 'randoms)
     140  (values
     141    (*make-random-poissons mu randoms)
     142    (lambda () (values mu randoms))) )
     143
     144;;; Bernoulli distribution
     145
     146(define (*make-random-bernoullis p randoms)
     147  (cond ((zero? p) (lambda () #f))
     148        ((= 1.0 p) (lambda () #t))
     149        (else      (lambda () (<= (randoms) p)))) )
     150
     151(define (make-random-bernoullis #!key (p 0.5) (randoms (make-uniform-random-reals)))
     152  (check-real-unit 'make-random-bernoullis p 'p)
     153  (check-procedure 'make-random-bernoullis randoms 'randoms)
     154  (values
     155    (*make-random-bernoullis p randoms)
     156    (lambda () (values p randoms))) )
     157
     158;;; Binomial distribution
     159
     160(define (*make-random-binomials t p randoms)
     161  (let ((bernoullis (*make-random-bernoullis p randoms)))
     162    ;FIXME O(t) but O(log(t)) desired for >> t
     163    (if (< t most-positive-fixnum)
    120164        (lambda ()
    121           (let ((u (rand)))
    122             (if (<= u q1)
    123                 (+ s (* p1 (sqrt u)))
    124                 (- l (* d3 (sqrt (- (* d2 u) d1)))))))
    125         (lambda () (values s m l rand))))) )
    126 
    127 ;;; Poisson
    128 
    129 (define (make-random-poissons #!optional (mu 1.0) (rand (make-uniform-random-reals)))
    130   (unless (and (real? mu) (not (negative? mu)))
    131     (error 'make-random-poissons "mu must be a non-negative real" mu))
    132   (let ((emu (exp (- mu))))
    133     (values
    134       (lambda ()
    135         ; FIXME O(mu) but O(log(mu)) desired for >> mu
    136         (do ((m 0 (fx+ 1 m))
    137              (prod (rand) (* prod (rand))))
    138             ((<= prod emu) m)))
    139       (lambda () (values mu rand)))) )
    140 
    141 ;;; Bernoulli
    142 
    143 (define (make-random-bernoullis #!optional (p 0.5) (rand (make-uniform-random-reals)))
    144   (unless (and (real? p) (<= 0.0 p 1.0))
    145     (error 'make-random-bernoullis "p must be a real in (0.0 1.0)" p))
    146   (values
    147     (cond ((zero? p) (lambda () #f))
    148           ((= 1.0 p) (lambda () #t))
    149           (else      (lambda () (<= (rand) p))))
    150     (lambda () (values p rand))) )
    151 
    152 ;;; Binomials
    153 
    154 (define (make-random-binomials #!optional (t 1) (p 0.5) (rand (make-uniform-random-reals)))
    155   (unless (and (integer? t) (not (negative? t)))
    156     (error 'make-random-binomials "t must be a non-negative integer" t))
    157   (unless (and (real? p) (<= 0.0 p 1.0))
    158     (error 'make-random-binomials "p must be a real in (0.0 1.0)" p))
    159   (let ((bernoullis (make-random-bernoullis p rand)))
    160     (values
    161       ;FIXME O(t) but O(log(t)) desired for >> t
    162       (if (< t most-positive-fixnum)
    163           (lambda ()
    164             (do ((i 0 (fx+ 1 i))
    165                  (n 0 (if (bernoullis) (fx+ 1 n) n)))
    166                 ((fx>= i t) n)))
    167           (lambda ()
    168             (do ((i 0 (+ 1 i))
    169                  (n 0 (if (bernoullis) (+ 1 n) n)))
    170                 ((>= i t) n))))
    171       (lambda () (values t p rand)))) )
    172 
    173 ;;; Geometrics
    174 
    175 (define (make-random-geometrics #!optional (p 0.5) (rand (make-uniform-random-reals)))
    176   (unless (and (real? p) (<= 0.0 p 1.0))
    177     (error 'make-random-geometrics "p must be a real in (0.0 1.0)" p))
     165          (do ((i 0 (fx+ 1 i))
     166               (n 0 (if (bernoullis) (fx+ 1 n) n)))
     167              ((fx<= t i) n)))
     168        (lambda ()
     169          (do ((i 0 (+ 1 i))
     170               (n 0 (if (bernoullis) (+ 1 n) n)))
     171              ((<= t i) n))))) )
     172
     173(define (make-random-binomials #!key (t 1) (p 0.5) (randoms (make-uniform-random-reals)))
     174  (check-cardinal-integer 'make-random-binomials t 't)
     175  (check-real-unit 'make-random-binomials p 'p)
     176  (check-procedure 'make-random-binomials randoms 'randoms)
     177  (values
     178    (*make-random-binomials t p randoms)
     179    (lambda () (values t p randoms))) )
     180
     181;;; Geometric distribution
     182
     183(define (*make-random-geometrics p randoms)
    178184  (let ((log-p (log p)))
    179     (values
    180       (lambda () (+ 1 (inexact->exact (floor (/ (log (- 1.0 (rand))) log-p)))))
    181       (lambda () (values p rand)))) )
    182 
    183 ;;; Lognormals
    184 
    185 (define (make-random-lognormals #!optional (mu 1.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    186   (unless (and (real? mu) (not (zero? mu)))
    187     (error 'make-random-lognormals "mu must be a non-zero real" mu))
    188   (unless (and (real? sigma) (not (negative? sigma)))
    189     (error 'make-random-lognormals "sigma must be a non-negative real" sigma))
    190   (let ((normals (make-random-normals rand))
     185    (lambda () (+ 1 (inexact->exact (floor (/ (log (- 1.0 (randoms))) log-p)))))) )
     186
     187(define (make-random-geometrics #!key (p 0.5) (randoms (make-uniform-random-reals)))
     188  (check-real-unit 'make-random-geometrics p 'p)
     189  (check-procedure 'make-random-geometrics randoms 'randoms)
     190  (values
     191    (*make-random-geometrics p randoms)
     192    (lambda () (values p randoms))) )
     193
     194;;; Lognormal distribution
     195
     196(define (*make-random-lognormals mu sigma randoms)
     197  (let ((normals (*make-random-normals 0.0 1.0 randoms))
    191198        (nmu (log (* mu (/ mu (sqrt (+ (* sigma sigma) (* mu mu)))))))
    192199        (nsigma (sqrt (log (+ 1 (* sigma (/ sigma mu mu)))))))
    193     (values
    194       (lambda () (exp (+ nmu (* (normals) nsigma))))
    195       (lambda () (values mu sigma rand)))) )
    196 
    197 ;;; Cauchys
    198 
    199 (define (make-random-cauchys #!optional (median 0.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    200   (unless (real? median)
    201     (error 'make-random-cauchys "median must be a real" median))
    202   (unless (and (real? sigma) (positive? sigma))
    203     (error 'make-random-cauchys "sigma must be a positive real" sigma))
    204   (values
    205     (lambda () (+ median (* sigma (tan (* PI (- (rand) 0.5))))))
    206     (lambda () (values median sigma rand))) )
    207 
    208 ;;; Gammas
     200    (lambda () (exp (+ nmu (* (normals) nsigma))))) )
     201
     202(define (make-random-lognormals #!key (mu 1.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     203  (check-nonzero-real 'make-random-lognormals mu 'mu)
     204  (check-nonnegative-real 'make-random-lognormals sigma 'sigma)
     205  (check-procedure 'make-random-lognormals randoms 'randoms)
     206  (values
     207    (*make-random-lognormals mu sigma randoms)
     208    (lambda () (values mu sigma randoms))) )
     209
     210;;; Cauchy distribution
     211
     212(define (*make-random-cauchys median sigma randoms)
     213  (lambda () (+ median (* sigma (tan (* PI (- (randoms) 0.5)))))) )
     214
     215(define (make-random-cauchys #!key (median 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     216  (check-real 'make-random-cauchys median 'median)
     217  (check-positive-real 'make-random-cauchys sigma 'sigma)
     218  (check-procedure 'make-random-cauchys randoms 'randoms)
     219  (values
     220    (*make-random-cauchys median sigma randoms)
     221    (lambda () (values median sigma randoms))) )
     222
     223;;; Gamma distribution
    209224
    210225;; "A Simple Method for Generating Gamma Variables", George Marsaglia & Wai Wan Tsang,
    211 ;; ACM Transactions on Mathematical Software, Vol. 26, No. 3, September 2000, Pages 363Ð372.
    212 
    213 (define (make-random-gammas #!optional (alpha 1.0) (theta 1.0) (rand (make-uniform-random-reals)))
    214   (unless (and (real? alpha) (positive? alpha))
    215     (error 'make-random-gammas "alpha must be a positive real" alpha))
    216   (unless (and (real? theta) (positive? theta))
    217     (error 'make-random-gammas "theta must be a positive real" theta))
    218   (values
    219     (if (= 1.0 alpha)
    220         ; then special case
    221         (lambda () (* theta (- (log (rand)))) )
    222         ; else general case
    223         (let ((norms (make-random-normals 0.0 1.0 rand))
    224               (unis
    225                 (if (< alpha 1.0)
    226                     (let ((inv-alpha (*inverse alpha)))
    227                       (lambda () (expt (rand) inv-alpha) ) )
    228                     rand)))
    229           (let* ((d (- (or (and (< alpha 1.0) (+ 1.0 alpha)) alpha) fp1/3))
    230                  (c (*inverse (sqrt (* 9.0 d)))))
    231             (lambda ()
    232               (* theta
    233                  (let loop ()
    234                    (let* ((x (norms))
    235                           (v (+ 1.0 (* c x))))
    236                      (if (and (positive? v)
    237                               (let ((v (* v v v))
    238                                     (u (unis))
    239                                     (x^2 (* x x)))
    240                                 (or (< u (- 1.0 (* 0.0331 x^2 x^2)))
    241                                     (< (log u) (+ (* 0.5 x^2) (* d (- 1.0 (+ v (log v)))))))))
    242                          (* d v)
    243                          (loop) ) ) ) ) ) ) ) )
    244     (lambda () (values alpha theta rand))) )
    245 
    246 ;;; Erlangs
    247 
    248 (define (make-random-erlangs #!optional (alpha 1) (theta 1.0) (rand (make-uniform-random-reals)))
    249   (unless (and (integer? alpha) (positive? alpha))
    250     (error 'make-random-erlangs "alpha must be a positive integer" alpha))
    251   (unless (and (real? theta) (positive? theta))
    252     (error 'make-random-erlangs "theta must be a positive real" theta))
    253   (make-random-gammas (exact->inexact alpha) (exact->inexact theta) rand) )
    254 
    255 ;;; Pareto
    256 
    257 (define (make-random-paretos #!optional (alpha 1.0) (xmin 1.0) (rand (make-uniform-random-reals)))
    258   (unless (and (real? alpha) (positive? alpha))
    259     (error 'make-random-paretos "alpha must be a positive real" alpha))
    260   (unless (and (real? xmin) (positive? xmin))
    261     (error 'make-random-paretos "xmin must be a positive real" xmin))
    262   (values
    263     (let ((gs (make-random-gammas alpha (*inverse xmin) rand)))
    264       (make-random-exponentials 1.0 (lambda () (*inverse (+ xmin (gs))))))
    265     (lambda () (values alpha xmin rand))) )
    266 
    267 ;;; LŽvys
     226;; ACM Transactions on Mathematical Software, Vol. 26, No. 3, September 2000, Pages 363 372.
     227
     228(define (*make-random-gammas alpha theta randoms)
     229  (if (= 1.0 alpha)
     230      ; then special case
     231      (lambda () (* theta (- (log (randoms)))) )
     232      ; else general case
     233      (let ((norms (*make-random-normals 0.0 1.0 randoms))
     234            (unis
     235              (if (< alpha 1.0)
     236                  (let ((inv-alpha (*inverse alpha)))
     237                    (lambda () (expt (randoms) inv-alpha) ) )
     238                  randoms)))
     239        (let* ((d (- (or (and (< alpha 1.0) (+ 1.0 alpha)) alpha) fp1/3))
     240               (c (*inverse (sqrt (* 9.0 d)))))
     241          (lambda ()
     242            (* theta
     243               (let loop ()
     244                 (let* ((x (norms))
     245                        (v (+ 1.0 (* c x))))
     246                   (if (and (positive? v)
     247                            (let ((v (* v v v))
     248                                  (u (unis))
     249                                  (x^2 (* x x)))
     250                              (or (< u (- 1.0 (* 0.0331 x^2 x^2)))
     251                                  (< (log u) (+ (* 0.5 x^2) (* d (- 1.0 (+ v (log v)))))))))
     252                       (* d v)
     253                       (loop) ) ) ) ) ) ) ) ) )
     254
     255(define (make-random-gammas #!key (alpha 1.0) (theta 1.0) (randoms (make-uniform-random-reals)))
     256  (check-positive-real 'make-random-gammas alpha 'alpha)
     257  (check-positive-real 'make-random-gammas theta 'theta)
     258  (check-procedure 'make-random-gammas randoms 'randoms)
     259  (values
     260    (*make-random-gammas alpha theta randoms)
     261    (lambda () (values alpha theta randoms))) )
     262
     263;;; Erlang distribution
     264
     265(define (*make-random-erlangs alpha theta randoms)
     266  (*make-random-gammas (exact->inexact alpha) (exact->inexact theta) randoms) )
     267
     268(define (make-random-erlangs #!key (alpha 1) (theta 1.0) (randoms (make-uniform-random-reals)))
     269  (check-positive-real 'make-random-erlangs alpha 'alpha)
     270  (check-positive-real 'make-random-erlangs theta 'theta)
     271  (check-procedure 'make-random-erlangs randoms 'randoms)
     272  (values
     273    (*make-random-erlangs alpha theta randoms)
     274    (lambda () (values alpah theta randoms))) )
     275
     276;;; Pareto distribution
     277
     278(define (*make-random-paretos alpha xmin randoms)
     279  (let ((gammas (*make-random-gammas alpha (*inverse xmin) randoms)))
     280    (*make-random-exponentials 1.0 (lambda () (*inverse (+ xmin (gammas)))))) )
     281
     282(define (make-random-paretos #!key (alpha 1.0) (xmin 1.0) (randoms (make-uniform-random-reals)))
     283  (check-positive-real 'make-random-paretos alpha 'alpha)
     284  (check-positive-real 'make-random-paretos xmin 'xmin)
     285  (check-procedure 'make-random-paretos randoms 'randoms)
     286  (values
     287    (*make-random-paretos alpha xmin randoms)
     288    (lambda () (values alpha xmin randoms))) )
     289
     290;;; Levy distribution
    268291
    269292;; See Stable Distributions - John P. Nolan, Formula 1.12
    270293
    271 (define (make-random-levys #!optional (gamma 1.0) (delta 0.0) (rand (make-uniform-random-reals)))
    272   (unless (and (real? delta) (not (negative? delta)))
    273     (error 'make-random-levys "delta must be a non-negative real" delta))
    274   (unless (and (real? gamma) (positive? gamma))
    275     (error 'make-random-levys "gamma must be a positive real" gamma))
    276   (values
    277     (if (and (= 1.0 gamma) (zero? delta))
    278         (lambda () (let ((r (rand))) (*inverse (* r r))))
    279         (lambda () (let ((r (rand))) (+ delta (* gamma (*inverse (* r r)))))))
    280     (lambda () (values gamma delta rand))) )
     294(define (*make-random-levys gamma delta randoms)
     295  (if (and (= 1.0 gamma) (zero? delta))
     296      (lambda () (let ((r (randoms))) (*inverse (* r r))))
     297      (lambda () (let ((r (randoms))) (+ delta (* gamma (*inverse (* r r))))))) )
     298
     299(define (make-random-levys #!key (gamma 1.0) (delta 0.0) (randoms (make-uniform-random-reals)))
     300  (check-nonnegative-real 'make-random-levys delta 'delta)
     301  (check-positive-real 'make-random-levys gamma 'gamma)
     302  (check-procedure 'make-random-levys randoms 'randoms)
     303  (values
     304    (*make-random-levys gamma delta randoms)
     305    (lambda () (values gamma delta randoms))) )
    281306
    282307;;; Weibull distribution
    283308
    284 (define (make-random-weibulls #!optional (shape 1.0) (scale 1.0) (rand (make-uniform-random-reals)))
    285   (unless (and (real? shape) (positive? shape))
    286     (error 'make-random-weibulls "shape must be a positive real" shape))
    287   (unless (and (real? scale) (positive? scale))
    288     (error 'make-random-weibulls "scale must be a positive real" scale))
    289   (values
    290     (let ((invscale (*-inverse scale))
    291           (invshape (*inverse shape)) )
    292       (lambda () (expt (* invscale (log (- 1 (rand)))) invshape)) )
    293     (lambda () (values shape scale rand))) )
     309(define (*make-random-weibulls shape scale randoms)
     310  (let ((invscale (*-inverse scale))
     311        (invshape (*inverse shape)) )
     312    (lambda () (expt (* invscale (log (- 1 (randoms)))) invshape)) ) )
     313
     314(define (make-random-weibulls #!key (shape 1.0) (scale 1.0) (randoms (make-uniform-random-reals)))
     315  (check-positive-real 'make-random-weibulls shape 'shape)
     316  (check-positive-real 'make-random-weibulls scale 'scale)
     317  (check-procedure 'make-random-weibulls randoms 'randoms)
     318  (values
     319    (*make-random-weibulls shape scale randoms)
     320    (lambda () (values shape scale randoms))) )
    294321
    295322) ;module srfi-27-distributions
  • release/4/srfi-27/trunk/srfi-27-numbers.scm

    r17327 r17330  
    55
    66  (;export
     7    ;
    78    check-integer
     9    check-cardinal-integer
    810    check-positive-integer
     11    check-real
     12    check-nonzero-real
     13    check-nonnegative-real
     14    check-positive-real
     15    check-real-open-interval
     16    check-real-closed-interval
     17    check-real-precision
    918    check-real-unit
     19    ;
    1020    random-power
    1121    random-large-integer
     
    1323
    1424  (import (except scheme
    15             <= <
     25            <= < zero? positive? negative?
    1626            + * - / quotient expt
    17             integer? real? positive?
     27            integer? real?
    1828            exact->inexact)
    1929          chicken
    2030          (only numbers
    21             <= <
     31            <= < zero? positive? negative?
    2232            + * - / quotient expt
    23             integer? real? positive?
     33            integer? real?
    2434            exact->inexact)
    25           (only type-errors error-argument-type error-open-interval))
     35          (only type-errors
     36            error-argument-type error-open-interval error-closed-interval))
    2637
    2738  (require-library numbers type-errors)
     
    2940  (declare
    3041    (not usual-integrations
    31       <= <
     42      <= < zero? positive? negative?
    3243      + * - / quotient expt
    33       integer? real? positive?
     44      integer? real?
    3445      exact->inexact) )
    3546
    3647;;;
     48
     49;;
    3750
    3851(define (check-integer loc obj #!optional argnam)
     
    4053    (error-argument-type loc obj "integer" argnam)) )
    4154
     55(define (check-cardinal-integer loc obj #!optional argnam)
     56  (unless (and (integer? obj) (<= 0 obj))
     57    (error-argument-type loc obj "cardinal-integer" argnam)) )
     58
    4259(define (check-positive-integer loc obj #!optional argnam)
    4360  (unless (and (integer? obj) (positive? obj))
    4461    (error-argument-type loc obj "positive-integer" argnam)) )
    4562
     63;;
     64
     65(define (check-real loc obj #!optional argnam)
     66  (unless (real? obj)
     67    (error-argument-type loc obj "real" argnam)) )
     68
     69(define (check-nonzero-real loc obj #!optional argnam)
     70  (unless (and (real? obj) (not (zero? obj)))
     71    (error-argument-type loc obj "nonzero-real" argnam)) )
     72
     73(define (check-nonnegative-real loc obj #!optional argnam)
     74  (unless (and (real? obj) (not (negative? obj)))
     75    (error-argument-type loc obj "nonnegative-real" argnam)) )
     76
     77(define (check-positive-real loc obj #!optional argnam)
     78  (unless (and (real? obj) (positive? obj))
     79    (error-argument-type loc obj "positive-real" argnam)) )
     80
     81;;
     82
     83(define (check-real-open-interval loc obj mn mx #!optional argnam)
     84  (check-real loc obj argnam)
     85  (unless (< mn obj mx)
     86    (error-open-interval loc obj mn mx argnam)) )
     87
     88(define (check-real-closed-interval loc obj mn mx #!optional argnam)
     89  (check-real loc obj argnam)
     90  (unless (<= mn obj mx)
     91    (error-closed-interval loc obj mn mx argnam)) )
     92
     93(define (check-real-precision loc obj #!optional argnam)
     94  (check-real-open-interval loc obj 0 1 argnam) )
     95
    4696(define (check-real-unit loc obj #!optional argnam)
    47   (unless (real? obj)
    48     (error-argument-type loc obj "real" argnam))
    49   (unless (< 0 obj 1)
    50     (error-open-interval loc obj 0 1 argnam)) )
     97  (check-real-closed-interval loc obj 0 1 argnam) )
    5198
    5299;;;
  • release/4/srfi-27/trunk/srfi-27-uniform-random.scm

    r17326 r17330  
    99    make-uniform-random-reals)
    1010
    11   (import (except scheme
    12             + - / *
    13             = <)
     11  (import (except scheme + - / * = <)
    1412          chicken
    1513          (only miscmacros exchange!)
    16           (only numbers
    17             + - / *
    18             = <)
     14          (only numbers + - / * = <)
    1915          random-source
    2016          (only srfi-27 current-random-source)
    21           (only srfi-27-large-numbers
    22             check-integer positive-integer check-real-unit))
     17          (only srfi-27-numbers
     18            check-integer check-positive-integer check-real-precision))
    2319
    2420  (require-library
    2521    miscmacros vector-lib numbers
    26     random-source srfi-27 srfi-27-large-numbers)
     22    random-source srfi-27 srfi-27-numbers)
    2723
    28   (declare
    29     (not usual-integrations
    30       + - / *
    31       = <) )
     24  (declare (not usual-integrations + - / * = <))
    3225
    3326;;; Uniform random integers in (low high by Unit)
    3427
    35 (define (*make-uniform-random-integers high low unit rand)
    36   (let ((range (/ (+ (- high low) 1) unit)) )
    37       (cond ((and (= 0 low) (= 1 unit)) (lambda () (rand range)))
    38             ((= 0 low)                  (lambda () (* (rand range) unit)))
    39             (else                       (lambda () (+ low (* (rand range) unit))))) ) )
     28(define (*make-uniform-random-integers high low prec rand)
     29  (let ((range (/ (+ (- high low) 1) prec)) )
     30      (cond ((and (= 0 low) (= 1 prec)) (lambda () (rand range)))
     31            ((= 0 low)                  (lambda () (* (rand range) prec)))
     32            (else                       (lambda () (+ low (* (rand range) prec))))) ) )
    4033
    41 (define (make-uniform-random-integers #!key (high #f) (low 0) (unit 1) (src (current-random-source)))
    42   (check-random-source 'make-uniform-random-integers src 'source)
    43   (unless high (set! high (- (*random-source-maximum-range src) 1)))
     34(define (make-uniform-random-integers #!key (high #f) (low 0) (precision 1) (source (current-random-source)))
     35  (check-random-source 'make-uniform-random-integers source 'source)
     36  (unless high (set! high (- (*random-source-maximum-range source) 1)))
    4437  (check-integer 'make-uniform-random-integers high 'high)
    4538  (check-integer 'make-uniform-random-integers low 'low)
    46   (check-positive-integer 'make-uniform-random-integers unit 'unit)
     39  (check-positive-integer 'make-uniform-random-integers precision 'precision)
    4740  (unless (< low high) (exchange! low high))
    4841  (values
    49     (*make-uniform-random-integers high low unit ((@random-source-make-integers src)))
    50     (lambda () (values high low unit src)) ) )
     42    (*make-uniform-random-integers high low precision ((@random-source-make-integers source)))
     43    (lambda () (values high low precision source)) ) )
    5144
    5245;;; Uniform random reals in (0.0 1.0 by Unit)
    5346
    54 (define (make-uniform-random-reals #!key (unit #f) (src (current-random-source)))
    55   (check-random-source 'make-uniform-random-reals src 'source)
    56   (when unit (check-real-unit 'make-uniform-random-reals unit 'unit))
     47(define (make-uniform-random-reals #!key (precision #f) (source (current-random-source)))
     48  (check-random-source 'make-uniform-random-reals source 'source)
     49  (when precision (check-real-precision 'make-uniform-random-reals precision 'precision))
    5750  (values
    58     ((@random-source-make-reals src) unit)
    59     (lambda () (values unit src)) ) )
     51    ((@random-source-make-reals source) precision)
     52    (lambda () (values precision source)) ) )
    6053
    6154) ;module srfi-27-uniform-random
  • release/4/srfi-27/trunk/srfi-27-vector.scm

    r17326 r17330  
    55
    66  (;export
     7    ;
     8    *random-permutation!
     9    *random-vector!
     10    *random-normal-vector!
     11    *random-hollow-sphere!
     12    *random-solid-sphere!
     13    ;
     14    make-random-permutations
     15    make-random-f64vector
     16    make-random-vector
     17    make-random-normal-vector
     18    make-random-hollow-sphere
     19    make-random-solid-sphere
     20    ;
     21    random-permutation!
     22    random-vector!
    723    random-normal-vector!
    824    random-hollow-sphere!
    925    random-solid-sphere!)
    1026
    11   (import (except scheme
    12             number? real? integer? positive? zero? negative?
    13             = >= <= < >
    14             inexact->exact
    15             exp log sqrt floor tan expt
    16             + - * /)
     27  (import (except scheme + * / sqrt expt)
    1728          chicken
    18           srfi-4
    19           vector-lib
     29          (only srfi-4
     30            f32vector? f32vector-length f32vector-ref f32vector-set!
     31            f64vector? f64vector-length f64vector-ref f64vector-set!)
     32          (only numbers + * / sqrt expt)
     33          (only vector-lib vector-map! vector-fold)
     34          (only type-checks check-cardinal-integer check-vector)
    2035          (only type-errors error-vector)
    21           type-checks
    22           srfi-4-checks
    23           (only numbers
    24             number? real? integer? positive? zero? negative?
    25             = >= <= < >
    26             inexact->exact
    27             exp log sqrt floor tan expt
    28             + - * /)
    2936          random-source
    30           srfi-27)
    31 
    32   (require-library srfi-4 vector-lib type-errors srfi-4-checks type-checks numbers random-source srfi-27)
    33 
    34   (declare
    35     (not usual-integrations
    36       number? real? integer? positive? zero? negative?
    37       = >= <= < >
    38       inexact->exact
    39       exp log sqrt floor tan expt
    40       + - * /) )
    41 
    42 ;;; Vector Support
    43 
    44 ;could use 'srfi-4-utils' here
    45 
    46 (define (f64vector-mapi!/1 proc vec)
    47   (let ((len (f64vector-length vec)))
    48     (do ((i 0 (fx+ i 1)))
    49         ((fx= i len) vec)
    50       (f64vector-set! vec i (proc i (f64vector-ref vec i))) ) ) )
    51 
    52 (define (f64vector-foldi/1 proc init vec)
    53   (let ((len (f64vector-length vec)))
    54     (do ((i 0 (fx+ i 1) )
    55          (acc init (proc i acc (f64vector-ref vec i)) ) )
    56         ((fx= i len) acc) ) ) )
    57 
    58 #;(define (array-rank/1? obj) (and (array? obj) (fx= 1 (array-rank obj))))
     37          srfi-27
     38          srfi-27-uniform-random
     39          (only srfi-27-numbers check-real))
     40
     41  (require-library
     42    srfi-4
     43    numbers
     44    vector-lib
     45    type-checks type-errors
     46    random-source srfi-27 srfi-27-uniform-random srfi-27-numbers)
     47
     48  (declare (not usual-integrations + * / sqrt expt))
     49
     50;;;
     51
     52; (in case special processing needed near limits TBD)
     53(define (*inverse n) (/ 1.0 n))
     54
     55;;; Vector% Support
     56
     57#; ;NOT YET
     58(define (array-rank/1? obj) (and (array? obj) (fx= 1 (array-rank obj))))
     59
     60(define (check-vector% loc obj #!optional argnam)
     61  (unless (or (vector? obj)
     62              (f32vector? obj)
     63              (f64vector? obj)
     64              #; ;NOT YET
     65              (array-rank/1? vec) )
     66    (error-vector loc obj argnam) ) )
    5967
    6068(define (vector%-length vec)
    6169  (cond ((vector? vec)        (vector-length vec))
     70        ((f32vector? vec)     (f32vector-length vec))
    6271        ((f64vector? vec)     (f64vector-length vec))
    63         #;((array-rank/1? vec)  (car (array-dimensions vec)))
     72        #; ;NOT YET
     73        ((array-rank/1? vec)  (car (array-dimensions vec)))
    6474        (else
    6575          (error-vector #f vec))) )
     
    6777(define (vector%-mapi!/1 proc vec)
    6878  (cond ((vector? vec)        (vector-map! proc vec))
     79        ((f32vector? vec)     (f32vector-mapi!/1 proc vec))
    6980        ((f64vector? vec)     (f64vector-mapi!/1 proc vec))
    70         #;
     81        #; ;NOT YET
    7182        ((array-rank/1? vec)  (array-map! vec (cut proc #f <>)))
    7283        (else
     
    7586(define (vector%-foldi/1 proc seed vec)
    7687  (cond ((vector? vec)        (vector-fold proc seed vec))
     88        ((f32vector? vec)     (f32vector-foldi/1 proc seed vec))
    7789        ((f64vector? vec)     (f64vector-foldi/1 proc seed vec))
    78         #;
     90        #; ;NOT YET
    7991        ((array-rank/1? vec)  (array-fold (cut proc #f <> <>) seed vec))
    8092        (else
    8193          (error-vector #f vec))) )
    8294
    83 (define (vector%-scale! vec factor) (vector%-mapi!/1 (lambda (i elm) (* elm factor)) vec))
    84 
    85 (define (vector%-sum-squares vec) (vector%-foldi/1 (lambda (i sum elm) (+ sum (* elm elm))) 0 vec))
     95(define (vector%-scale! vec factor)
     96  (vector%-mapi!/1 (lambda (i elm) (* elm factor)) vec) )
     97
     98(define (vector%-sum-squares vec)
     99  (vector%-foldi/1 (lambda (i sum elm) (+ sum (* elm elm))) 0 vec) )
     100
     101;;;
     102
     103;;
     104
     105(define (*random-permutation! vec randoms)
     106  (let ((n (vector-length vec)))
     107    (do ((i 0 (+ i 1)))
     108        ((= i n))
     109      (vector-set! vec i i))
     110    (do ((k n (- k 1)))
     111        ((= k 1) vec)
     112      (let* ((i (- k 1))
     113             (j (randoms k))
     114             (xi (vector-ref vec i))
     115             (xj (vector-ref vec j)) )
     116        (vector-set! vec i xj)
     117        (vector-set! vec j xi) ) ) ) )
     118
     119(define (make-random-permutations #!key (randoms (make-uniform-random-integers)))
     120  (lambda (n)
     121    (*random-permutation! (make-vector n 0) randoms)) )
     122
     123(define (random-permutation! vec #!key (randoms (make-uniform-random-integers)))
     124  (check-vector 'random-permutation! vec)
     125  (*random-permutation! vec randoms) )
     126
     127;;
     128
     129(define (*random-vector! vec randoms) (vector%-mapi!/1 randoms vec))
     130
     131(define (make-random-vector #!key (randoms (make-uniform-random-reals)))
     132  (lambda (n)
     133    (check-cardinal-integer 'random-vector n 'length)
     134    (*random-vector! (make-vector n) randoms)) )
     135
     136(define (random-vector! vec #!key (randoms (make-uniform-random-reals)))
     137  (check-vector% 'random-vector! vec)
     138  (*random-vector! vec randoms) )
     139
     140(define *random-64vector! *random-vector!)
     141
     142(define (make-random-f64vector #!key (randoms (make-uniform-random-reals)))
     143  (lambda (n)
     144    (check-cardinal-integer 'random-vector n 'length)
     145    (*random-vector! (make-f64vector n) randoms)) )
    86146
    87147;;; Normal vectors
    88148
    89 (define (random-normal-vector! vec #!optional (mu 0.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    90   (let ((norms (if (number? mu) (make-random-normals rand mu sigma) rand)))
    91     (vector%-mapi!/1 (lambda (i elm) (norms)) vec)) )
    92 
    93 (define (random-hollow-sphere! vec #!optional (mu 0.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    94   (random-normal-vector! vec rand mu sigma)
     149;;
     150
     151;Fills vect with inexact real random numbers that are independent
     152;and standard normally distributed (i.e., with mean 0 and variance 1).
     153
     154(define (*random-normal-vector! vec mu sigma randoms)
     155  (let ((norms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     156    (*random-vector! vec (lambda (i elm) (norms))) ) )
     157
     158(define (make-random-normal-vector #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     159  (let ((norms (make-random-normals #:mu mu #:sigma sigma #:randoms randoms)))
     160    (lambda (n)
     161      (check-cardinal-integer 'random-normal-vector n 'length)
     162      (*random-normal-vector! (make-vector n) norms)) ) )
     163
     164(define (random-normal-vector! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     165  (check-vector% 'random-normal-vector! vec)
     166  (*random-normal-vector! vec mu sigma randoms) )
     167
     168;;
     169
     170;Fills vect with inexact real random numbers the sum of whose
     171;squares is equal to 1.0.  Thinking of vect as coordinates in space
     172;of dimension n = (vector-length vect), the coordinates are
     173;uniformly distributed over the surface of the unit n-sphere.
     174
     175(define (*random-hollow-sphere! vec mu sigma randoms)
     176  (*random-normal-vector! vec mu sigma randoms)
    95177  (vector%-scale! vec (*inverse (sqrt (vector%-sum-squares vec)))) )
    96178
    97 (define (random-solid-sphere! vec #!optional (mu 0.0) (sigma 1.0) (rand (make-uniform-random-reals)))
    98   (random-hollow-sphere! vec rand mu sigma)
     179(define (make-random-hollow-sphere #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     180  (lambda (n)
     181    (check-cardinal-integer 'random-hollow-sphere n 'length)
     182    (*random-hollow-sphere! (make-vector n) mu sigma randoms) ) )
     183
     184(define (random-hollow-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     185  (check-vector% 'random-hollow-sphere! vec)
     186  (*random-hollow-sphere! vec mu sigma randoms) )
     187
     188;;
     189
     190;Fills vect with inexact real random numbers the sum of whose
     191;squares is less than 1.0.  Thinking of vect as coordinates in
     192;space of dimension n = (vector-length vect), the coordinates are
     193;uniformly distributed within the unit n-sphere.  The sum of the
     194;squares of the numbers is returned.
     195
     196(define (*random-solid-sphere! vec mu sigma randoms)
     197  (random-hollow-sphere! vec mu sigma randoms)
    99198  (vector%-scale! vec (expt (rand) (*inverse (vector%-length vec)))) )
    100199
     200(define (make-random-solid-sphere #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     201  (lambda (n)
     202    (check-cardinal-integer 'random-solid-sphere n 'length)
     203    (*random-solid-sphere! (make-vector n) mu sigma randoms) ) )
     204
     205(define (random-solid-sphere! vec #!key (mu 0.0) (sigma 1.0) (randoms (make-uniform-random-reals)))
     206  (check-vector% 'random-solid-sphere! vec)
     207  (*random-solid-sphere! vec mu sigma randoms) )
     208
    101209) ;module srfi-27-vector
  • release/4/srfi-27/trunk/srfi-27.meta

    r17327 r17330  
    3030        "srfi-27-uniform-random.scm"
    3131        "srfi-27-numbers.scm"
     32        "srfi-27-srfi-4.scm"
    3233        "srfi-27.scm"
    3334  "srfi-27.setup") )
  • release/4/srfi-27/trunk/srfi-27.scm

    r17328 r17330  
    55
    66  (;export
    7     ; SRFI 27
     7    ;; SRFI 27
    88    default-random-source
    99    random-integer
     
    1717    random-source-make-integers
    1818    random-source-make-reals
    19     ; Extensions
    20     current-random-source
    21     random-source-kind
    22     random-source-documentation
    23     random-source-log2-period
    24     random-source-maximum-range
    25     random-source-maximum-modulus
    26     random-source-entropy-source random-source-entropy-source-set!
     19    ;; Extensions
    2720    current-entropy-source
    2821    make-entropy-source
     
    3326    entropy-source-f64
    3427    entropy-source-u8vector
    35     entropy-source-f64vector)
     28    entropy-source-f64vector
     29    ;
     30    current-random-source
     31    random-source-kind
     32    random-source-documentation
     33    random-source-log2-period
     34    random-source-maximum-range
     35    random-source-maximum-modulus
     36    random-source-entropy-source random-source-entropy-source-set!
     37    random-source-make-u8vectors
     38    random-source-make-f64vectors
     39    random-u8vector
     40    random-f64vector)
    3641
    3742  (import scheme
     
    4651          entropy-clock
    4752          mrg32k3a
    48           (only srfi-27-numbers check-real-unit))
     53          (only srfi-27-numbers check-real-precision))
    4954
    5055  (require-library
     
    186191(define (random-source-make-reals s #!optional u)
    187192  (check-random-source 'random-source-make-reals s)
    188   (when u (check-real-unit 'random-source-make-reals u 'unit))
     193  (when u (check-real-precision 'random-source-make-reals u 'precision))
    189194  ((@random-source-make-reals s) u) )
    190195
     196(define (*random-source-make-u8vectors s)
     197  (let ((rndint ((@random-source-make-integers s))))
     198    (lambda (n)
     199      (check-cardinal-integer 'make-u8vector n 'length)
     200      (u8vector-filled! (make-u8vector n) (lambda () (modulo (rndint) 256))) ) ) )
     201
     202(define (*random-source-make-f64vectors s u)
     203  (let ((rnd ((@random-source-make-reals s) u)))
     204    (lambda (n)
     205      (check-cardinal-integer 'make-f64vector n 'length)
     206      (u8vector-filled! (make-f64vector n) rnd) ) ) )
     207
     208(define (random-source-make-u8vectors s)
     209  (check-random-source 'random-source-make-u8vectors s)
     210  (*random-source-make-u8vectors s) )
     211
     212(define (random-source-make-f64vectors s #!optional u)
     213  (check-random-source 'random-source-make-f64vectors s)
     214  (when u (check-real-precision 'random-source-make-f64vectors u 'precision))
     215  (*random-source-make-f64vectors s u) )
     216
     217(define random-u8vector
     218  (let ((mkv (*random-source-make-u8vectors default-random-source)))
     219    (lambda (n)
     220      (mkv n) ) ) )
     221
     222(define random-f64vector
     223  (let ((mkv (*random-source-make-f64vectors default-random-source #f)))
     224    (lambda (n)
     225      (mkv n) ) ) )
     226
    191227) ;module srfi-27
Note: See TracChangeset for help on using the changeset viewer.