From af3c747de555cb94875fe33339dd3710b21613b7 Mon Sep 17 00:00:00 2001
From: Avril <flanchan@cumallover.me>
Date: Sun, 19 Apr 2020 06:25:36 +0100
Subject: [PATCH] added weighted

---
 cl-rng.asd   |  3 ++-
 cl-rng.lisp  | 60 ++++++++++++++++++----------------------------------
 urandom.lisp | 48 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 70 insertions(+), 41 deletions(-)
 create mode 100644 urandom.lisp

diff --git a/cl-rng.asd b/cl-rng.asd
index 3764a68..0d832f7 100644
--- a/cl-rng.asd
+++ b/cl-rng.asd
@@ -7,4 +7,5 @@
   :version "0.0.1"
   :serial t
   :components ((:file "package")
-               (:file "cl-rng")))
+               (:file "urandom")
+	       (:file "cl-rng")))
diff --git a/cl-rng.lisp b/cl-rng.lisp
index 7b063ae..ab766e4 100644
--- a/cl-rng.lisp
+++ b/cl-rng.lisp
@@ -1,48 +1,28 @@
-;;;; cl-rng.lisp
 
-(in-package #:cl-rng)
 
-(defun urandom (&key (limit 1.0) (precision 1) (transform nil))
-  (let ((transform (or transform (lambda (x) x))))
-    (with-open-file (rng "/dev/urandom" :element-type 'unsigned-byte)
-      (assert (> precision 0))
-      (if (= precision 1)
-	  (funcall transform (* limit (/ (read-byte rng) 255)))
-	  (let* ((val (apply '+ (loop for i from 0 below precision collect (read-byte rng))))
-		 (max (* precision 255))
-		 (frac (/ val max)))
-	    (values (* limit frac) frac))))))
+(in-package :cl-rng)
 
-(defun %urandom-vector (range &rest params)
-  (loop for x from 0 below (length range) collect
-       (setf (aref range x) (apply 'urandom params))))
+(defparameter *default-randomness-provider* #'urandom)
 
-(defun %urandom-list (range &rest params)
-  (setf (car range) (apply 'urandom params))
-  (when (not (null (cdr range)))
-    (cons (car range) (apply '%urandom-list (cons (cdr range) params)))))
+(defun chance (fraction &key (provider *default-randomness-provider*))
+  (< (funcall provider) fraction))
 
-(defun urandom-range (range &rest params)
-  (if (listp range)
-      (apply '%urandom-list (cons range params))
-      (apply '%urandom-vector (cons range params))))
-
-(export 'urandom)
-(export 'urandom-range)
-
-;(defparameter *dice-results* (make-list 10))
-
-
-;  (let ((num 0)
-;	(max 10000)
-;	(low 50))
-;    (format t "~%Searching ~a values for >= ~a...~%" max low)
-;    (loop for i from 0 below max do
-;	 (let ((value (apply '+ (urandom-range *dice-results* :limit 6 :transform (lambda (x) (1+ (floor x)))))))
-;	   (and (>= value low)
-;		(incf num)
-;		(format t " -> ~a: ~a~%" i value))))
-;    (format t "Found ~a / ~a (~,8f %)~%" num max (* 100 (/ num max))))
+(export '*default-randomness-provider*)
+(export 'chance)
 
+(defun weighted (weights &key (default nil) (provider *default-randomness-provider*))
+  (let ((previous 0)
+	(result (funcall provider))
+	(rval default))
+    (mapc (lambda (x)
+	    (let ((value (car x))
+		  (weight (cdr x)))
+	      (and (>= result previous)
+		   (<= result (+ previous weight))
+		   (setf rval value))
+	      (incf previous weight)))
+	  weights)
+    (values rval result)))
 
+(export 'weighted)
 
diff --git a/urandom.lisp b/urandom.lisp
new file mode 100644
index 0000000..1c23e0f
--- /dev/null
+++ b/urandom.lisp
@@ -0,0 +1,48 @@
+;;;; cl-rng.lisp
+
+(in-package #:cl-rng)
+
+(defun urandom (&key (limit 1.0) (precision 1) (transform nil))
+  (let ((transform (or transform #'identity)))
+    (with-open-file (rng "/dev/urandom" :element-type 'unsigned-byte)
+      (assert (> precision 0))
+      (if (= precision 1)
+	  (funcall transform (* limit (/ (read-byte rng) 255)))
+	  (let* ((val (apply '+ (loop for i from 0 below precision collect (read-byte rng))))
+		 (max (* precision 255))
+		 (frac (/ val max)))
+	    (values (* limit frac) frac))))))
+
+(defun %urandom-vector (range &rest params)
+  (loop for x from 0 below (length range) collect
+       (setf (aref range x) (apply 'urandom params))))
+
+(defun %urandom-list (range &rest params)
+  (setf (car range) (apply 'urandom params))
+  (unless (null (cdr range))
+    (cons (car range) (apply '%urandom-list (cons (cdr range) params)))))
+
+(defun urandom-range (range &rest params)
+  (if (listp range)
+      (apply '%urandom-list (cons range params))
+      (apply '%urandom-vector (cons range params))))
+
+(export 'urandom)
+(export 'urandom-range)
+
+;(defparameter *dice-results* (make-list 10))
+
+
+;  (let ((num 0)
+;	(max 10000)
+;	(low 50))
+;    (format t "~%Searching ~a values for >= ~a...~%" max low)
+;    (loop for i from 0 below max do
+;	 (let ((value (apply '+ (urandom-range *dice-results* :limit 6 :transform (lambda (x) (1+ (floor x)))))))
+;	   (and (>= value low)
+;		(incf num)
+;		(format t " -> ~a: ~a~%" i value))))
+;    (format t "Found ~a / ~a (~,8f %)~%" num max (* 100 (/ num max))))
+
+
+