add cmwc rng to extra

diff --git a/extra/random/cmwc/authors.txt b/extra/random/cmwc/authors.txt
new file mode 100644 (file)
index 0000000..b4bd0e7
--- /dev/null
+++ b/extra/random/cmwc/authors.txt
@@ -0,0 +1 @@
+Doug Coleman
\ No newline at end of file

diff --git a/extra/random/cmwc/cmwc-tests.factor b/extra/random/cmwc/cmwc-tests.factor
new file mode 100644 (file)
index 0000000..3578592
--- /dev/null
+++ b/extra/random/cmwc/cmwc-tests.factor
@@ -0,0 +1,42 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays kernel random random.cmwc sequences tools.test ;
+IN: random.cmwc.tests
+
+[ ] [
+    cmwc-4096 [
+        random-32 drop
+    ] with-random
+] unit-test
+
+[
+{
+    4294604858
+    4294948512
+    4294929730
+    4294910948
+    4294892166
+    4294873384
+    4294854602
+    4294835820
+    4294817038
+    4294798256
+}
+] [
+    cmwc-4096
+    4096 iota >array seed-random [
+        10 [ random-32 ] replicate
+    ] with-random
+] unit-test
+
+[ t ] [
+    cmwc-4096
+    4096 iota >array seed-random [
+        10 [ random-32 ] replicate
+    ] with-random
+
+    cmwc-4096
+    4096 iota >array seed-random [
+        10 [ random-32 ] replicate
+    ] with-random =
+] unit-test

diff --git a/extra/random/cmwc/cmwc.factor b/extra/random/cmwc/cmwc.factor
new file mode 100644 (file)
index 0000000..471c616
--- /dev/null
+++ b/extra/random/cmwc/cmwc.factor
@@ -0,0 +1,45 @@
+! 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 ;
+IN: random.cmwc
+
+! Multiply-with-carry RNG
+
+TUPLE: cmwc Q a b c i r mod ;
+
+TUPLE: cmwc-seed Q c ;
+
+: <cmwc> ( length a b c -- cmwc )
+    cmwc new
+        swap >>c
+        swap >>b
+        swap >>a
+        swap [ 1 - >>i ] [ 0 <array> >>Q ] bi
+        dup b>> 1 - >>r
+        dup Q>> length 1 - >>mod ;
+
+M: cmwc seed-random
+    [ >>Q ]
+    [ length 1 - >>i ] bi ;
+
+M:: cmwc random-32* ( cmwc -- n )
+    cmwc dup mod>> '[ 1 + _ bitand ] change-i
+    [ a>> ]
+    [ [ i>> ] [ Q>> ] bi nth * ]
+    [ c>> + ] tri :> t!
+
+    t -32 shift cmwc (>>c)
+
+    t cmwc [ b>> bitand ] [ c>> + ] bi 64 bits t!
+    t cmwc r>> > [
+        cmwc [ 1 + ] change-c drop
+        t cmwc b>> - 64 bits t!
+    ] when
+
+    cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth ;
+
+: cmwc-4096 ( -- cmwc )
+    4096
+    [ 18782 4294967295 362436 <cmwc> ]
+    [ '[ [ random-32 ] replicate ] with-system-random seed-random ] bi ;