Skip to content
Snippets Groups Projects
Commit cba9bad7 authored by Raymond Toy's avatar Raymond Toy
Browse files

Update xoroshiro methods to standard names

parent 38db18cb
No related branches found
No related tags found
No related merge requests found
...@@ -13,12 +13,11 @@ ...@@ -13,12 +13,11 @@
(in-package "LISP") (in-package "LISP")
(intl:textdomain "cmucl") (intl:textdomain "cmucl")
#+nil (export '(random-state random-state-p random *random-state*
(export '(xoro-random-state xoro-random-state-p xoro-random *xoro-random-state* make-random-state))
make-xoro-random-state))
(in-package "KERNEL") (in-package "KERNEL")
(export '(%xoroshiro-single-float %xoroshiro-double-float xoroshiro-chunk init-xoro-state)) (export '(%random-single-float %random-double-float random-chunk init-random-state))
(sys:register-lisp-feature :random-xoroshiro) (sys:register-lisp-feature :random-xoroshiro)
...@@ -88,7 +87,7 @@ ...@@ -88,7 +87,7 @@
state)) state))
(defun init-xoro-state (&optional (seed 5772156649015328606) state) (defun init-random-state (&optional (seed 5772156649015328606) state)
"Generate an random state vector from the given SEED. The seed can be "Generate an random state vector from the given SEED. The seed can be
either an integer or a vector of (unsigned-byte 32)" either an integer or a vector of (unsigned-byte 32)"
(declare (type (or null integer (declare (type (or null integer
...@@ -101,8 +100,8 @@ ...@@ -101,8 +100,8 @@
((array (unsigned-byte 64) (2)) ((array (unsigned-byte 64) (2))
(vec-init-xoro-state seed state))))) (vec-init-xoro-state seed state)))))
(defstruct (xoro-random-state (defstruct (random-state
(:constructor make-xoroshiro-object) (:constructor make-random-object)
(:print-function %print-xoro-state) (:print-function %print-xoro-state)
(:make-load-form-fun :just-dump-it-normally)) (:make-load-form-fun :just-dump-it-normally))
;; The state of the RNG. The actual algorithm uses 2 64-bit words ;; The state of the RNG. The actual algorithm uses 2 64-bit words
...@@ -110,7 +109,7 @@ ...@@ -110,7 +109,7 @@
;; since a double-float is 64 bits long. At no point do we operate ;; since a double-float is 64 bits long. At no point do we operate
;; on these as floats; they're just convenient objects to hold the ;; on these as floats; they're just convenient objects to hold the
;; state we need. ;; state we need.
(state (init-xoro-state) (state (init-random-state)
:type (simple-array double-float (2))) :type (simple-array double-float (2)))
;; The generator produces 64-bit results. We separate the 64-bit ;; The generator produces 64-bit results. We separate the 64-bit
;; result into two parts. One is returned and the other is cached ;; result into two parts. One is returned and the other is cached
...@@ -125,9 +124,9 @@ ...@@ -125,9 +124,9 @@
;; Basically the same as the default structure printer, but we want ;; Basically the same as the default structure printer, but we want
;; to print the state as an array of integers instead of doubles, ;; to print the state as an array of integers instead of doubles,
;; because it's a bit confusing to see the state as doubles. ;; because it's a bit confusing to see the state as doubles.
(let ((state (xoro-random-state-state rng-state))) (let ((state (random-state-state rng-state)))
(pprint-logical-block (stream nil :prefix "#S(" :suffix ")") (pprint-logical-block (stream nil :prefix "#S(" :suffix ")")
(prin1 'xoro-random-state stream) (prin1 'random-state stream)
(write-char #\space stream) (write-char #\space stream)
(pprint-indent :block 2 stream) (pprint-indent :block 2 stream)
(pprint-newline :linear stream) (pprint-newline :linear stream)
...@@ -135,7 +134,7 @@ ...@@ -135,7 +134,7 @@
(write-char #\space stream) (write-char #\space stream)
(pprint-newline :miser stream) (pprint-newline :miser stream)
(pprint-logical-block (stream nil :prefix "#.(" :suffix ")") (pprint-logical-block (stream nil :prefix "#.(" :suffix ")")
(prin1 'init-xoro-state stream) (prin1 'init-random-state stream)
(write-char #\space stream) (write-char #\space stream)
(flet ((c (x) (flet ((c (x)
(multiple-value-bind (hi lo) (multiple-value-bind (hi lo)
...@@ -152,46 +151,47 @@ ...@@ -152,46 +151,47 @@
(prin1 :rand stream) (prin1 :rand stream)
(write-char #\space stream) (write-char #\space stream)
(pprint-newline :miser stream) (pprint-newline :miser stream)
(prin1 (xoro-random-state-rand rng-state) stream) (prin1 (random-state-rand rng-state) stream)
(write-char #\space stream) (write-char #\space stream)
(pprint-newline :linear stream) (pprint-newline :linear stream)
(prin1 :cached-p stream) (prin1 :cached-p stream)
(write-char #\space stream) (write-char #\space stream)
(pprint-newline :miser stream) (pprint-newline :miser stream)
(prin1 (xoro-random-state-cached-p rng-state) stream)))) (prin1 (random-state-cached-p rng-state) stream))))
(defvar *xoro-random-state* (defvar *random-state*
(make-xoroshiro-object)) (make-random-object))
(defun make-xoro-random-state (&optional state) (defun make-random-state (&optional state)
(flet ((copy-random-state (state) (flet ((copy-random-state (state)
(let ((old-state (xoro-random-state-state state)) (let ((old-state (random-state-state state))
(new-state (new-state
(make-array 2 :element-type 'double-float))) (make-array 2 :element-type 'double-float)))
(setf (aref new-state 0) (aref old-state 0)) (setf (aref new-state 0) (aref old-state 0))
(setf (aref new-state 1) (aref old-state 1)) (setf (aref new-state 1) (aref old-state 1))
(make-xoroshiro-object :state new-state (make-random-object :state new-state
:rand (xoro-random-state-rand state) :rand (random-state-rand state)
:cached-p (xoro-random-state-cached-p state))))) :cached-p (random-state-cached-p state)))))
(cond ((not state) (cond ((not state)
(copy-random-state *xoro-random-state*)) (copy-random-state *random-state*))
((xoro-random-state-p state) ((random-state-p state)
(copy-random-state state)) (copy-random-state state))
((eq state t) ((eq state t)
(make-xoroshiro-object :state (init-xoro-state (generate-seed 4)) (make-random-object :state (init-random-state (generate-seed 4))
:rand 0 :rand 0
:cached-p nil)) :cached-p nil))
(t (t
(error "Argument is not a RANDOM-STATE, T, or NIL: ~S" state))))) (error "Argument is not a RANDOM-STATE, T, or NIL: ~S" state)))))
(defun rand-initializer ()
(init-random-state (generate-seed)
(random-state-state *random-state*)))
(pushnew 'rand-initializer ext:*after-save-initializations*)
;;;; Random entries: ;;;; Random entries:
(declaim (ext:start-block xoroshiro-gen xoroshiro-chunk
%xoroshiro-single-float %xoroshiro-double-float
%xoroshiro-integer
#+double-double
%xoroshiro-double-double-float))
;;#+x86 ;;#+x86
;;(declaim (inline xoroshiro-next)) ;;(declaim (inline xoroshiro-next))
#+x86 #+x86
...@@ -280,31 +280,31 @@ ...@@ -280,31 +280,31 @@
(setf (aref state 0) (make-double s0-1 s0-0) (setf (aref state 0) (make-double s0-1 s0-0)
(aref state 1) (make-double r1 r0))))))) (aref state 1) (make-double r1 r0)))))))
;;; Size of the chunks returned by xoroshiro-chunk. ;;; Size of the chunks returned by random-chunk.
;;; ;;;
;;(defconstant random-chunk-length 32) (defconstant random-chunk-length 32)
;;; xoroshiro-chunk -- Internal ;;; random-chunk -- Internal
;;; ;;;
;;; This function generaters a 32bit integer between 0 and #xffffffff ;;; This function generaters a 32bit integer between 0 and #xffffffff
;;; inclusive. ;;; inclusive.
;;; ;;;
(declaim (inline xoroshiro-chunk)) (declaim (inline random-chunk))
(defun xoroshiro-chunk (rng-state) (defun random-chunk (rng-state)
(declare (type xoro-random-state rng-state) (declare (type random-state rng-state)
(optimize (speed 3) (safety 0))) (optimize (speed 3) (safety 0)))
(let ((cached (xoro-random-state-cached-p rng-state))) (let ((cached (random-state-cached-p rng-state)))
(cond (cached (cond (cached
(setf (xoro-random-state-cached-p rng-state) nil) (setf (random-state-cached-p rng-state) nil)
(xoro-random-state-rand rng-state)) (random-state-rand rng-state))
(t (t
(let ((s (xoro-random-state-state rng-state))) (let ((s (random-state-state rng-state)))
(declare (type (simple-array double-float (2)) s)) (declare (type (simple-array double-float (2)) s))
(multiple-value-bind (r1 r0) (multiple-value-bind (r1 r0)
(xoroshiro-gen s) (xoroshiro-gen s)
(setf (xoro-random-state-rand rng-state) r0) (setf (random-state-rand rng-state) r0)
(setf (xoro-random-state-cached-p rng-state) t) (setf (random-state-cached-p rng-state) t)
r1)))))) r1))))))
...@@ -314,45 +314,45 @@ ...@@ -314,45 +314,45 @@
;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits, ;;; between 0.0 and 1.0 by clobbering the significand of 1.0 with random bits,
;;; then subtracting 1.0. This hides the fact that we have a hidden bit. ;;; then subtracting 1.0. This hides the fact that we have a hidden bit.
;;; ;;;
(declaim (inline %xoroshiro-single-float %xoroshiro-double-float)) (declaim (inline %random-single-float %random-double-float))
(declaim (ftype (function ((single-float (0f0)) xoro-random-state) (declaim (ftype (function ((single-float (0f0)) random-state)
(single-float 0f0)) (single-float 0f0))
%xoroshiro-single-float)) %random-single-float))
;;; ;;;
(defun %xoroshiro-single-float (arg state) (defun %random-single-float (arg state)
(declare (type (single-float (0f0)) arg) (declare (type (single-float (0f0)) arg)
(type xoro-random-state state)) (type random-state state))
(* arg (* arg
(- (make-single-float (- (make-single-float
(dpb (ash (xoroshiro-chunk state) (dpb (ash (random-chunk state)
(- vm:single-float-digits random-chunk-length)) (- vm:single-float-digits random-chunk-length))
vm:single-float-significand-byte vm:single-float-significand-byte
(single-float-bits 1.0))) (single-float-bits 1.0)))
1.0))) 1.0)))
;;; ;;;
(declaim (ftype (function ((double-float (0d0)) xoro-random-state) (declaim (ftype (function ((double-float (0d0)) random-state)
(double-float 0d0)) (double-float 0d0))
%xoroshiro-double-float)) %random-double-float))
;;; ;;;
;;; 53bit version. ;;; 53bit version.
;;; ;;;
(defun %xoroshiro-double-float (arg state) (defun %random-double-float (arg state)
(declare (type (double-float (0d0)) arg) (declare (type (double-float (0d0)) arg)
(type xoro-random-state state)) (type random-state state))
(* arg (* arg
(- (lisp::make-double-float (- (lisp::make-double-float
(dpb (ash (xoroshiro-chunk state) (dpb (ash (random-chunk state)
(- vm:double-float-digits random-chunk-length (- vm:double-float-digits random-chunk-length
vm:word-bits)) vm:word-bits))
vm:double-float-significand-byte vm:double-float-significand-byte
(lisp::double-float-high-bits 1d0)) (lisp::double-float-high-bits 1d0))
(xoroshiro-chunk state)) (random-chunk state))
1d0))) 1d0)))
#+double-double #+double-double
(defun %xoroshiro-double-double-float (arg state) (defun %random-double-double-float (arg state)
(declare (type (double-double-float (0w0)) arg) (declare (type (double-double-float (0w0)) arg)
(type xoro-random-state state)) (type random-state state))
;; Generate a 31-bit integer, scale it and sum them up ;; Generate a 31-bit integer, scale it and sum them up
(let* ((r 0w0) (let* ((r 0w0)
(scale (scale-float 1d0 -31)) (scale (scale-float 1d0 -31))
...@@ -361,7 +361,7 @@ ...@@ -361,7 +361,7 @@
(type double-double-float r) (type double-double-float r)
(optimize (speed 3) (inhibit-warnings 3))) (optimize (speed 3) (inhibit-warnings 3)))
(dotimes (k 4) (dotimes (k 4)
(setf r (+ r (* mult (ldb (byte 31 0) (xoroshiro-chunk state))))) (setf r (+ r (* mult (ldb (byte 31 0) (random-chunk state)))))
(setf mult (* mult scale))) (setf mult (* mult scale)))
(* arg r))) (* arg r)))
...@@ -385,12 +385,12 @@ ...@@ -385,12 +385,12 @@
;;; %RANDOM-INTEGER -- Internal ;;; %RANDOM-INTEGER -- Internal
;;; ;;;
(defun %xoroshiro-integer (arg state) (defun %random-integer (arg state)
(declare (type (integer 1) arg) (declare (type (integer 1) arg)
(type xoro-random-state state)) (type random-state state))
(let ((shift (- random-chunk-length random-integer-overlap))) (let ((shift (- random-chunk-length random-integer-overlap)))
(do ((bits (xoroshiro-chunk state) (do ((bits (random-chunk state)
(logxor (ash bits shift) (xoroshiro-chunk state))) (logxor (ash bits shift) (random-chunk state)))
(count (+ (integer-length arg) (count (+ (integer-length arg)
(- random-integer-extra-bits shift)) (- random-integer-extra-bits shift))
(- count shift))) (- count shift)))
...@@ -398,29 +398,27 @@ ...@@ -398,29 +398,27 @@
(rem bits arg)) (rem bits arg))
(declare (fixnum count))))) (declare (fixnum count)))))
(declaim (ext:end-block)) (defun random (arg &optional (state *random-state*))
(defun xoro-random (arg &optional (state *xoro-random-state*))
"Generate a uniformly distributed pseudo-random number between zero "Generate a uniformly distributed pseudo-random number between zero
and Arg. State, if supplied, is the random state to use." and Arg. State, if supplied, is the random state to use."
(declare (inline %xoroshiro-single-float %xoroshiro-double-float (declare (inline %random-single-float %random-double-float
#+long-float %long-float)) #+long-float %long-float))
(cond (cond
((typep arg '(integer 1 #x100000000)) ((typep arg '(integer 1 #x100000000))
;; Let the compiler deftransform take care of this case. ;; Let the compiler deftransform take care of this case.
(%xoroshiro-integer arg state)) (%random-integer arg state))
((and (typep arg 'single-float) (> arg 0.0F0)) ((and (typep arg 'single-float) (> arg 0.0F0))
(%xoroshiro-single-float arg state)) (%random-single-float arg state))
((and (typep arg 'double-float) (> arg 0.0D0)) ((and (typep arg 'double-float) (> arg 0.0D0))
(%xoroshiro-double-float arg state)) (%random-double-float arg state))
#+long-float #+long-float
((and (typep arg 'long-float) (> arg 0.0L0)) ((and (typep arg 'long-float) (> arg 0.0L0))
(%xoroshiro-long-float arg state)) (%random-long-float arg state))
#+double-double #+double-double
((and (typep arg 'double-double-float) (> arg 0.0w0)) ((and (typep arg 'double-double-float) (> arg 0.0w0))
(%xoroshiro-double-double-float arg state)) (%random-double-double-float arg state))
((and (integerp arg) (> arg 0)) ((and (integerp arg) (> arg 0))
(%xoroshiro-integer arg state)) (%random-integer arg state))
(t (t
(error 'simple-type-error (error 'simple-type-error
:expected-type '(or (integer 1) (float (0.0))) :datum arg :expected-type '(or (integer 1) (float (0.0))) :datum arg
...@@ -428,8 +426,8 @@ ...@@ -428,8 +426,8 @@
:format-arguments (list arg))))) :format-arguments (list arg)))))
(defun xoroshiro-jump (rng-state) (defun xoroshiro-jump (rng-state)
(declare (type xoro-random-state rng-state)) (declare (type random-state rng-state))
(let ((state (xoro-random-state-state rng-state)) (let ((state (random-state-state rng-state))
(s0-0 0) (s0-0 0)
(s0-1 0) (s0-1 0)
(s1-0 0) (s1-0 0)
...@@ -451,7 +449,7 @@ ...@@ -451,7 +449,7 @@
(setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1)) (setf s1-1 (logxor s1-1 (ldb (byte 32 0) x1))
s1-0 (logxor s1-0 x0)))) s1-0 (logxor s1-0 x0))))
(format t "jump: ~D s0, s1 = ~X~8,'0X ~X~8,'0X~%" b s0-1 s0-0 s1-1 s1-0) (format t "jump: ~D s0, s1 = ~X~8,'0X ~X~8,'0X~%" b s0-1 s0-0 s1-1 s1-0)
(xoroshiro-next state))) (xoroshiro-gen state)))
(flet ((convert (x1 x0) (flet ((convert (x1 x0)
(declare (type (unsigned-byte 32) x1 x0)) (declare (type (unsigned-byte 32) x1 x0))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment