Changeset 8432 in project


Ignore:
Timestamp:
02/13/08 06:40:44 (11 years ago)
Author:
kon
Message:

Save.

Location:
release/3/srfi-27/trunk
Files:
5 edited

Legend:

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

    r8337 r8432  
    4545static unsigned char masktab[256];
    4646
     47static void
     48init_masktab ()
     49{
     50  int i, m;
     51  for (m = 1; m <= 256; m <<= 1)
     52    for (i = m >> 1; i < m; ++i)
     53      masktab[i] = m - 1;
     54}
     55
    4756#define m16Long 65536L           /* 2^16 */
    4857#define m16Mask 0xFFFF           /* mask for lower 16 bits */
     
    136145}
    137146
    138 static void
    139 init_masktab ()
    140 {
    141   int i, m;
    142   for (m = 1; m <= 256; m <<= 1)
    143     for (i = m >> 1; i < m; ++i)
    144       masktab[i] = m - 1;
    145 }
    146 
    147147#if 0
    148148static void
     
    188188  (make-s16vector STATE-SIZE) )
    189189
    190 (define *moa-initial-state* (make-state))
     190(define (moa-initial-state)
     191  (let ([state (make-state)])
     192    ($ void init_state #$state (double INITIAL-SEED))
     193    state ) )
    191194
    192195;; Note - The result will never exceed the fixnum range when
     
    208211(define (moa-state-set external-state)
    209212  (if (and (pair? external-state)
    210            (fx= (fx+ STATE-SIZE 1) (length external-state))
    211            (eq? 'marsaglia-moa (car external-state)))
     213           (eq? 'marsaglia-moa (car external-state))
     214           (fx= (fx+ STATE-SIZE 1) (length external-state)))
    212215      (let ([state (make-state)])
    213216        (let loop ([i 0] [lst (cdr external-state)])
     
    256259
    257260(define (make-moa-random-source)
    258   (let ([state *moa-initial-state*])
     261  (let ([state (moa-initial-state)])
    259262    (%make-random-source 'MOA
    260263      ;
     
    301304
    302305($ void init_masktab)
    303 ($ void init_state #$*moa-initial-state* (double INITIAL-SEED))
  • release/3/srfi-27/trunk/mrg32k3a-primitives.scm

    r8338 r8432  
    8484(define-constant MAXIMUM-RANGE 1073741823) ; 2^30-1 (MOST_POSITIVE_FIXNUM)
    8585
    86 (define-constant M1 4294967087.0) ; modulus of component 1
    87 
    88 (define-constant M2 4294944443.0) ; modulus of component 2
     86(define-constant M1 4294967087.0)   ; modulus of component 1
     87(define-constant M1-1 4294967086.0) ; M1 - 1.0
     88
     89(define-constant M2 4294944443.0)   ; modulus of component 2
     90(define-constant M2-1 4294944442.0) ; M2 - 1.0
    8991
    9092(define-constant M2^28 268435456.0)
     
    166168; ===================
    167169
     170(define (mrg32k3a-initial-state)
     171  ; 0 3 6 9 12 15 of A^16, see below
     172  (f64vector
     173   1250826159
     174   3004357423
     175    431373563
     176   3322526864
     177    623307378
     178   2983662421) )
     179
    168180(define (mrg32k3a-unpack-state packed-state)
    169181  (cons 'lecuyer-mrg32k3a
    170182        (map inexact->exact (f64vector->list packed-state))) )
    171183
    172 (define (mrg32k3a-state-packed external-state)
     184(define (mrg32k3a-pack-state external-state)
    173185
    174186  (define (check-value x m)
    175     (or (and (integer? x) (<= 0 x (- m 1)))
    176         (error 'mrg32k3a-state-packed "illegal value" x) ) )
     187    (or (and (integer? x) (<= 0 x) (< x m))
     188        (error 'mrg32k3a-pack-state "illegal value" x) ) )
    177189
    178190  (if (and (pair? external-state)
     
    189201        (if (or (zero? (+ l0 l1 l2))
    190202                (zero? (+ l3 l4 l5)))
    191           (error 'mrg32k3a-state-packed "illegal degenerate state" external-state)
     203          (error 'mrg32k3a-pack-state "illegal degenerate state" external-state)
    192204          (f64vector l0 l1 l2 l3 l4 l5) ) )
    193       (error 'mrg32k3a-state-packed "malformed state" external-state) ) )
     205      (error 'mrg32k3a-pack-state "malformed state" external-state) ) )
    194206
    195207; Pseudo-Randomization
     
    227239; available this is not necessary, but pseudo-randomize! is expected
    228240; to be called only occasionally so we do not provide this implementation.
    229 
    230 (define *mrg32k3a-initial-state* ; 0 3 6 9 12 15 of A^16, see below
    231   (f64vector
    232    1250826159
    233    3004357423
    234     431373563
    235    3322526864
    236     623307378
    237    2983662421))
    238241
    239242(define mrg32k3a-pseudo-randomize-state
     
    357360  (let ([random
    358361         (let ([random-m
    359                  (let ([x (fpmodulo ((%entropy-source-f64 entropy-source))
    360                                     M2^16)])
     362                 (let ([x (fpmodulo ((%entropy-source-f64 entropy-source)) M2^16)])
    361363                   (lambda ()
    362364                     (let ([y x])
    363                        (set! x (fpmodulo (fp+ (fp* 30903.0 x) (fpquotient x M2^16))
    364                                          M2^16))
     365                       (set! x (fpmodulo (fp+ (fp* 30903.0 x) (fpquotient x M2^16)) M2^16))
    365366                       y ) ) ) ] )
    366367           (lambda (n)      ; m < n < m^2
    367              (fpmodulo (fp+ (fp* (random-m) M2^16)
    368                             (random-m))
    369                        n) ) ) ] )
     368             (fpmodulo (fp+ (fp* (random-m) M2^16) (random-m)) n) ) ) ] )
    370369    ; the new state
    371370    (f64vector
    372      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 0) (random (fp- M1 1.0))) (fp- M1 1.0)))
     371     (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 0) (random M1-1)) M1-1))
    373372     (fpmodulo (fp+ (f64vector-ref state 1) (random M1)) M1)
    374373     (fpmodulo (fp+ (f64vector-ref state 2) (random M1)) M1)
    375      (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 3) (random (fp- M2 1.0))) (fp- M2 1.0)))
     374     (fp+ 1.0 (fpmodulo (fp+ (f64vector-ref state 3) (random M2-1)) M2-1))
    376375     (fpmodulo (fp+ (f64vector-ref state 4) (random M2)) M2)
    377376     (fpmodulo (fp+ (f64vector-ref state 5) (random M2)) M2)) ) )
     
    406405
    407406(define (make-mrg32k3a-random-source)
    408   (let ([state *mrg32k3a-initial-state*])
     407  (let ([state (mrg32k3a-initial-state)])
    409408    (%make-random-source 'MRG32k3a
    410409      ;
     
    415414      ;
    416415      (lambda (new-state)
    417         (set! state (mrg32k3a-state-packed new-state)) )
     416        (set! state (mrg32k3a-pack-state new-state)) )
    418417      ;
    419418      (lambda (entropy-source)
  • release/3/srfi-27/trunk/mwc-primitives.scm

    r8337 r8432  
    4444
    4545static unsigned char masktab[256];
     46
     47static void
     48init_masktab ()
     49{
     50  int i, m;
     51  for (m = 1; m <= 256; m <<= 1)
     52    for (i = m >> 1; i < m; ++i)
     53      masktab[i] = m - 1;
     54}
    4655
    4756static uint32_t
     
    94103
    95104static void
    96 init_masktab ()
    97 {
    98   int i, m;
    99   for (m = 1; m <= 256; m <<= 1)
    100     for (i = m >> 1; i < m; ++i)
    101       masktab[i] = m - 1;
    102 }
    103 
    104 static void
    105105uniformu32_ith_state (rstate_t *state, uint32_t i)
    106106{
     
    143143  (make-u32vector STATE-SIZE) )
    144144
    145 (define *mwc-initial-state* (make-state))
     145(define (mwc-initial-state)
     146  (let ([state (make-state)])
     147    ($ void init_state #$state (double INITIAL-SEED))
     148    state ) )
    146149
    147150;; Note - The result will never exceed the fixnum range when
     
    160163(define (mwc-state-set external-state)
    161164  (if (and (pair? external-state)
    162            (fx= (fx+ STATE-SIZE 1) (length external-state))
    163            (eq? 'marsaglia-mwc (car external-state)))
     165           (eq? 'marsaglia-mwc (car external-state))
     166           (fx= (fx+ STATE-SIZE 1) (length external-state)))
    164167      (let* ([state (make-state)]
    165168             [setter
     
    198201
    199202(define (make-mwc-random-source)
    200   (let ([state *mwc-initial-state*])
     203  (let ([state (mwc-initial-state)])
    201204    (%make-random-source 'MWC
    202205      ;
     
    243246
    244247($ void init_masktab)
    245 ($ void init_state #$*mwc-initial-state* (double INITIAL-SEED))
     248
  • release/3/srfi-27/trunk/srfi-27.setup

    r8337 r8432  
    1010  'numbers                "1.8")
    1111
     12#|
    1213(install-dynld entropy-structures *version*)
    1314
     
    1516
    1617(install-dynld entropy-clock *version* -O3 -d0)
    17 #+windows
    18 (install-dynld entropy-windows *version* -O3 -d0)
    19 #+unix
    20 (install-dynld entropy-unix *version* -O3 -d0)
     18
     19(cond-expand
     20  [unix
     21    (install-dynld entropy-unix *version* -O3 -d0) ]
     22  [windows
     23    (install-dynld entropy-windows *version* -O3 -d0) ] )
     24
    2125(install-dynld entropy-fixed *version*)
    2226
     
    2630
    2731(install-dynld srfi-27-large-numbers *version* -O3 -d0)
     32|#
    2833
    2934(install-dynld mrg32k3a-primitives *version* -O3 -d0 +easyffi +dollar)
     
    3641(install-dynld moa *version*)
    3742
     43#|
    3844(install-dynld srfi-27-parameters *version*)
    3945
     
    4147
    4248(install-dynld+docu srfi-27 *version*)
     49|#
  • release/3/srfi-27/trunk/tests/conf-test.scm

    r8346 r8432  
    205205           (unless (equal? state1 state2)
    206206             (error 'check-mrg32k3a "16-th state after (1 0 0 1 0 0) is wrong" state1 state2))))
     207(print "State " k ": " (random-source-state-ref s))
    207208      (rand) ) )
    208209  (print "ok")
Note: See TracChangeset for help on using the changeset viewer.