--- a/DOCUMENTATION.markdown Thu Aug 18 17:47:33 2016 +0000
+++ b/DOCUMENTATION.markdown Sat Aug 20 13:25:22 2016 +0000
@@ -644,3 +644,36 @@
+## Package `LOSH.WEIGHTLISTS`
+
+A simple data structure for choosing random items with weighted probabilities.
+
+### `MAKE-WEIGHTLIST` (function)
+
+ (MAKE-WEIGHTLIST ITEMS WEIGHTS)
+
+Make a weightlist of the given items and weights.
+
+ Weights can be any `real` numbers. Weights of zero are fine, as long as at
+ least one of the weights is nonzero (otherwise there's nothing to choose).
+
+
+
+### `WEIGHTLIST`
+
+`#<STANDARD-CLASS DOCPARSER:STRUCT-NODE>`
+
+### `WEIGHTLIST-ITEMS` (function)
+
+ (WEIGHTLIST-ITEMS VALUE INSTANCE)
+
+### `WEIGHTLIST-RANDOM` (function)
+
+ (WEIGHTLIST-RANDOM WEIGHTLIST)
+
+Return a random item from the weightlist, taking the weights into account.
+
+### `WEIGHTLIST-WEIGHTS` (function)
+
+ (WEIGHTLIST-WEIGHTS VALUE INSTANCE)
+
--- a/losh.lisp Thu Aug 18 17:47:33 2016 +0000
+++ b/losh.lisp Sat Aug 20 13:25:22 2016 +0000
@@ -1100,6 +1100,32 @@
(format s "~A" str)))
+;;;; Weightlists
+(defstruct (weightlist (:constructor %make-weightlist))
+ weights sums items total)
+
+(defun make-weightlist (items weights)
+ "Make a weightlist of the given items and weights.
+
+ Weights can be any `real` numbers. Weights of zero are fine, as long as at
+ least one of the weights is nonzero (otherwise there's nothing to choose).
+
+ "
+ (%make-weightlist
+ :items items
+ :weights weights
+ :sums (prefix-sums weights)
+ :total (apply #'+ weights)))
+
+(defun weightlist-random (weightlist)
+ "Return a random item from the weightlist, taking the weights into account."
+ (iterate
+ (with n = (random (weightlist-total weightlist)))
+ (for item :in (weightlist-items weightlist))
+ (for weight :in (weightlist-sums weightlist))
+ (finding item :such-that (< n weight))))
+
+
;;;; Eldritch Horrors
(defmacro dlambda (&rest clauses)
;;; From Let Over Lambda.
--- a/make-docs.lisp Thu Aug 18 17:47:33 2016 +0000
+++ b/make-docs.lisp Sat Aug 20 13:25:22 2016 +0000
@@ -19,6 +19,7 @@
"LOSH.QUEUES"
"LOSH.RANDOM"
"LOSH.SYMBOLS"
+ "LOSH.WEIGHTLISTS"
))
--- a/package.lisp Thu Aug 18 17:47:33 2016 +0000
+++ b/package.lisp Sat Aug 20 13:25:22 2016 +0000
@@ -170,6 +170,16 @@
#:slurp
#:spit))
+(defsubpackage #:losh.weightlists
+ (:documentation
+ "A simple data structure for choosing random items with weighted probabilities.")
+ (:export
+ #:weightlist
+ #:weightlist-weights
+ #:weightlist-items
+ #:make-weightlist
+ #:weightlist-random))
+
(defsubpackage #:losh.eldritch-horrors
(:documentation "Abandon all hope, ye who enter here.")
(:export