9411e512ce
I have a semblance of code giving me functions to help me run my D&D games. The README needs a lot more love, but the code is generally tidy. Time to add some tables...
363 lines
14 KiB
EmacsLisp
363 lines
14 KiB
EmacsLisp
;;; rpgdm-tables.el --- Choose table 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@workday.com>
|
|
;; Created: January 8, 2021
|
|
;;
|
|
;; This file is not part of GNU Emacs.
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; By storing tables in files, we can preparse them, allowing us to randomly
|
|
;; choose entries. The primary interface are:
|
|
;;
|
|
;; - `rpgdm-tables-load' :: Which when pointed to a directory, stores the data
|
|
;; in all text files read.
|
|
;;
|
|
;; - `rpgdm-tables-choose' :: Which, when a table is choosen, returns a random
|
|
;; element.
|
|
;;
|
|
;; The files read can be simply formatted as lists, or as an org-mode table. If
|
|
;; a table is found, the second column should be a _frequency_ label, where some
|
|
;; items in that table will be chosen more often than others.
|
|
;;
|
|
;;; Code:
|
|
|
|
(defvar rpgdm-base ".")
|
|
(require 'rpgdm-dice (expand-file-name "rpgdm-dice.el" rpgdm-base) t)
|
|
|
|
(defvar rpgdm-tables-directory
|
|
(expand-file-name "tables" rpgdm-base)
|
|
"Directory path containing the tables to load and create functions.")
|
|
|
|
(defvar rpgdm-tables (make-hash-table :test 'equal)
|
|
"Collection of tables and lists for the Dungeon Master.")
|
|
|
|
|
|
(defun rpgdm-tables-load (&optional filepath)
|
|
"Create functions from table files located in FILEPATH directory."
|
|
(interactive (list (read-directory-name "DM Tables Directory: " rpgdm-tables-directory)))
|
|
(dolist (table-file (directory-files filepath t))
|
|
(let ((name (file-name-base table-file))
|
|
(contents (rpgdm-tables--read-table-file table-file)))
|
|
;; (message "Read: %s" table-file)
|
|
(puthash name contents rpgdm-tables)))
|
|
(message "Read: %s" (s-join ", " (hash-table-keys rpgdm-tables))))
|
|
|
|
(defun rpgdm-tables-choose (table-name)
|
|
"Given a TABLE-NAME string, pick a random item from that table."
|
|
(interactive (list (completing-read "Choose from Table: " (hash-table-keys rpgdm-tables))))
|
|
(let ((table (gethash table-name rpgdm-tables)))
|
|
(cond ((listp table) (rpgdm-tables--choose-list table))
|
|
((hash-table-p table) (rpgdm-tables--choose-hash table))
|
|
(t "Error: Could choose anything from %s (internal bug?)" table-name))))
|
|
|
|
|
|
(defvar rpgdm-tables--line-parse
|
|
(rx bol (zero-or-more space)
|
|
(optional
|
|
(any "+" "-" "*" "|")
|
|
(one-or-more space))
|
|
(group (+? any))
|
|
(optional (zero-or-more space) (or ":" "|") (zero-or-more space)
|
|
(group (one-or-more alphanumeric))
|
|
(zero-or-more space) (optional (or ":" "|")) (zero-or-more space))
|
|
eol)
|
|
"A regular expression for locating parsable lines.")
|
|
|
|
(ert-deftest rpgdm-tables--line-parse-test ()
|
|
"Why yes, we should test our regular expression."
|
|
(dolist (data '((" - normal list" "normal list" nil)
|
|
(" + normal list" "normal list" nil)
|
|
(" * normal list" "normal list" nil)
|
|
("normal list" "normal list" nil)
|
|
(" - list with tag :tag:" "list with tag" "tag")
|
|
(" - list with tag :tag" "list with tag" "tag")
|
|
(" - list with tag : tag" "list with tag" "tag")
|
|
(" | table cell | freq |" "table cell" "freq")))
|
|
(cl-destructuring-bind (line contents tag) data
|
|
(should (string-match rpgdm-tables--line-parse line))
|
|
(should (equal (match-string 1 line) contents))
|
|
(when tag
|
|
(should (equal (match-string 2 line) tag))))))
|
|
|
|
|
|
(defun rpgdm-tables--read-table-file (table-file)
|
|
"Read and parse TABLE-FILE as data. Whatever that means."
|
|
(with-temp-buffer
|
|
(insert-file-contents table-file)
|
|
(goto-char (point-min))
|
|
(flush-lines (rx bol (zero-or-more space) "#"))
|
|
(when (re-search-forward rpgdm-tables--line-parse nil nil)
|
|
(if (match-string 2)
|
|
(rpgdm-tables--parse-as-hash)
|
|
(rpgdm-tables--parse-as-list)))))
|
|
|
|
(defun rpgdm-tables--parse-as-list ()
|
|
"Return list of lines matching `rpgdm-tables--line-parse'."
|
|
(let ((results (list (match-string-no-properties 1))))
|
|
(while (re-search-forward rpgdm-tables--line-parse nil t)
|
|
(let ((entry (match-string-no-properties 1)))
|
|
(setq results (cons entry results))))
|
|
results))
|
|
|
|
(defun rpgdm-tables--parse-as-hash ()
|
|
"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--flatten-hash results)))
|
|
|
|
(defun rpgdm-tables--flatten-hash (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)) ; Ignore all the numbers
|
|
(tags (-map 'rest table-tags)))
|
|
(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))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;;
|
|
;; At this point, we have a hash table of tables, where the key is the name, and
|
|
;; the value is either:
|
|
;; - A list of things to choose
|
|
;; - A hash table where the key is a tag, and the value is a list of items
|
|
;; that match that tag.
|
|
;;
|
|
;; Obviously, selecting an element from a list is easy:
|
|
|
|
(defun rpgdm-tables--choose-list (lst)
|
|
"Randomly choose (equal chance for any) element in LST."
|
|
(let ((item (seq-random-elt lst)))
|
|
(message "%s" item)))
|
|
|
|
;; 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"))
|
|
|
|
;; TODO English tags and their relative weights are hard-coded at the moment.
|
|
;; This really should just be part of the file, perhaps as a buffer-local
|
|
;; variable?
|
|
|
|
(defconst rpgdm-tables-tag-groups
|
|
'(((10 "common")
|
|
(6 "uncommon")
|
|
(4 "rare")
|
|
(2 "veryrare" "very-rare" "very rare")
|
|
(1 "legendary"))
|
|
|
|
((4 "often")
|
|
(3 "seldom" "sometimes")
|
|
(2 "scarcely" "scarce" "hardly ever")
|
|
(1 "rarely"))))
|
|
|
|
(defun rpgdm-tables--choose-hash (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)))
|
|
(rpgdm-tables--choose-list (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)
|
|
(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)))
|
|
|
|
(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))))))
|
|
|
|
;; ----------------------------------------------------------------------
|
|
;; 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
|
|
|
|
(provide 'rpgdm-tables)
|
|
;;; rpgdm-tables.el ends here
|