Working with both Dice and Frequency tables
Some of these tables are getting complicated, so I have created three different tables, and this should be sufficient. Describing it, however, seems to be a lot for source code, and I thought I would describe it using a literate programming style. We'll see.
This commit is contained in:
Howard Abrams
parent
558d7eb984
commit
7dab533415
7 changed files with 975 additions and 270 deletions
308
rpgdm-tables.el
308
rpgdm-tables.el
|
|
@ -27,6 +27,9 @@
|
|||
|
||||
(defvar rpgdm-base ".")
|
||||
(require 'rpgdm-dice (expand-file-name "rpgdm-dice.el" rpgdm-base) t)
|
||||
(require 'rpgdm-tables-freq (expand-file-name "rpgdm-tables-freq.el" rpgdm-base) t)
|
||||
(require 'rpgdm-tables-dice (expand-file-name "rpgdm-tables-dice.el" rpgdm-base) t)
|
||||
|
||||
|
||||
(defvar rpgdm-tables-directory
|
||||
(expand-file-name "tables" rpgdm-base)
|
||||
|
|
@ -47,13 +50,28 @@
|
|||
(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))))
|
||||
"Return random item from a table of a given TABLE-NAME string.
|
||||
|
||||
The name is searched in the `rpgdm-tables' hash-table, and the
|
||||
value returned is a _table_ of sorts. It could be a list, which
|
||||
would be easy (see `rpgdm-tables--choose-list'), or it is either
|
||||
a freq-uency table (see `rpgdm-tables--choose-freq-table') or a
|
||||
dice table (see `rpgdm-tables--choose-dice-table')."
|
||||
(interactive (list (completing-read "Choose from Table: " (hash-table-keys rpgdm-tables))))
|
||||
(let* ((table (gethash table-name rpgdm-tables))
|
||||
(response (cond ((dice-table-p table) (rpgdm-tables--choose-dice-table table))
|
||||
((hash-table-p table) (rpgdm-tables--choose-freq-table table))
|
||||
((listp table) (rpgdm-tables--choose-list table))
|
||||
(t "Error: Could choose anything from %s (internal bug?)" table-name))))
|
||||
(rpgdm-message "%s" response)))
|
||||
|
||||
(defun rpgdm-tables--choose-list (lst)
|
||||
"Randomly choose (equal chance for any) element in LST."
|
||||
(seq-random-elt lst))
|
||||
|
||||
;; I originally thought that I could have a single regular expression that
|
||||
;; matched all possible tables, but that is a bit too complicated. The following
|
||||
;; regular expression, however, will parse a list or a frequency table.
|
||||
|
||||
(defvar rpgdm-tables--line-parse
|
||||
(rx bol (zero-or-more space)
|
||||
|
|
@ -83,17 +101,22 @@
|
|||
(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)))))
|
||||
(when (and (file-regular-p table-file) (file-readable-p table-file))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents table-file)
|
||||
(goto-char (point-min))
|
||||
(flush-lines (rx bol (zero-or-more space) "#"))
|
||||
|
||||
;; The following predicates are not /pure functions/, as they scan the
|
||||
;; current buffer, leaving the initial match in the 'hopper', so the parsing
|
||||
;; function called makes that assumption, and will immediately grab that
|
||||
;; `match-string' and then parse the rest of the buffer.
|
||||
(cond
|
||||
((rpgdm-tables-dice-table?) (rpgdm-tables--parse-as-dice-table))
|
||||
((rpgdm-tables-freq-table?) (rpgdm-tables--parse-as-freq-table))
|
||||
(t (rpgdm-tables--parse-as-list))))))
|
||||
|
||||
(defun rpgdm-tables--parse-as-list ()
|
||||
"Return list of lines matching `rpgdm-tables--line-parse'."
|
||||
|
|
@ -103,261 +126,6 @@
|
|||
(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)))
|
||||
(rpgdm-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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue