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-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))))