Commits

Paul Sexton  committed 4a98414

Filled in error messages, expanded documentation.

  • Participants
  • Parent commits b093518

Comments (0)

Files changed (2)

 PTables
 =======
 
-Probability tables ("ptables") emulate (and surpass in functionality) the
-"levelled lists" that are used to randomly generate loot and encounters in the
-Elder Scrolls games.
+When writing games, we often want the ability to randomly choose an item or
+value from a set of possible items. We often want to associate each possible
+item with a probability, so that some items will occur commonly and others will
+be rare. We often want some parts of the game to be more dangerous and
+rewarding than others, and we want some items to become more common and others
+to become more rare as this danger level increases.
 
-Each entry in a probability table or ptable associates a value with a numerical
-rarity (higher is more rare). Each value can be a lisp object or a link to
-another ptable, allowing nested ptables.
+We would like for sets to be able to nest -- for example, one of the items in
+the set "contents of a treasure chest" might be the set "expensive jewelry",
+which in turn might contain rings, bracelets and so forth.
+
+Finally, it would be convenient, when declaring new classes of game items,
+monsters and so on, to be able to declare their membership in a particular
+random set, rather than have to place them into that set manually.
+
+Probability tables ("ptables") provide all of the functionality described
+above. Each ptable contains a number of entries. Each entry contains some lisp
+value, associated with a rarity, and optionally with information about how the
+rarity changes as the game "level" changes.
+
+Ptables were originally inspired by the "levelled lists" used in the Elder
+Scrolls games.
 
 ## Defining ptables
 
 up piecewise. A "ptabled-class" metaclass is also provided which allows classes
 to insert entries for themselves into ptables.
 
+(define-ptable
+
 ## Rarity
 
-The Advanced Dungeons and Dragons Monster Manuals gave each monster a
-frequency that indicated how often it should be encountered.
+Each entry in a ptable has a positive integer that represents its rarity. The
+lower the number, the more common the item, with 1 being maximally common.
 
-AD&D Frequency    Probability   PTable rarity
-Common            0.42          1.0
-Uncommon          0.27          1.5
-Rare              0.22          1.9
-Very rare         0.09          4.4
+The probability of an item being selected from its ptable is equal to its
+frequency (1/rarity) divided by the sum of the frequencies of all the table's
+entries.
 
-It can be appreciated that "very rare" monsters were not terribly rare -- a
-dice roll would generate a very rare monster 9% of the time.
+For example, here is a table containing 5 monsters. Rats are very common
+(rarity 1). Dragons are very rare (rarity 25). The other monsters have rarities
+between these extremes.
+
+Monster  Rarity  Frequency  Probability
+                 1/rarity   freq/1.89*100
+rat      1       1.00        53%
+goblin   2       0.50        27%
+orc      4       0.25        13%
+spectre  10      0.10         5%
+dragon   25      0.04         2%
+                 ----       ----
+                 1.89       100%
+
+When randomly choosing a monster from the table, a rat will be chosen 53% of
+the time, a goblin 27% of the time, and so on.
 
 The levelled lists used in the Elder Scrolls games do not specify probabilities
 or rarities for their contents. The only fact that is specified for each item
 ## Levels and ptables
 
 Each entry can also contain information about how its rarity should vary as a
-"level" parameter increases. This information includes a minimum level below
-which the value will not appear at all, and level values where the item should
-be maximally common.
+"level" parameter increases. This information includes:
+* a minimum level below which the value will never appear
+* a series of 1 or more peak levels. When these are present, the entry's rarity
+will be scaled so that it is equal to the given rarity when the level is equal
+to one of the peaks, and becomes more rare as the level moves away from a peak.
    #:ptable-replace-entry
    #:ptable-contents
    #:ptabled-class
-   #:ptabled-class?
-   #:all-ptable-entries))
+   #:ptabled-class?))
 
 (in-package :ptable)
 
 
 (defmacro define-ptable (sym &body body)
   "* Arguments
-- BODY :: consists of the forms (PTABLE-ENTRY) (PTABLE-ENTRY) ....
 - SYM :: names a new or existing ptable (if it does not exist it is
 created.) Each of the following PTABLE-ENTRIES is then added to the
 entries for the new ptable.
+- BODY :: consists of the forms (PTABLE-ENTRY) (PTABLE-ENTRY) ....
+
+PTABLE-ENTRY := ITEM ENTRY-ARGS...
+                | ITEM RARITY ENTRY-ARGS...
 
 * Returns:
 Two values:
     (let ((tbl (symbol->ptable sym :make? t)))
       (iterate
         (for (item . body) in entries)
+        (when (or (numberp (car body))
+                  (assoc (car body) *ptable-rarities*))
+          (push :rarity body))
         (ptable-replace-entry tbl (append (list :item item) body)))
       (values sym tbl))))
 
                   entries))))
 
 
-(defun symbol->ptable (sym &key (error? nil) (make? nil))
+(defun* (symbol->ptable -> (or null ptable)) ((sym symbol)
+                                              &key (error? nil)
+                                                   (make? nil))
   (typecase sym
-    (null (error ""))
+    (null (error "There is no ptable named NIL"))
     (symbol (or (gethash sym *ptables*)
                 (cond
                   (make? (make-instance 'ptable :name sym))
   (ptable-replace-entry tbl (list-to-entry entry)))
 
 
-(defun list-to-entry (entry)
+(defun* (list-to-entry -> ptable-entry) ((entry list))
   (cond
     ((atom entry)
      (error "Cannot make ptable-entry out of value `~S'" entry))
 
 
 
-(defun probabilities-at-level (entries level
-                               &key cumulative? flat?
-                                    sort?)
+(define-memo-function probabilities-at-level (entries level
+                                                      &key cumulative? flat?
+                                                      sort?)
+  "ENTRIES is a list of `ptable-entry' instances, usually taken from the
+ptable-entries slot of a `ptable' instance.
+
+Returns an alist of the form ((P . ENTRY)*), where P is the probability of
+choosing the associated entry. Any duplicate entries will be combined.
+
+If LEVEL is supplied, then any entries that contain level-related information
+such as a minimum level or peaks, will have their probabilities adjusted to take
+the supplied level into account.
+
+If CUMULATIVE? is non-nil, the probabilities will be cumulative, i.e. each will
+have the preceding probabilities added to it, and the final probability will
+always be 1.
+
+If FLAT? is non-nil, any entries that refer to ptables will be expanded in
+place, i.e., replaced by the results of calling this function for that ptable,
+with the probabilities adjusted so they add up to whatever the probability for
+the original ptable entry would have been.
+"
   (cond
     ((null entries)
      nil)
      (let ((entries (mapcar (lambda (e) (cons (rarity-at-level e level) e))
                             entries)))
        (setf entries (remove nil entries :key #'car))
-       (let ((highest-rarity (apply #'max (mapcar #'car entries))))
-         ;; Convert rarities into frequencies.
-         (setf entries (mapcar (d-lambda (rarity . item)
-                                 (cons (/ highest-rarity rarity)
-                                       item))
-                               entries))
-         ;; Turn frequencies into probabilities (0-1). The sum of all the
-         ;; probabilities in the ptable is guaranteed to be 1.
-         (setq entries
-               (iterate
-                 (with freq-sum = (coerce (apply #'+ (mapcar #'car entries))
-                                          'double-float))
-                 (for (freq . entry) in entries)
-                 (cond
-                   ((and flat?
-                         (symbol->ptable (pentry-item entry)))
-                    ;; This entry refers to another ptable. The `flat?' option
-                    ;; is set, so expand the ptable inline. Multiply each
-                    ;; probability in the inline table by the probability for
-                    ;; the current entry.
-                    (appending (mapcar (d-lambda (p . e)
-                                         (cons (* p (/ freq freq-sum)) e))
-                                       (probabilities-at-level
-                                        (ptable-entries (symbol->ptable
-                                                         (pentry-item entry)))
-                                        level :cumulative? nil :flat? t))))
-                   (t
-                    (collect (cons (/ freq freq-sum)
-                                   entry))))))
-         ;; If duplicate entries exist, combine their probabilities together.
-         (setq entries
-               (iterate
-                 (with new-entries = nil)
-                 (for (prob . entry) in entries)
-                 (if-let (pos (position-if (lambda (e)
-                                             (pentries-equal? e entry))
-                                           new-entries :key #'cdr))
-                         (incf (car (nth pos new-entries)) prob)
-                         ;; else
-                         (push (cons prob entry) new-entries))
-                 (finally
-                  (return new-entries))))
-         (if sort?
-             (setq entries (sort entries #'> :key #'car)))
-         (cond
-           (cumulative?
-            (iterate
-              (with cum-prob = 0d0)
-              (for (prob . entry) in entries)
-              (incf cum-prob prob)
-              (collect (cons cum-prob entry))))
-           (t
-            entries)))))))
+       ;; Convert rarities into relative frequencies.
+       (setf entries (mapcar (d-lambda (rarity . item)
+                               (cons (/ 1.0 rarity)
+                                     item))
+                             entries))
+       ;; Turn frequencies into probabilities (0-1). The sum of all the
+       ;; probabilities in the ptable is guaranteed to be 1.
+       (setq entries
+             (iterate
+               (with freq-sum = (coerce (apply #'+ (mapcar #'car entries))
+                                        'double-float))
+               (for (freq . entry) in entries)
+               (cond
+                 ((and flat?
+                       (symbol->ptable (pentry-item entry)))
+                  ;; This entry refers to another ptable. The `flat?' option
+                  ;; is set, so expand the ptable inline. Multiply each
+                  ;; probability in the inline table by the probability for
+                  ;; the current entry.
+                  (appending (mapcar (d-lambda (p . e)
+                                       (cons (* p (/ freq freq-sum)) e))
+                                     (probabilities-at-level
+                                      (ptable-entries (symbol->ptable
+                                                       (pentry-item entry)))
+                                      level :cumulative? nil :flat? t))))
+                 (t
+                  (collect (cons (/ freq freq-sum)
+                                 entry))))))
+       ;; If duplicate entries exist, combine their probabilities together.
+       (setq entries
+             (iterate
+               (with new-entries = nil)
+               (for (prob . entry) in entries)
+               (if-let (pos (position-if (lambda (e)
+                                           (pentries-equal? e entry))
+                                         new-entries :key #'cdr))
+                       (incf (car (nth pos new-entries)) prob)
+                       ;; else
+                       (push (cons prob entry) new-entries))
+               (finally
+                (return new-entries))))
+       (if sort?
+           (setq entries (sort entries #'> :key #'car)))
+       (cond
+         (cumulative?
+          (iterate
+            (with cum-prob = 0d0)
+            (for (prob . entry) in entries)
+            (incf cum-prob prob)
+            (collect (cons cum-prob entry))))
+         (t
+          entries))))))
 
 
 (defmethod ptable-probabilities ((tbl ptable) &key level cumulative? flat?
   (let ((probs (ptable-probabilities tbl :level level :cumulative? t)))
     (cond
       ((null probs)
-       (error "choosing from empty ptable ~S" tbl))
+       (error "Choosing from empty ptable ~S" tbl))
       (t
        (iterate
          (with p = (random 1.0d0))
                      (return (values item (pentry-choose-count
                                            (pentry-count entry)))))))
          (finally
-          (error "")))))))
+          (error "Probabilities of ptable ~S add up to < 1 " tbl)))))))
 
 
 (defun pentry-choose-count (cnt)
     (list (rand-between (nth 0 cnt) (nth 1 cnt)))
     (symbol (if (fboundp cnt)
                 (funcall cnt)
-                (error "")))
-    (otherwise (error ""))))
+                (error "~S is not a valid pentry-count value" cnt)))
+    (otherwise (error "~S is not a valid pentry-count value" cnt))))
 
 
 
   ((ptable-entries :initform nil :initarg :ptable-entries
                    :accessor ptable-entries
                    :documentation "List of PTABLE-ENTRIES. Each PTABLE-ENTRY
-is a list of the form (PTABLE-SYM FREQ [(CLAUSE) (CLAUSE)...]).
+is a list of the form (PTABLE-SYM RARITY [other ptable-entry args...]).
 In fact this list will always be embedded inside a further list, because
 of the way class options are stored.")))
 
+
 (defmethod validate-superclass ((class ptabled-class)
                                 (superclass standard-class))
   t)
 (defmethod initialize-instance :after ((tc ptabled-class)
                                        &key
                                        &allow-other-keys)
-  ;; Get rid of the list surrounding the slot's contents.
   (iterate
-    (for (ptable-sym . entry-body) in (all-ptable-entries tc))
+    (for (ptable-sym . entry-body) in (ptable-entries tc :inherited? t))
     (when ptable-sym
-      (format *error-output* "~&ptable ~S += ~S~%"
-              ptable-sym (class-name tc))
+      (when (or (numberp (car entry-body))
+                (assoc (car entry-body) *ptable-rarities*))
+        (push :rarity entry-body))
+      ;; (format *error-output* "~&ptable ~S += ~S~%"
+      ;;         ptable-sym (class-name tc))
       (ptable-replace-entry (symbol->ptable ptable-sym :make? t)
                             (apply #'make-instance 'ptable-entry
                                    :item (class-name tc)
                                    entry-body)))))
 
 
-(defun ptabled-class? (c)
+(defun* (ptabled-class? -> boolean) (c)
   (typep c 'ptabled-class))
 
 
-(defgeneric ptable-entries (c)
-  (:method ((c ptabled-class))
-    (let ((entries (slot-value c 'ptable-entries)))
-      ;; If the value is of the form ((ENTRY ENTRY ...)) rather
-      ;; than (ENTRY ENTRY ...), remove the outer parentheses
-      (if (and entries
-               (listp entries)
-               (= 1 (length entries))
-               (listp (first entries))
-               (first (first entries))
-               (listp (first (first entries))))
-          (first entries)
-          entries)))
-  (:method ((c null)) (error "Asked for ptable-entries of NIL"))
-  (:method ((tbl ptable)) (slot-value tbl 'ptable-entries))
-  (:method ((kwd symbol)) (if (symbol->ptable kwd)
-                              (ptable-entries (symbol->ptable kwd)))))
+(defgeneric ptable-entries (c &key &allow-other-keys)
+  (:method ((pclass ptabled-class) &key (inherited? nil))
+    (cond
+      ((not inherited?)
+       (let ((entries (slot-value pclass 'ptable-entries)))
+         ;; If the value is of the form ((ENTRY ENTRY ...)) rather
+         ;; than (ENTRY ENTRY ...), remove the outer parentheses
+         (if (and entries
+                  (listp entries)
+                  (= 1 (length entries))
+                  (listp (first entries))
+                  (first (first entries))
+                  (listp (first (first entries))))
+             (first entries)
+             entries)))
+      (t
+       (ensure-finalized pclass)
+       (iterate
+         (with entries = nil)
+         (for c in (class-precedence-list pclass))
+         (when (ptabled-class? c)
+           (iterate
+             (for entry in (ptable-entries c))
+             ;; Only inherit entry if not overridden by a subclass
+             (unless (assoc (car entry) entries)
+               (push entry entries))))
+         (finally
+          (return entries))))))
+  (:method ((p standard-class) &key)
+    (error "ptable-entries: class ~S is not of type ~S"
+           p (find-class 'ptabled-class)))
+  (:method ((c null) &key) (error "Asked for ptable-entries of NIL"))
+  (:method ((tbl ptable) &key) (slot-value tbl 'ptable-entries))
+  (:method ((p standard-object) &key) (ptable-entries (class-of p)))
+  (:method ((sym symbol) &key)
+    (cond
+      ((symbol->ptable sym)
+       (ptable-entries (symbol->ptable sym)))
+      ((find-class sym nil)
+       (ptable-entries (find-class sym nil)))
+      (t
+       (error "Don't know how to get ptable-entries of `~S'" sym)))))
 
 
 (defmethod (setf ptable-entries) (value (tbl ptable))
   (setf (slot-value tbl 'ptable-entries) value))
 
 
-(defgeneric* all-ptable-entries (x)
-  (:method ((p standard-object)) (all-ptable-entries (class-of p)))
-  (:method ((p standard-class))
-    (error "all-ptable-entries: class ~S is not of type ~S"
-           p (find-class 'ptabled-class)))
-  (:method ((p symbol))
-    (typecase p
-      (null (error "Illegal ptabled class: NIL"))
-      (otherwise (all-ptable-entries (find-class p t)))))
-  (:method ((pclass ptabled-class))
-    (ensure-finalized pclass)
-    (iterate
-      (with entries = nil)
-      (for c in (class-precedence-list pclass))
-      (when (ptabled-class? c)
-        (iterate
-          (for entry in (ptable-entries c))
-          ;; Only inherit entry if not overridden by a subclass
-          (unless (assoc (car entry) entries)
-            (push entry entries))))
-      (finally
-       (return entries)))))
-
 
 (defparameter animals
   (make-instance 'ptable
                           (:item :badger :count 1 :rarity :common))))
 
 (define-ptable :tbl-plants
-  (:apple :rarity 3 :min-level 2)
+  (:apple 3 :min-level 2)
   (:pear :rarity 4 :min-level 4)
   (:carrot :rarity :common)
   (:tbl-trees :rarity 2)
   (:ptable-entries ((:tbl-furniture :rarity :common)))
   (:metaclass ptabled-class))
 
+(defclass table (furniture)
+  ((name :initform "table"))
+  (:ptable-entries ((:tbl-furniture :uncommon)))
+  (:metaclass ptabled-class))
+
 
 
 ;;;; ptable.lisp ends here  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;