]> gitweb.factorcode.org Git - factor.git/commitdiff
ricing random.cmwc
authorDoug Coleman <doug.coleman@gmail.com>
Fri, 16 Oct 2009 20:07:05 +0000 (15:07 -0500)
committerDoug Coleman <doug.coleman@gmail.com>
Fri, 16 Oct 2009 20:07:05 +0000 (15:07 -0500)
extra/random/cmwc/cmwc-tests.factor
extra/random/cmwc/cmwc.factor

index 6e3f4ac178c741c3ae72341b346c9529a78b1956..8dc9f8764f6838db85321f28698eca42ab6ea319 100644 (file)
@@ -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 =
index 00258257be702302173f26f15a726eb504a55c53..b38dd0a28a57ecc7c0f1456120e734b10374ea02 100644 (file)
@@ -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 ;