Get working on Windows 8
[clnl] / src / main / random.lisp
1 (in-package #:clnl-random)
2
3 (defun set-seed (n)
4  "SET-SEED => RESULT
5
6 ARGUMENTS AND VALUES:
7
8   RESULT: undefined
9
10 DESCRIPTION:
11
12   SET-SEED sets the seed on the RNG."
13  (setf mt19937:*random-state* (funcall
14                                (symbol-function (intern "MAKE-RANDOM-OBJECT" :mt19937))
15                                :state (mt19937:init-random-state n))))
16
17 (defun next-int (n)
18  "NEXT-INT N => INT
19
20 ARGUMENTS AND VALUES:
21
22   N: An integer representing the upper bound
23   INT: An integer
24
25 DESCRIPTION:
26
27   NEXT-INTEGER returns the next randomly generated integer.
28
29   It does so in a way that's in accordance with java.util.Random and
30   the MerseinneTwisterFast that's in NetLogo.  It also advances the
31   RNG and is bounded by N."
32  (if
33   (= n (logand n (- n) ))
34   (ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1) ) -31)
35   (rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n)))
36
37 (defun next-double (&optional (n 1d0))
38  "NEXT-DOUBLE &optional N => DOUBLE
39
40 ARGUMENTS AND VALUES:
41
42   N: A double representing the upper bound
43   DOUBLE: A double
44
45 DESCRIPTION:
46
47   NEXT-DOUBLE returns the next randomly generated double.
48
49   It does so in a way that's in accordance with java.util.Random and
50   the MerseinneTwisterFast that's in NetLogo.  It also advances the
51   RNG and is bounded by N."
52  (let
53   ((y (mt19937:random-chunk mt19937:*random-state*))
54    (z (mt19937:random-chunk mt19937:*random-state*)))
55   (*
56    (/
57     (+ (ash (ash y -6) 27) (ash z -5))
58     (coerce (ash 1 53) 'double-float))
59    n)))
60
61 ; Oh, export world, you WILL be mine
62 (defun export ()
63  "EXPORT => RANDOM-STATE
64
65 ARGUMENTS AND VALUES:
66
67   RANDOM-STATE: A dump of the current random state
68
69 DESCRIPTION:
70
71   EXPORT dumps out the random state to be export world ready.
72
73   When NetLogo dumps out the current state of the engine, the state of the
74   RNG also gets dumped out so that it can be reinitialized later.  This
75   accomplishes that.
76
77   This isn't really useful for regular use."
78  (let
79   ((state
80     (map
81      'list
82      (lambda (x) (if (logbitp (1- 32) x) (dpb x (byte 32 0) -1) x))
83      (funcall (symbol-function (intern "RANDOM-STATE-STATE" :mt19937)) mt19937:*random-state*))))
84   (format nil "0 ~A ~A ~A 0.0 false ~{~A~^ ~}"
85    (first state) (second state) (third state)
86    (nthcdr 3 state))))