X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Fmain%2Frandom.lisp;h=fad9431ff26a4a8040f2df12b481209f77aa978d;hb=fe712aa;hp=44a1a2af0531f6d48e40109cbfa04f9283369bc1;hpb=1ae8c7a0199a4955708c7f5d7a286a12782b5fd2;p=clnl diff --git a/src/main/random.lisp b/src/main/random.lisp index 44a1a2a..fad9431 100644 --- a/src/main/random.lisp +++ b/src/main/random.lisp @@ -1,32 +1,86 @@ -(in-package #:cl-nl.random) +(in-package #:clnl-random) -; This is a wrapper around the very nice mersenne twister mt19937 to match -; NetLogo's implementation that tries to match how java.util.Random works - (defun set-seed (n) - (setf mt19937:*random-state* (mt19937::make-random-object :state (mt19937:init-random-state n)))) + "SET-SEED => RESULT + +ARGUMENTS AND VALUES: + + RESULT: undefined + +DESCRIPTION: + + SET-SEED sets the seed on the RNG." + (setf mt19937:*random-state* (funcall + (symbol-function (intern "MAKE-RANDOM-OBJECT" :mt19937)) + :state (mt19937:init-random-state n)))) (defun next-int (n) - (rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n)) + "NEXT-INT N => INT + +ARGUMENTS AND VALUES: + + N: An integer representing the upper bound + INT: An integer + +DESCRIPTION: + + NEXT-INTEGER returns the next randomly generated integer. + + It does so in a way that's in accordance with java.util.Random and + the MerseinneTwisterFast that's in NetLogo. It also advances the + RNG and is bounded by N." + (if + (= n (logand n (- n) )) + (ash (* n (ash (mt19937:random-chunk mt19937:*random-state*) -1) ) -31) + (rem (ash (mt19937:random-chunk mt19937:*random-state*) -1) n))) (defun next-double (&optional (n 1d0)) + "NEXT-DOUBLE &optional N => DOUBLE + +ARGUMENTS AND VALUES: + + N: A double representing the upper bound + DOUBLE: A double + +DESCRIPTION: + + NEXT-DOUBLE returns the next randomly generated double. + + It does so in a way that's in accordance with java.util.Random and + the MerseinneTwisterFast that's in NetLogo. It also advances the + RNG and is bounded by N." (let ((y (mt19937:random-chunk mt19937:*random-state*)) (z (mt19937:random-chunk mt19937:*random-state*))) - (* - (/ - (+ (ash (ash y -6) 27) (ash z -5)) - (coerce (ash 1 53) 'double-float)) - n))) + (* + (/ + (+ (ash (ash y -6) 27) (ash z -5)) + (coerce (ash 1 53) 'double-float)) + n))) ; Oh, export world, you WILL be mine (defun export () + "EXPORT => RANDOM-STATE + +ARGUMENTS AND VALUES: + + RANDOM-STATE: A dump of the current random state + +DESCRIPTION: + + EXPORT dumps out the random state to be export world ready. + + When NetLogo dumps out the current state of the engine, the state of the + RNG also gets dumped out so that it can be reinitialized later. This + accomplishes that. + + This isn't really useful for regular use." (let ((state (map 'list (lambda (x) (if (logbitp (1- 32) x) (dpb x (byte 32 0) -1) x)) - (mt19937::random-state-state mt19937:*random-state*)))) - (format nil "0 ~A ~A ~A 0.0 false 1 ~{~A~^ ~}" + (funcall (symbol-function (intern "RANDOM-STATE-STATE" :mt19937)) mt19937:*random-state*)))) + (format nil "0 ~A ~A ~A 0.0 false ~{~A~^ ~}" (first state) (second state) (third state) - (nthcdr 4 state)))) + (nthcdr 3 state))))