GitLab

at 2017-12-16T08:16:46-08:00

Simplify state

Don't need an array for the cached value; (unsigned-byte 32) is a
specialized structure slot, so no consing.

Some random cleanups and comments.

Add tests for xoroshiro generator

 	  make-xoro-random-state))

 (in-package "KERNEL")

-(export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-random-state))

+(export '(%xorohiro-single-float %xorohiro-double-float xoroshiro-chunk init-xoro-state))

 (sys:register-lisp-feature :random-xoroshiro)

 (defstruct (xoro-random-state

 	     (:constructor make-xoroshiro-object)

 	     (:make-load-form-fun :just-dump-it-normally))

+  ;; The state of the RNG.  The actual algorithm uses 2 64-bit words

+  ;; of state.  To reduce consing, we use an array of double-float's

+  ;; 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

+  ;; state we need.

   (state (init-xoro-state)

    :type (simple-array double-float (2)))

-  (rand (make-array 1 :element-type '(unsigned-byte 32) :initial-element 0)

-   :type (simple-array (unsigned-byte 32) (1)))

+  ;; The generator produces 64-bit results.  We separate the 64-bit

+  ;; result into two parts.  One is returned and the other is cached

+  ;; here for later use.

+  (rand 0 :type (unsigned-byte 32))

+  ;; Indicates if RAND holds a valid value.  If NIL, we need to

+  ;; generate a new 64-bit result.

   (cached-p nil :type (member t nil)))

 (defvar *xoro-random-state*)

   (flet ((copy-random-state (state)

 	   (let ((old-state (xoro-random-state-state state))

 		 (new-state

-		  (make-array 2 :element-type 'double-float))

-		 (new-rand (make-array 1 :element-type '(unsigned-byte 32))))

+		  (make-array 2 :element-type 'double-float)))

 	     (setf (aref new-state 0) (aref old-state 0))

 	     (setf (aref new-state 1) (aref old-state 1))

-	     (setf (aref new-rand 0) (aref (xoro-random-state-rand state) 0))

 	     (make-xoroshiro-object :state new-state

-				    :rand new-rand

+				    :rand (xoro-random-state-rand state)

 				    :cached-p (xoro-random-state-cached-p state)))))

     (cond ((not state)

 	   (copy-random-state *xoro-random-state*))

 	   (copy-random-state state))

 	  ((eq state t)

 	   (make-xoroshiro-object :state (init-xoro-state (generate-seed 4))

-				  :rand (make-array 1 :element-type '(unsigned-byte 32) :initial-element 0)

+				  :rand 0

 				  :cached-p nil))

 	  (t

 	   (error "Argument is not a RANDOM-STATE, T, or NIL: ~S" state)))))

   (let ((cached (xoro-random-state-cached-p rng-state)))

     (cond (cached

 	   (setf (xoro-random-state-cached-p rng-state) nil)

-	   (aref (xoro-random-state-rand rng-state) 0))

+	   (xoro-random-state-rand rng-state))

 	  (t

 	   (let ((s (xoro-random-state-state rng-state)))

 	     (declare (type (simple-array double-float (2)) s))

 	     (multiple-value-bind (r1 r0)

 		 (vm::xoroshiro-next s)

-	       (setf (aref (xoro-random-state-rand rng-state) 0) r1)

+	       (setf (xoro-random-state-rand rng-state) r0)

 	       (setf (xoro-random-state-cached-p rng-state) t)

-	       r0))))))

+	       r1))))))

 #-x86

 (defun xoroshiro-next (state)

 	1d0)))

 #+double-double

-(defun %random-double-double-float (arg state)

+(defun %xoroshiro-double-double-float (arg state)

   (declare (type (double-double-float (0w0)) arg)

 	   (type xoro-random-state state))

   ;; Generate a 31-bit integer, scale it and sum them up

+;; Tests for RNG

+

+(defpackage :rng-tests

+  (:use :cl :lisp-unit))

+

+(in-package "RNG-TESTS")

+

+(defun 64-bit-rng-state (rng)

+  (let ((state (kernel::xoro-random-state-state rng)))

+    (flet ((convert (x)

+	     (multiple-value-bind (hi lo)

+		 (kernel:double-float-bits x)

+	       (logior (ash (ldb (byte 32 0) hi) 32)

+		       lo))))

+      (values (convert (aref state 0)) (convert (aref state 1))))))

+

+(defun 64-bit-value (rng)

+  (logior (ash (kernel::xoroshiro-chunk rng) 32)

+	  (kernel::xoroshiro-chunk rng)))

+

+(defvar *test-state*)

+  

+(define-test rng.initial-state

+  (setf *test-state*

+	(kernel::make-xoroshiro-object :state (kernel::init-xoro-state #x12345678)

+				       :rand 0

+				       :cached-p nil))

+  (multiple-value-bind (s0 s1)

+      (64-bit-rng-state *test-state*)

+    (assert-equal #x38f1dc39d1906b6f s0)

+    (assert-equal #xdfe4142236dd9517 s1)

+    (assert-equal 0 (kernel::xoro-random-state-rand *test-state*))

+    (assert-equal nil (kernel::xoro-random-state-cached-p *test-state*))))

+

+

+(define-test rng.values-test

+  (assert-equal (list #x38f1dc39d1906b6f #xdfe4142236dd9517)

+		(multiple-value-list (64-bit-rng-state *test-state*)))

+  (assert-equal 0 (kernel::xoro-random-state-rand *test-state*))

+  (assert-equal nil (kernel::xoro-random-state-cached-p *test-state*))

+

+  (dolist (item '((#x18d5f05c086e0086 (#x228f4926843b364d #x74dfe78e715c81be))

+		  (#x976f30b4f597b80b (#x5b6bd4558bd96a68 #x567b7f35650aea8f))

+		  (#xb1e7538af0e454f7 (#x13e5253e242fac52 #xed380e70d10ab60e))

+		  (#x011d33aef53a6260 (#x9d0764952ca00d8a #x5251a5cfedd2b4ef))

+		  (#xef590a651a72c279 (#xba4ef2b425bda963 #x172b965cf56c15ac))

+		  (#xd17a89111b29bf0f (#x458277a5e5f0a21b #xd1bccfad6564e8d))

+		  (#x529e44a0bc46f0a8 (#x2becb68d5a7194c7 #x3a6ec964899bb5f3))

+		  (#x665b7ff1e40d4aba (#xededfd481d0a19fe #x3ea213411827fe9d))

+		  (#x2c9010893532189b (#xd7bb59bcd8fba26f #x52de763d34fee090))

+		  (#x2a99cffa0dfa82ff (#xf96e892c62d6ff2e #xc0542ff85652f81e))))

+    (destructuring-bind (value state)

+	item

+      (assert-equal value (64-bit-value *test-state*))

+      (assert-equal state (multiple-value-list (64-bit-rng-state *test-state*))))))

Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl

Commits:

2 changed files:

Changes: