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
217
rpgdm-tables-freq.el
Normal file
217
rpgdm-tables-freq.el
Normal file
|
|
@ -0,0 +1,217 @@
|
|||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::+BEGIN_SRC emacs-lisp][No heading:1]]
|
||||
;;; 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:
|
||||
;; No heading:1 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Parsing a Frequency Table][Parsing a Frequency Table:1]]
|
||||
(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))
|
||||
;; Parsing a Frequency Table:1 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Parsing a Frequency Table][Parsing a Frequency Table:2]]
|
||||
(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)))
|
||||
;; Parsing a Frequency Table:2 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Parsing a Frequency Table][Parsing a Frequency Table:3]]
|
||||
(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))
|
||||
;; Parsing a Frequency Table:3 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Frequencies as Weights][Frequencies as Weights:3]]
|
||||
(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"))))
|
||||
;; Frequencies as Weights:3 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Choosing an Item][Choosing an Item:1]]
|
||||
(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)
|
||||
(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)))
|
||||
;; Choosing an Item:1 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Match Table with Tag Group][Match Table with Tag Group:1]]
|
||||
(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))))))
|
||||
;; Match Table with Tag Group:1 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Validating my Assumptions][Validating my Assumptions:1]]
|
||||
(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))
|
||||
;; Validating my Assumptions:1 ends here
|
||||
|
||||
;; [[file:../../../../../Volumes/Personal/dropbox/org/rpg-dm/docs/rpgdm-tables-freq.org::*Validating my Assumptions][Validating my Assumptions:3]]
|
||||
(provide 'rpgdm-tables-freq)
|
||||
;;; rpgdm-tables-freq.el ends here
|
||||
;; Validating my Assumptions:3 ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue