emacs-rpgdm/docs/rpgdm-tables-freq.org

Frequency Tables for Games

• Introduction
• Parsing a Frequency Table
• Frequencies as Weights
• Choosing an Item
• Match Table with Tag Group
• Validating my Assumptions

;;; rpgdm-tables-freq.el --- Rolling dice for choosing items from Tables -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2021 Howard X. Abrams
;;
;; Author: Howard X. Abrams <http://gitlab.com/howardabrams>
;; Maintainer: Howard X. Abrams <howard.abrams@gmail.com>
;; Created: February  5, 2021
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;     This file contains the source code, but the concept behind what I'm
;;     calling random frequency tables is a bit complex, so I recommend looking
;;     at the original file in `docs/rpgdm-tables-freq.org'.

Introduction

While the majority of my tables are simple lists to choose a random element, some lists should return some elements more often than other elements. While that sounds great in a sentence, I need to actually code what I mean. I call them frequency tables and they look something like my Faction Encounter table:

Church of Talos :: Worshipers of the god of storms and destruction.	scarcely
City Watch :: Members of the Waterdeep constabulary.	often
Cult of the Dragon :: Cultists who venerate evil dragons.	seldom
Emerald Enclave :: Alliance of druids and rangers sworn to defend the wilds from evil.	seldom
Enclave of Red Magic :: Thayan mages who often smuggle slaves into Skullport.	sometimes
Force Grey :: League of heroes sworn to protect Waterdeep.	often
Halaster’s Heirs :: Dark arcanists trained at a hidden academy within Undermountain	rarely
The Kraken Society :: Shadowy group of thieves and mages who serve a kraken master.	rarely

While I have over 50 factions running around my Waterdeep campaign, I would assume my players would run into the City Watch more often than the delusional members of the Kraken Society.

While I am using the following code, I would like to explain it better, so until that happens, I'm not really advertising this page.

Parsing a Frequency Table

Unlike a normal list, we should have two columns, where the first is the item and the second determines the frequency. My rpgdm-tables--line-parse regular expression is already available to parse, and return two groups, so we can create a predicate:

(defun rpgdm-tables-freq-table? ()
  "Return non-nil if current buffer contains a frequency table"
  (goto-char (point-min))
  (re-search-forward rpgdm-tables--line-parse nil nil)
  (match-string 2))

You'll notice that this predicate is not a pure function, as it scans the current buffer, leaving the initial match in the hopper, so the parsing function called next, can make an assumption, and to immediately grab that match-string and then parse the rest of the buffer.

The rpgdm-tables--parse-as-freq-table will return a hash-table where the keys are the frequency labels, like often or common, and the values will be the list of items of that frequency.

First, grab the previously matched entry and store them, and then with each successive match, append them (via cons) to whatever list is already there.

(defun rpgdm-tables--parse-as-freq-table ()
  "Return hashtable of lines matching `rpgdm-tables--line-parse'.
The keys in the hashtable are the tags from the file, and the
values will be a list of matching entries of that tag.

For instance, the file:
  - salt :common:
  - silver :rare:
  - gold :rare:
  - pepper :common:

Would return a hashtable containing:

  rare: [gold silver]
  common [salt peper]"
  ;; Create a hash, populated it, and return it:
  (let ((results (make-hash-table :test 'equal))
        (entry (match-string-no-properties 1))
        (tag (match-string-no-properties 2)))
    ;; Store initial match from parent call:
    (puthash tag (list entry) results)

    (while (re-search-forward rpgdm-tables--line-parse nil t)
      (let* ((entry (match-string-no-properties 1))
             (tag (match-string-no-properties 2))
             (prev-list (gethash tag results)))
        (puthash tag (cons entry prev-list) results)))

    ;; Combine the sublists of equivalent tags:
    (rpgdm-tables--merge-frequencies results)))

The previous function needs to massage the hash table a wee bit. I feel that I might write the frequency label, scarce one time, and scarcely another time. Why not allow this, but then merge them:

(defun rpgdm-tables--merge-frequencies (table)
  "Combine the values of equivalent table-tags in TABLE.
A table, read as a hash table, may have similar, but equal tags.
For instance, `veryrare' and `very-rare' are the same."
  (let* ((table-tags (rpgdm-tables--which-tag-group table))
         (tags (-map 'rest table-tags)))  ; Ignore all the numbers
    (dolist (subtag-list tags)
      (unless (= 1 (length subtag-list))
        (let ((keeper (first subtag-list)))
          (dolist (tag (rest subtag-list))
            (puthash keeper (append (gethash keeper table)
                                    (gethash tag table)) table)
            (remhash tag table)))))
    table))

Frequencies as Weights

However, choosing an element in a hash of tags seems … challenging. This is because I want the tags to somehow add a particular weight to the randomness. Not a complete standard distribution (bell curve), but a little more favor to some items. For instance, labeling something common should show more often than uncommon.

Choosing an item from a hash table is a complicated algorithm that may not be as obvious by reading the code, so let's describe this with an example. Assume we have the following frequency table with a relative weight for each tag:

• often : 4
• seldom : 3
• scarely : 2
• rarely : 1

Is coded with the following list of lists:

   ((4 "often")
    (3 "seldom" "sometimes")
    (2 "scarcely" "scarce" "hardly ever")
    (1 "rarely"))

Read this as: we should have 4 times as many items labeled "often" as "rarely".

So we use the function, rpgdm-tables--table-distribution to make a table-specific tag list, usually called table-tags, where:

each weight = the number of items * relative weight

So if we had 11 items in the table tagged as "often", and 8 rare items, we would have a tag table as:

   ((44 "often") (27 "seldom") (22 "scarcely") (8 "rarely"))

Granted, English tags and their relative weights are hard-coded at the moment. But this really should just be part of the file, perhaps as a buffer-local variable?

(defconst rpgdm-tables-tag-groups
  '(((12 "common")
     (7 "uncommon")
     (4 "rare")
     (2 "veryrare" "very-rare" "very rare")
     (1 "legendary"))

    ((4 "often")
     (3 "seldom" "sometimes")
     (2 "scarcely" "scarce" "hardly ever")
     (1 "rarely"))))

Choosing an Item

(defun rpgdm-tables--choose-freq-table (table)
  "Select item from a hash TABLE.
Note that tables stored in a hash table have weight keys and a list
of items associated with that weight."
  (let* ((table-tags (rpgdm-tables--table-distribution table))
         (tag (rpgdm-tables--choose-tag table-tags)))
    (seq-random-elt (gethash tag table))))


(defun rpgdm-tables--relevel-table (table tag)
  "Given a TAG of a hash TABLE, return new relative level.
The new value is based on the original weight, e.g. 4 and the
number of items of that particular tag.

Note: This is a helper function for `rpgdm-tables--table-distribution'."
  (let* ((name  (second tag))
         (items (gethash name table))
         (weight (first tag))
         (new-weight (* weight (length items))))
    (list new-weight name)))

(ert-deftest rpgdm-tables-relevel-table-test ()
  ;; Need to make a fake table, so we will just have a single entry in this
  ;; table, with a tag of "often". We'll specify that the weight for this should
  ;; be 4, and we'll store 10 items under that tag:
  (let* ((table (make-hash-table :test 'equal))
         (tag "often")
         (tag-weight-tuple (list 4 tag)))
    (puthash tag (number-sequence 1 10) table)
    (should (equal (list 40 tag)
                   (rpgdm-tables--relevel-table table tag-weight-tuple)))))


(defun rpgdm-tables--table-distribution (table)
  "Return a relative frequency tag group for a given TABLE.
Works by running map over the table's tags through the
`rpgdm-tables--relevel-table' helper function."
  (let ((table-tags (rpgdm-tables--which-tag-group table)))
    (--map (rpgdm-tables--relevel-table table it) table-tags)))


(defun rpgdm-tables--sum-tag-weights (tags)
  "The TAGS is a list of lists where the first element is a numeric weight.
Using `-reduce' allows us to sum these, but we need to make sure that the
first element of our list is our initial condition, so we `cons' a 0 onto
the start."
  (--reduce (+ acc (first it)) (cons 0 tags)))

(ert-deftest rpgdm-tables--sum--tag-weights-test ()
  (let ((weighted-tags
         '((44 "often") (27 "seldom") (22 "scarcely") (7 "rarely"))))
    (should (= 100 (rpgdm-tables--sum-tag-weights weighted-tags)))))


(defun rpgdm-tables--find-tag (roll tag-list)
  "Given a ROLL as a level in TAG-LIST, return matching tag.
The matching is based on the weight. A million ways to do this,
but stepping through the list of tags to see roll is in that
,*window*, and if not, both move to the next tag, as well as
decrement the ROLL value."
  (cl-loop for (num-elems tag) in tag-list do
           ;; (message "Comparing %d <= %d for %s" roll num-elems tag)
           (if (<= roll num-elems)
               (return tag)
             (cl-decf roll num-elems))))

(ert-deftest rpgdm-tables--find-tag-test ()
  (let ((weighted-tags
         '((44 "often") (27 "seldom") (22 "scarcely") (7 "rarely"))))
    (should (equal "often"    (rpgdm-tables--find-tag 1 weighted-tags)))
    (should (equal "often"    (rpgdm-tables--find-tag 44 weighted-tags)))
    (should (equal "seldom"   (rpgdm-tables--find-tag 45 weighted-tags)))
    (should (equal "seldom"   (rpgdm-tables--find-tag 71 weighted-tags)))
    (should (equal "scarcely" (rpgdm-tables--find-tag 72 weighted-tags)))
    (should (equal "scarcely" (rpgdm-tables--find-tag 93 weighted-tags)))
    (should (equal "rarely"   (rpgdm-tables--find-tag 94 weighted-tags)))
    (should (equal "rarely"   (rpgdm-tables--find-tag 100 weighted-tags)))))


(defun rpgdm-tables--choose-tag (tags)
  "Select random tag from TAGS in `rpgdm-tables-tag-groups'.
Uses helper function, `rpgdm-tables--find-tag'."
  (let* ((upper-limit (rpgdm-tables--sum-tag-weights tags))
         (roll (rpgdm--roll-die upper-limit)))
    ;; (message "Rolled %d on %d" roll upper-limit)
    (rpgdm-tables--find-tag roll tags)))

rpgdm-tables--choose-tag

Match Table with Tag Group

(defun rpgdm-tables--which-tag-group (table)
  "Return the tag table-tags associated with TABLE."
  (let (results
        (tag (first (hash-table-keys table))))
    (dolist (table-tags rpgdm-tables-tag-groups results)
      (let ((tag-list (->> table-tags
                          (-map 'rest)  ; Drop the numeric weight from each sublist
                          (-flatten))))
        (when (-contains? tag-list tag)
          (setq results table-tags))))))

Validating my Assumptions

Let's attempt to test our code and its theories.

The function repeatedly selects items from a table randomly, and returns a hash of the number of times each element was selected …

(defun rpgdm-tables-validate (&optional table-name iterations)
  "Return results randomly choosing many items from TABLE-NAME.
Calls `rpgdm-tables-choose' a number of ITERATIONS (defaults to 500)."
  (unless iterations (setq iterations 500))
  (unless table-name
    (setq table-name "test-subject")
    (puthash table-name (make-hash-table :test 'equal) rpgdm-tables)
    (setf (gethash "often" (gethash table-name rpgdm-tables))
          '(o1 o2 o3 o4 o5 o6 o7 o8 o9 o0))
    (setf (gethash "seldom" (gethash table-name rpgdm-tables))
          '(s1 s2 s3 s4 s5 s6 s7 s8 s9 s0))
    (setf (gethash "scarcely" (gethash table-name rpgdm-tables))
          '(l1 l2 l3 l4 l5 l6 l7 l8 l9 l0))
    (setf (gethash "rarely" (gethash table-name rpgdm-tables))
          '(r1 r2 r3 r4 r5 r6 r7 r8 r9 r0)))

  (let ((accumulator (make-hash-table :test 'equal)))
    (dotimes (i iterations accumulator)
      (let* ((item (rpgdm-tables-choose table-name))
             (item-name (first (s-split " :: " item))))
        (incf (gethash item-name accumulator 0))))
    accumulator))

Since we are randomly selecting items, even over large iterations, one can see scarcely appear almost as much as items labeled often. However, if we first sort the data:

    "o1" 35 "o2" 31 "o3" 38 "o4" 44 "o5" 43 ...
    "s1" 35 "s2" 38 "s3" 29 "s4" 28 "s5" 26 ...
    "l1" 26 "l2" 20 "l3" 19 "l4" 19 "l5" 26 ...
    "r1" 10 "r2" 7 "r3" 8 "r4" 5 "r5" 13 ...

And then calculate the average of each level, we see that the items occur as we would expect:

    (/ (+ 35 31 38 44 43) 5) ; -> 38
    (/ (+ 35 38 29 28 26) 5) ; -> 31
    (/ (+ 26 20 19 19 26) 5) ; -> 22
    (/ (+ 10  7  8  5 13) 5) ; ->  8

Good enough for now.

(provide 'rpgdm-tables-freq)
;;; rpgdm-tables-freq.el ends here