[Git][cmucl/cmucl][rtoy-xoro] 2 commits: Simplify state
Raymond Toy
rtoy at common-lisp.net
Sat Dec 16 16:17:40 UTC 2017
Raymond Toy pushed to branch rtoy-xoro at cmucl / cmucl
Commits:
192fe3b6 by Raymond Toy 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.
- - - - -
c62e3467 by Raymond Toy at 2017-12-16T08:17:24-08:00
Add tests for xoroshiro generator
- - - - -
2 changed files:
- src/code/rand-xoroshiro.lisp
- + tests/rng.lisp
Changes:
=====================================
src/code/rand-xoroshiro.lisp
=====================================
--- a/src/code/rand-xoroshiro.lisp
+++ b/src/code/rand-xoroshiro.lisp
@@ -18,7 +18,7 @@
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)
@@ -80,10 +80,19 @@
(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*)
@@ -92,13 +101,11 @@
(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*))
@@ -106,7 +113,7 @@
(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)))))
@@ -130,15 +137,15 @@
(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)
@@ -267,7 +274,7 @@
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/rng.lisp
=====================================
--- /dev/null
+++ b/tests/rng.lisp
@@ -0,0 +1,55 @@
+;; 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*))))))
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/eea11e0772aee7480a290045684c02b827f8dd50...c62e34677442429bf337d1a0c09275e29c97cad7
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/eea11e0772aee7480a290045684c02b827f8dd50...c62e34677442429bf337d1a0c09275e29c97cad7
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20171216/2a5affe7/attachment-0001.html>
More information about the cmucl-cvs
mailing list