Changeset 8432 in project
 Timestamp:
 02/13/08 06:40:44 (12 years ago)
 Location:
 release/3/srfi27/trunk
 Files:

 5 edited
Legend:
 Unmodified
 Added
 Removed

release/3/srfi27/trunk/moaprimitives.scm
r8337 r8432 45 45 static unsigned char masktab[256]; 46 46 47 static void 48 init_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 47 56 #define m16Long 65536L /* 2^16 */ 48 57 #define m16Mask 0xFFFF /* mask for lower 16 bits */ … … 136 145 } 137 146 138 static void139 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 147 147 #if 0 148 148 static void … … 188 188 (makes16vector STATESIZE) ) 189 189 190 (define *moainitialstate* (makestate)) 190 (define (moainitialstate) 191 (let ([state (makestate)]) 192 ($ void init_state #$state (double INITIALSEED)) 193 state ) ) 191 194 192 195 ;; Note  The result will never exceed the fixnum range when … … 208 211 (define (moastateset externalstate) 209 212 (if (and (pair? externalstate) 210 ( fx= (fx+ STATESIZE 1) (lengthexternalstate))211 ( eq? 'marsagliamoa (carexternalstate)))213 (eq? 'marsagliamoa (car externalstate)) 214 (fx= (fx+ STATESIZE 1) (length externalstate))) 212 215 (let ([state (makestate)]) 213 216 (let loop ([i 0] [lst (cdr externalstate)]) … … 256 259 257 260 (define (makemoarandomsource) 258 (let ([state *moainitialstate*])261 (let ([state (moainitialstate)]) 259 262 (%makerandomsource 'MOA 260 263 ; … … 301 304 302 305 ($ void init_masktab) 303 ($ void init_state #$*moainitialstate* (double INITIALSEED)) 
release/3/srfi27/trunk/mrg32k3aprimitives.scm
r8338 r8432 84 84 (defineconstant MAXIMUMRANGE 1073741823) ; 2^301 (MOST_POSITIVE_FIXNUM) 85 85 86 (defineconstant M1 4294967087.0) ; modulus of component 1 87 88 (defineconstant M2 4294944443.0) ; modulus of component 2 86 (defineconstant M1 4294967087.0) ; modulus of component 1 87 (defineconstant M11 4294967086.0) ; M1  1.0 88 89 (defineconstant M2 4294944443.0) ; modulus of component 2 90 (defineconstant M21 4294944442.0) ; M2  1.0 89 91 90 92 (defineconstant M2^28 268435456.0) … … 166 168 ; =================== 167 169 170 (define (mrg32k3ainitialstate) 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 168 180 (define (mrg32k3aunpackstate packedstate) 169 181 (cons 'lecuyermrg32k3a 170 182 (map inexact>exact (f64vector>list packedstate))) ) 171 183 172 (define (mrg32k3a statepackedexternalstate)184 (define (mrg32k3apackstate externalstate) 173 185 174 186 (define (checkvalue x m) 175 (or (and (integer? x) (<= 0 x ( m 1)))176 (error 'mrg32k3a statepacked"illegal value" x) ) )187 (or (and (integer? x) (<= 0 x) (< x m)) 188 (error 'mrg32k3apackstate "illegal value" x) ) ) 177 189 178 190 (if (and (pair? externalstate) … … 189 201 (if (or (zero? (+ l0 l1 l2)) 190 202 (zero? (+ l3 l4 l5))) 191 (error 'mrg32k3a statepacked"illegal degenerate state" externalstate)203 (error 'mrg32k3apackstate "illegal degenerate state" externalstate) 192 204 (f64vector l0 l1 l2 l3 l4 l5) ) ) 193 (error 'mrg32k3a statepacked"malformed state" externalstate) ) )205 (error 'mrg32k3apackstate "malformed state" externalstate) ) ) 194 206 195 207 ; PseudoRandomization … … 227 239 ; available this is not necessary, but pseudorandomize! is expected 228 240 ; to be called only occasionally so we do not provide this implementation. 229 230 (define *mrg32k3ainitialstate* ; 0 3 6 9 12 15 of A^16, see below231 (f64vector232 1250826159233 3004357423234 431373563235 3322526864236 623307378237 2983662421))238 241 239 242 (define mrg32k3apseudorandomizestate … … 357 360 (let ([random 358 361 (let ([randomm 359 (let ([x (fpmodulo ((%entropysourcef64 entropysource)) 360 M2^16)]) 362 (let ([x (fpmodulo ((%entropysourcef64 entropysource)) M2^16)]) 361 363 (lambda () 362 364 (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)) 365 366 y ) ) ) ] ) 366 367 (lambda (n) ; m < n < m^2 367 (fpmodulo (fp+ (fp* (randomm) M2^16) 368 (randomm)) 369 n) ) ) ] ) 368 (fpmodulo (fp+ (fp* (randomm) M2^16) (randomm)) n) ) ) ] ) 370 369 ; the new state 371 370 (f64vector 372 (fp+ 1.0 (fpmodulo (fp+ (f64vectorref state 0) (random (fp M1 1.0))) (fp M1 1.0)))371 (fp+ 1.0 (fpmodulo (fp+ (f64vectorref state 0) (random M11)) M11)) 373 372 (fpmodulo (fp+ (f64vectorref state 1) (random M1)) M1) 374 373 (fpmodulo (fp+ (f64vectorref state 2) (random M1)) M1) 375 (fp+ 1.0 (fpmodulo (fp+ (f64vectorref state 3) (random (fp M2 1.0))) (fp M2 1.0)))374 (fp+ 1.0 (fpmodulo (fp+ (f64vectorref state 3) (random M21)) M21)) 376 375 (fpmodulo (fp+ (f64vectorref state 4) (random M2)) M2) 377 376 (fpmodulo (fp+ (f64vectorref state 5) (random M2)) M2)) ) ) … … 406 405 407 406 (define (makemrg32k3arandomsource) 408 (let ([state *mrg32k3ainitialstate*])407 (let ([state (mrg32k3ainitialstate)]) 409 408 (%makerandomsource 'MRG32k3a 410 409 ; … … 415 414 ; 416 415 (lambda (newstate) 417 (set! state (mrg32k3a statepackednewstate)) )416 (set! state (mrg32k3apackstate newstate)) ) 418 417 ; 419 418 (lambda (entropysource) 
release/3/srfi27/trunk/mwcprimitives.scm
r8337 r8432 44 44 45 45 static unsigned char masktab[256]; 46 47 static void 48 init_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 } 46 55 47 56 static uint32_t … … 94 103 95 104 static 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 void105 105 uniformu32_ith_state (rstate_t *state, uint32_t i) 106 106 { … … 143 143 (makeu32vector STATESIZE) ) 144 144 145 (define *mwcinitialstate* (makestate)) 145 (define (mwcinitialstate) 146 (let ([state (makestate)]) 147 ($ void init_state #$state (double INITIALSEED)) 148 state ) ) 146 149 147 150 ;; Note  The result will never exceed the fixnum range when … … 160 163 (define (mwcstateset externalstate) 161 164 (if (and (pair? externalstate) 162 ( fx= (fx+ STATESIZE 1) (lengthexternalstate))163 ( eq? 'marsagliamwc (carexternalstate)))165 (eq? 'marsagliamwc (car externalstate)) 166 (fx= (fx+ STATESIZE 1) (length externalstate))) 164 167 (let* ([state (makestate)] 165 168 [setter … … 198 201 199 202 (define (makemwcrandomsource) 200 (let ([state *mwcinitialstate*])203 (let ([state (mwcinitialstate)]) 201 204 (%makerandomsource 'MWC 202 205 ; … … 243 246 244 247 ($ void init_masktab) 245 ($ void init_state #$*mwcinitialstate* (double INITIALSEED)) 248 
release/3/srfi27/trunk/srfi27.setup
r8337 r8432 10 10 'numbers "1.8") 11 11 12 # 12 13 (installdynld entropystructures *version*) 13 14 … … 15 16 16 17 (installdynld entropyclock *version* O3 d0) 17 #+windows 18 (installdynld entropywindows *version* O3 d0) 19 #+unix 20 (installdynld entropyunix *version* O3 d0) 18 19 (condexpand 20 [unix 21 (installdynld entropyunix *version* O3 d0) ] 22 [windows 23 (installdynld entropywindows *version* O3 d0) ] ) 24 21 25 (installdynld entropyfixed *version*) 22 26 … … 26 30 27 31 (installdynld srfi27largenumbers *version* O3 d0) 32 # 28 33 29 34 (installdynld mrg32k3aprimitives *version* O3 d0 +easyffi +dollar) … … 36 41 (installdynld moa *version*) 37 42 43 # 38 44 (installdynld srfi27parameters *version*) 39 45 … … 41 47 42 48 (installdynld+docu srfi27 *version*) 49 # 
release/3/srfi27/trunk/tests/conftest.scm
r8346 r8432 205 205 (unless (equal? state1 state2) 206 206 (error 'checkmrg32k3a "16th state after (1 0 0 1 0 0) is wrong" state1 state2)))) 207 (print "State " k ": " (randomsourcestateref s)) 207 208 (rand) ) ) 208 209 (print "ok")
Note: See TracChangeset
for help on using the changeset viewer.