code.consxy.com Git - clnl/blob - 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))))