code.consxy.com Git - clnl/blob - src/main/clnl/random.lisp

   1 ; Copyright 2022 Frank Duncan (frank@consxy.com) under AGPL3.  See distributed LICENSE.txt.
   2 (in-package #:clnl-random)
   3
   4 (defun set-seed (n)
   5  "SET-SEED => RESULT
   6
   7 ARGUMENTS AND VALUES:
   8
   9   RESULT: undefined
  10
  11 DESCRIPTION:
  12
  13   SET-SEED sets the seed on the RNG."
  14  (setf mt19937:*random-state* (funcall
  15                                (symbol-function (intern "MAKE-RANDOM-OBJECT" :mt19937))
  16                                :state (mt19937:init-random-state n))))
  17
  18 (defun next-int (n)
  19  "NEXT-INT N => INT
  20
  21 ARGUMENTS AND VALUES:
  22
  23   N: An integer representing the upper bound
  24   INT: An integer
  25
  26 DESCRIPTION:
  27
  28   NEXT-INT returns the next randomly generated integer.
  29
  30   It does so in a way that's in accordance with java.util.Random and
  31   the MerseinneTwisterFast that's in NetLogo.  It also advances the
  32   RNG and is bounded by N."
  33  (if
  34   (= n (logand n (- n)))
  35   (ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1)) -31)
  36   (rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n)))
  37
  38 (defun next-long (n)
  39  "NEXT-LONG N => LONG
  40
  41 ARGUMENTS AND VALUES:
  42
  43   N: A long representing the upper bound
  44   LONG: A long
  45
  46 DESCRIPTION:
  47
  48   NEXT-LONG returns the next randomly generated long.
  49
  50   It does so in a way that's in accordance with java.util.Random and
  51   the MerseinneTwisterFast that's in NetLogo.  It also advances the
  52   RNG and is bounded by N."
  53  (flet
  54   ((unsigned-to-signed (value size) ; We need this because MersenneTwisterFast
  55     (if (logbitp (1- size) value) (dpb value (byte size 0) -1) value))
  56    (signed-to-unsigned (value size) (ldb (byte size 0) value)))
  57   (let
  58    ((y (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32))
  59     (z (unsigned-to-signed (mt19937:random-chunk mt19937:*random-state*) 32)))
  60    ;(mod (+ (ash y 32) z) n)))
  61    (mod (signed-to-unsigned (ash (+ (ash y 32) z) -1) 63) n))))
  62
  63 (defun next-double (&optional (n 1d0))
  64  "NEXT-DOUBLE &optional N => DOUBLE
  65
  66 ARGUMENTS AND VALUES:
  67
  68   N: A double representing the upper bound
  69   DOUBLE: A double
  70
  71 DESCRIPTION:
  72
  73   NEXT-DOUBLE returns the next randomly generated double.
  74
  75   It does so in a way that's in accordance with java.util.Random and
  76   the MerseinneTwisterFast that's in NetLogo.  It also advances the
  77   RNG and is bounded by N."
  78  (let
  79   ((y (mt19937:random-chunk mt19937:*random-state*))
  80    (z (mt19937:random-chunk mt19937:*random-state*)))
  81   (*
  82    (/
  83     (+ (ash (ash y -6) 27) (ash z -5))
  84     (coerce (ash 1 53) 'double-float))
  85    n)))
  86
  87 ; Oh, export world, you WILL be mine
  88 (defun export ()
  89  "EXPORT => RANDOM-STATE
  90
  91 ARGUMENTS AND VALUES:
  92
  93   RANDOM-STATE: A dump of the current random state
  94
  95 DESCRIPTION:
  96
  97   EXPORT dumps out the random state to be export world ready.
  98
  99   When NetLogo dumps out the current state of the engine, the state of the
 100   RNG also gets dumped out so that it can be reinitialized later.  This
 101   accomplishes that.
 102
 103   This isn't really useful for regular use."
 104  (let
 105   ((state
 106     (map
 107      'list
 108      (lambda (x) (if (logbitp (1- 32) x) (dpb x (byte 32 0) -1) x))
 109      (funcall (symbol-function (intern "RANDOM-STATE-STATE" :mt19937)) mt19937:*random-state*))))
 110   (format nil "0 ~A ~A ~A 0.0 false ~{~A~^ ~}"
 111    (first state) (second state) (third state)
 112    (nthcdr 3 state))))