Prims - Implement random, random-xcor, random-ycor, setxy
[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-INT 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-long (n)
38  "NEXT-LONG N => LONG
39
40 ARGUMENTS AND VALUES:
41
42   N: A long representing the upper bound
43   LONG: A long
44
45 DESCRIPTION:
46
47   NEXT-LONG returns the next randomly generated long.
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  (flet
53   ((unsigned-to-signed (value size) ; We need this because MersenneTwisterFast
54     (if (logbitp (1- size) value) (dpb value (byte size 0) -1) value))
55    (signed-to-unsigned (value size) (ldb (byte size 0) value)))
56   (let
57    ((y (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32))
58     (z (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32)))
59    ;(mod (+ (ash y 32) z) n)))
60    (mod (signed-to-unsigned (ash (+ (ash y 32) z) -1) 63) n))))
61
62 (defun next-double (&optional (n 1d0))
63  "NEXT-DOUBLE &optional N => DOUBLE
64
65 ARGUMENTS AND VALUES:
66
67   N: A double representing the upper bound
68   DOUBLE: A double
69
70 DESCRIPTION:
71
72   NEXT-DOUBLE returns the next randomly generated double.
73
74   It does so in a way that's in accordance with java.util.Random and
75   the MerseinneTwisterFast that's in NetLogo.  It also advances the
76   RNG and is bounded by N."
77  (let
78   ((y (mt19937:random-chunk mt19937:*random-state*))
79    (z (mt19937:random-chunk mt19937:*random-state*)))
80   (*
81    (/
82     (+ (ash (ash y -6) 27) (ash z -5))
83     (coerce (ash 1 53) 'double-float))
84    n)))
85
86 ; Oh, export world, you WILL be mine
87 (defun export ()
88  "EXPORT => RANDOM-STATE
89
90 ARGUMENTS AND VALUES:
91
92   RANDOM-STATE: A dump of the current random state
93
94 DESCRIPTION:
95
96   EXPORT dumps out the random state to be export world ready.
97
98   When NetLogo dumps out the current state of the engine, the state of the
99   RNG also gets dumped out so that it can be reinitialized later.  This
100   accomplishes that.
101
102   This isn't really useful for regular use."
103  (let
104   ((state
105     (map
106      'list
107      (lambda (x) (if (logbitp (1- 32) x) (dpb x (byte 32 0) -1) x))
108      (funcall (symbol-function (intern "RANDOM-STATE-STATE" :mt19937)) mt19937:*random-state*))))
109   (format nil "0 ~A ~A ~A 0.0 false ~{~A~^ ~}"
110    (first state) (second state) (third state)
111    (nthcdr 3 state))))