# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1469300875 0
# Node ID 175fccc805fc4376173f677cf10efd5d78300f7d
# Parent  579c965d6ae5831bb1f19c5d6a1667a2e83b1518
Add the first random distribution algorithm

diff -r 579c965d6ae5 -r 175fccc805fc package.lisp
--- a/package.lisp	Sun Jul 17 21:37:55 2016 +0000
+++ b/package.lisp	Sat Jul 23 19:07:55 2016 +0000
@@ -36,6 +36,7 @@
     #:run-time
     #:since-start-into
     #:per-iteration-into
+    #:in-whatever
 
     #:queue
     #:queue-contents
diff -r 579c965d6ae5 -r 175fccc805fc src/random-numbers.lisp
--- a/src/random-numbers.lisp	Sun Jul 17 21:37:55 2016 +0000
+++ b/src/random-numbers.lisp	Sat Jul 23 19:07:55 2016 +0000
@@ -7,8 +7,8 @@
 
 (deftype positive-fixnum () `(integer 1 ,most-positive-fixnum))
 (deftype negative-fixnum () `(integer ,most-negative-fixnum -1))
-(deftype nonnegative-fixnum () `(integer 1 ,most-positive-fixnum))
-(deftype nonpositive-fixnum () `(integer ,most-negative-fixnum -1))
+(deftype nonnegative-fixnum () `(integer 0 ,most-positive-fixnum))
+(deftype nonpositive-fixnum () `(integer ,most-negative-fixnum 0))
 
 
 ;;;; Utils
@@ -26,6 +26,18 @@
 
 
 ;;;; Random Number Generators
+(defun make-linear-congruential-rng-java (modulus multiplier increment seed)
+  (declare (type nonnegative-fixnum seed)
+           (type positive-fixnum modulus multiplier increment))
+  (let ((val (mod (logxor seed multiplier)
+                  modulus)))
+    (dlambda
+      (:next ()
+       (ldb (byte 32 16) ; java's j.u.Random only gives out 32 high-order bits
+            (setf val (mod (+ (* val multiplier) increment)
+                           modulus))))
+      (:modulus () modulus))))
+
 (defun make-linear-congruential-rng (modulus multiplier increment seed)
   (declare (type nonnegative-fixnum seed)
            (type positive-fixnum modulus multiplier increment))
@@ -33,9 +45,8 @@
                   modulus)))
     (dlambda
       (:next ()
-       (ldb (byte 32 16)
-            (setf val (mod (+ (* val multiplier) increment)
-                           modulus))))
+       (setf val (mod (+ (* val multiplier) increment)
+                      modulus)))
       (:modulus () modulus))))
 
 
@@ -48,17 +59,6 @@
   (funcall generator :modulus))
 
 
-(define-compiler-macro make-linear-congruential-rng
-    (&whole form
-     modulus multiplier increment seed)
-  (if (and (constantp modulus)
-           (constantp multiplier)
-           (<= (* multiplier (1- modulus))
-               most-positive-fixnum))
-    `(make-linear-congruential-rng-fast% ,modulus ,multiplier ,increment ,seed)
-    form))
-
-
 (defparameter *generator*
   (make-linear-congruential-rng (expt 2 48)
                                 25214903917
@@ -110,7 +110,6 @@
   (+ min (las-vegas (- max min))))
 
 
-
 ;;;; Spectral Test
 (defun spectral ()
   (spit "data"
@@ -123,4 +122,34 @@
         (format t "~d ~d ~d~%" i j k)))))
 
 
+;;;; Distributions
+(defun prefix-sums (list)
+  (iterate
+    (for i :in list)
+    (sum i :into s)
+    (collect s :result-type vector)))
+
+(defun frequencies (seq &key (test 'eql))
+  (iterate
+    (with result = (make-hash-table :test test))
+    (for i :in-whatever seq)
+    (incf (gethash i result 0))
+    (finally (return result))))
+
+
+(defun random-weighted-list (weights n)
+  (iterate
+    (with sums = (prefix-sums weights))
+    (with max = (elt sums (1- (length sums))))
+    (repeat n)
+    (collect (iterate
+               (with r = (rand-range 0 max))
+               (for s :in-vector sums :with-index i)
+               (finding i :such-that (< r s))))))
+
+(defun random-weighted (weights)
+  (first (random-weighted-list weights 1)))
+
+
+;;;; Scratch
 ; (spectral)
diff -r 579c965d6ae5 -r 175fccc805fc src/utils.lisp
--- a/src/utils.lisp	Sun Jul 17 21:37:55 2016 +0000
+++ b/src/utils.lisp	Sat Jul 23 19:07:55 2016 +0000
@@ -184,3 +184,24 @@
         ,(when (and (null var) (null per))
            `(finally (return ,since)))))))
 
+(defmacro-driver (FOR var IN-WHATEVER seq)
+  "Iterate over items in the given sequence.
+
+  Unlike iterate's own `in-sequence` this won't use the horrifically inefficient
+  `elt`/`length` functions on a list.
+
+  "
+  (let ((kwd (if generate 'generate 'for)))
+    (with-gensyms (is-list source i len)
+      `(progn
+        (with ,source = ,seq)
+        (with ,is-list = (typep ,source 'list))
+        (with ,len = (if ,is-list -1 (length ,source)))
+        (for ,i :from 0)
+        (,kwd ,var next (if ,is-list
+                          (if ,source
+                            (pop ,source)
+                            (terminate))
+                          (if (< ,i ,len)
+                            (elt ,source ,i)
+                            (terminate))))))))