ricing random.cmwc
parent
3db0ad12e8
commit
69f5381d34
|
@ -1,6 +1,7 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays kernel random random.cmwc sequences tools.test ;
|
||||
USING: alien.c-types arrays kernel random random.cmwc sequences
|
||||
specialized-arrays specialized-arrays.instances.uint tools.test ;
|
||||
IN: random.cmwc.tests
|
||||
|
||||
[ ] [
|
||||
|
@ -24,18 +25,18 @@ IN: random.cmwc.tests
|
|||
}
|
||||
] [
|
||||
cmwc-4096
|
||||
4096 iota >array 362436 <cmwc-seed> seed-random [
|
||||
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
|
||||
10 [ random-32 ] replicate
|
||||
] with-random
|
||||
] unit-test
|
||||
|
||||
[ t ] [
|
||||
cmwc-4096 [
|
||||
4096 iota >array 362436 <cmwc-seed> seed-random [
|
||||
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
|
||||
10 [ random-32 ] replicate
|
||||
] with-random
|
||||
] [
|
||||
4096 iota >array 362436 <cmwc-seed> seed-random [
|
||||
4096 iota >uint-array 362436 <cmwc-seed> seed-random [
|
||||
10 [ random-32 ] replicate
|
||||
] with-random
|
||||
] bi =
|
||||
|
|
|
@ -1,28 +1,34 @@
|
|||
! Copyright (C) 2009 Doug Coleman.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays fry kernel locals math math.bitwise
|
||||
random sequences ;
|
||||
USING: accessors alien.c-types arrays fry kernel locals math
|
||||
math.bitwise random sequences specialized-arrays
|
||||
specialized-arrays.instances.uint ;
|
||||
IN: random.cmwc
|
||||
|
||||
! Multiply-with-carry RNG
|
||||
|
||||
TUPLE: cmwc Q a b c i r mod ;
|
||||
TUPLE: cmwc
|
||||
{ Q uint-array }
|
||||
{ a fixnum }
|
||||
{ b fixnum }
|
||||
{ c fixnum }
|
||||
{ i fixnum }
|
||||
{ r fixnum }
|
||||
{ mod fixnum } ;
|
||||
|
||||
TUPLE: cmwc-seed Q c ;
|
||||
TUPLE: cmwc-seed { Q uint-array read-only } { c read-only } ;
|
||||
|
||||
: <cmwc> ( length a b c -- cmwc )
|
||||
cmwc new
|
||||
swap >>c
|
||||
swap >>b
|
||||
swap >>a
|
||||
swap [ 1 - >>i ] [ 0 <array> >>Q ] bi
|
||||
swap [ 1 - >>i ] [ <uint-array> >>Q ] bi
|
||||
dup b>> 1 - >>r
|
||||
dup Q>> length 1 - >>mod ;
|
||||
|
||||
: <cmwc-seed> ( Q c -- cmwc-seed )
|
||||
cmwc-seed new
|
||||
swap >>c
|
||||
swap >>Q ; inline
|
||||
cmwc-seed boa ; inline
|
||||
|
||||
M: cmwc seed-random
|
||||
[ Q>> >>Q ]
|
||||
|
@ -49,6 +55,8 @@ M:: cmwc random-32* ( cmwc -- n )
|
|||
4096
|
||||
[ 18782 4294967295 362436 <cmwc> ]
|
||||
[
|
||||
'[ [ random-32 ] replicate ] with-system-random
|
||||
'[ [ random-32 ] uint-array{ } replicate-as ] with-system-random
|
||||
362436 <cmwc-seed> seed-random
|
||||
] bi ;
|
||||
|
||||
: default-cmwc ( -- cmwc ) cmwc-4096 ;
|
||||
|
|
Loading…
Reference in New Issue