Poke at the LCG a bit more
author |
Steve Losh <steve@stevelosh.com> |
date |
Sun, 17 Jul 2016 21:37:55 +0000 |
parents |
644e7f766db4
|
children |
175fccc805fc
|
branches/tags |
(none) |
files |
.lispwords package.lisp src/random-numbers.lisp src/utils.lisp |
Changes
--- a/.lispwords Sun Jul 17 21:37:44 2016 +0000
+++ b/.lispwords Sun Jul 17 21:37:55 2016 +0000
@@ -0,0 +1,1 @@
+(1 spit)
--- a/package.lisp Sun Jul 17 21:37:44 2016 +0000
+++ b/package.lisp Sun Jul 17 21:37:55 2016 +0000
@@ -13,6 +13,10 @@
#:recursively
#:recur
#:dis
+ #:bits
+ #:spit
+
+ #:dlambda
#:hash-set
#:make-set
--- a/src/random-numbers.lisp Sun Jul 17 21:37:44 2016 +0000
+++ b/src/random-numbers.lisp Sun Jul 17 21:37:55 2016 +0000
@@ -2,7 +2,8 @@
;;;; Types, etc
-(declaim (optimize (speed 1) (safety 1) (debug 3)))
+; (declaim (optimize (speed 1) (safety 1) (debug 3)))
+; (declaim (optimize (speed 3) (safety 0) (debug 0)))
(deftype positive-fixnum () `(integer 1 ,most-positive-fixnum))
(deftype negative-fixnum () `(integer ,most-negative-fixnum -1))
@@ -11,7 +12,14 @@
;;;; Utils
-(defun +mod (x y m)
+(declaim (ftype (function (nonnegative-fixnum
+ nonnegative-fixnum
+ nonnegative-fixnum)
+ nonnegative-fixnum)
+ mod+)
+ (inline mod+))
+
+(defun mod+ (x y m)
(if (<= x (- m 1 y))
(+ x y)
(- x (- m y))))
@@ -19,23 +27,16 @@
;;;; Random Number Generators
(defun make-linear-congruential-rng (modulus multiplier increment seed)
- (let ((val seed))
- (lambda (msg)
- (ecase msg
- (:next (setf val (mod (+ (* multiplier val)
- increment)
- modulus)))
- (:modulus modulus)))))
-
-(defun make-linear-congruential-rng-fast% (modulus multiplier increment seed)
- (declare (optimize (speed 3) (safety 0) (debug 0)))
- (let ((val seed))
- (lambda (msg)
- (ecase msg
- (:next (setf val (mod (+ (the nonnegative-fixnum (* multiplier val))
- increment)
- modulus)))
- (:modulus modulus)))))
+ (declare (type nonnegative-fixnum seed)
+ (type positive-fixnum modulus multiplier increment))
+ (let ((val (mod (logxor seed multiplier)
+ modulus)))
+ (dlambda
+ (:next ()
+ (ldb (byte 32 16)
+ (setf val (mod (+ (* val multiplier) increment)
+ modulus))))
+ (:modulus () modulus))))
(declaim (inline rng-next rng-modulus))
@@ -58,7 +59,11 @@
form))
-(defparameter *generator* (make-linear-congruential-rng 601 15 4 354))
+(defparameter *generator*
+ (make-linear-congruential-rng (expt 2 48)
+ 25214903917
+ 11
+ 0))
(defun rand ()
@@ -103,3 +108,19 @@
(defun rand-range (min max)
(+ min (las-vegas (- max min))))
+
+
+
+;;;; Spectral Test
+(defun spectral ()
+ (spit "data"
+ (iterate
+ (repeat 1000)
+ (for i = (rand))
+ (for j :previous i)
+ (for k :previous j)
+ (when k
+ (format t "~d ~d ~d~%" i j k)))))
+
+
+; (spectral)
--- a/src/utils.lisp Sun Jul 17 21:37:44 2016 +0000
+++ b/src/utils.lisp Sun Jul 17 21:37:55 2016 +0000
@@ -56,12 +56,35 @@
doing what you think it should be doing.
"
- `(->> '(lambda* ,arglist
+ `(->> '(lambda ,arglist
(declare (optimize speed))
,@body)
- macroexpand-1
(compile nil)
- disassemble))
+ #+sbcl sb-disassem:disassemble-code-component
+ #-sbcl disassemble))
+
+(defun bits (n size)
+ ;; http://blog.chaitanyagupta.com/2013/10/print-bit-representation-of-signed.html
+ (format t (format nil "~~~D,'0B" size) (ldb (byte size 0) n))
+ (values))
+
+(defmacro spit (filename &body body)
+ `(with-open-file (*standard-output* ,filename
+ :direction :output
+ :if-exists :supersede)
+ ,@body))
+
+
+;;;; dlambda
+(defmacro dlambda (&rest clauses)
+ (with-gensyms (message arguments)
+ (flet ((parse-clause (clause)
+ (destructuring-bind (key arglist &rest body)
+ clause
+ `(,key (apply (lambda ,arglist ,@body) ,arguments)))))
+ `(lambda (,message &rest ,arguments)
+ (ecase ,message
+ ,@(mapcar #'parse-clause clauses))))))
;;;; Sets
@@ -123,7 +146,9 @@
(defmethod print-object ((set hash-set) stream)
(print-unreadable-object (set stream :type t)
(format stream "~{~S~^ ~}"
- (hash-keys (slot-value set 'data)))))
+ (iterate
+ (for (key) :in-hashtable (slot-value set 'data))
+ (collect key)))))
;;;; Iterate