1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays fry kernel locals math math.bitwise
7 ! Multiply-with-carry RNG
9 TUPLE: cmwc Q a b c i r mod ;
11 TUPLE: cmwc-seed Q c ;
13 : <cmwc> ( length a b c -- cmwc )
18 swap [ 1 - >>i ] [ 0 <array> >>Q ] bi
20 dup Q>> length 1 - >>mod ;
22 : <cmwc-seed> ( Q c -- cmwc-seed )
29 [ Q>> length 1 - >>i ]
32 M:: cmwc random-32* ( cmwc -- n )
33 cmwc dup mod>> '[ 1 + _ bitand ] change-i
35 [ [ i>> ] [ Q>> ] bi nth * ]
38 t -32 shift cmwc (>>c)
40 t cmwc [ b>> bitand ] [ c>> + ] bi 64 bits t!
42 cmwc [ 1 + ] change-c drop
43 t cmwc b>> - 64 bits t!
46 cmwc [ r>> t - 32 bits dup ] [ i>> ] [ Q>> ] tri set-nth ;
48 : cmwc-4096 ( -- cmwc )
50 [ 18782 4294967295 362436 <cmwc> ]
52 '[ [ random-32 ] replicate ] with-system-random
53 362436 <cmwc-seed> seed-random