diff --git a/extra/random/cmwc/authors.txt b/extra/random/cmwc/authors.txt new file mode 100644 index 0000000000..b4bd0e7b35 --- /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 index 0000000000..35785923f2 --- /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 index 0000000000..471c616247 --- /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 ; + +: ( length a b c -- cmwc ) + cmwc new + swap >>c + swap >>b + swap >>a + swap [ 1 - >>i ] [ 0 >>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 ] + [ '[ [ random-32 ] replicate ] with-system-random seed-random ] bi ;