chris/emacs-rpgdm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Working with both Dice and Frequency tables

Browse source 
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 2021-02-08 15:26:16 -08:00
parent 558d7eb984
commit 7dab533415
7 changed files with 975 additions and 270 deletions
Download patch file Download diff file Expand all files Collapse all files

190
docs/rpgdm-tables-dice.org Normal file
View file

@ -0,0 +1,190 @@
#+title: Dice Tables for Games
#+author: Howard X. Abrams
#+email: howard.abrams@gmail.com
#+FILETAGS: :org-mode:emacs:rpgdm:
#+STARTUP: inlineimages yes
#+PROPERTY: header-args:emacs-lisp :tangle ../rpgdm-tables-dice.el :comments yes
#+PROPERTY: header-args :eval no-export
#+PROPERTY: header-args :results silent
#+PROPERTY: header-args :exports both
#+BEGIN_SRC emacs-lisp
;;; rpgdm-tables-dice.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:
#+END_SRC
A "dice table" is a table that is easy to manipulate with dice in a game, and is pretty typical. The general idea is to roll one or more specific dice, and compare the number in the first column to see what the choice.
For instance, Xanathar's Guide to Everything, a Dungeons and Dragons supplement from Wizards of the Coast, allows you to choose a random alignment with the following table:
| 3d6 | Alignment |
|--------+---------------------------------------------|
| 3 | Chaotic evil (50%) or chaotic neutral (50%) |
| 4--5 | Lawful evil |
| 6--8 | Neutral evil |
| 9--12 | Neutral |
| 13--15 | Neutral good |
| 16--17 | Lawful good (50%) or lawful neutral (50%) |
| 18 | Chaotic good (50%) or chaotic neutral (50%) |
#+BEGIN_SRC emacs-lisp
;;; Code:
#+END_SRC
To represent these types of tables, we create a special type, called a =dice-table=. Where the first "slot" is the dice expression (or the number of sides of a dice to roll), and an associative list of result values and the choice.
#+BEGIN_SRC emacs-lisp :results silent
(defstruct dice-table dice rows)
#+END_SRC
How is this used to render the example table above?
#+NAME: alignment-table
#+BEGIN_SRC emacs-lisp :results silent :tangle no
(make-dice-table :dice "3d6"
:rows '((3 . ("Chaotic evil" "Chaotic neutral"))
(5 . "Lawful evil")
(8 . "Neutral evil")
(12 . "Neutral")
(15 . "Neutral good")
(17 . ("Lawful good" "Lawful neutral"))
(18 . ("Chaotic good" "chaotic neutral"))))
#+END_SRC
Couple things to notice about this rendering of the table. First, we don't need a range, just the upper bound (for if we roll a 4, we skip over the 3, we are below the next number, so we bugger off with the answer).
Second, a table row could have multiple choices. For instance, if we were to roll a =3=, we should flip a coin to choose between /chaotic evil/ and /chaotic neutral/. In other words, if the value of the row is a list, then we could just select from one of those options.
Let's do the fun part, and select an item from one of these dice-tables. First, we grab the dice expression and the rows of the table and put them into a couple of variables. We use a helper function, =rpgdm-tables-dice--choose= to get the results of rolling the dice expression
#+BEGIN_SRC emacs-lisp :results silent
(defun rpgdm-tables--choose-dice-table (table)
"Choose a string from a random dice table."
(let* ((roll (rpgdm-roll-sum (dice-table-dice table)))
(rows (dice-table-rows table))
(results (rpgdm-tables-dice--choose roll rows)))
(if (stringp results)
results
(seq-random-elt results))))
#+END_SRC
If the results are not a single string item, we assume we have a list sequence, and return one at random using =seq-random-elt=.
The helper function is recursive, as we can evaluate each /row/ to see if it matches the dice roll:
#+BEGIN_SRC emacs-lisp :results silent
(defun rpgdm-tables-dice--choose (roll rows)
"Given a numeric ROLL, return row that matches.
This assumes ROWS is a sorted list where the first element (the
`car') is a numeric level that if ROLL is less than or equal, we
return the `rest' of the row. Otherwise, we recursively call this
function with the `rest' of the rows."
(let* ((row (first rows))
(level (car row))
(answer (rest row)))
(if (<= roll level)
answer
(rpgdm-tables-dice--choose roll (rest rows)))))
#+END_SRC
So, let's see it in action, by first assigning the dice-table above, to a variable: =alignment-table=:
#+BEGIN_SRC emacs-lisp :var alignment-table=alignment-table :tangle no
(rpgdm-tables--choose-dice-table alignment-table)
#+END_SRC
#+RESULTS:
: Neutral good
Nice. Now we just have to read and parse the table from an org-mode file.
Since I format my tables in different /styles/, I need to be able to identify a /dice table/, I figured I would have a key word, =Roll on table= with a dice expression from =rpgdm-dice.el=:
#+BEGIN_SRC emacs-lisp :results silent
(setq rpgdm-tables-dice-table-regexp (rx "Roll"
(one-or-more space)
(optional (or "on" "for"))
(zero-or-more space)
"Table:"
(zero-or-more space)
(group
(regexp rpgdm-roll-regexp))))
#+END_SRC
A predicate could return true when this regular expression returns a valid response:
#+BEGIN_SRC emacs-lisp :results silent
(defun rpgdm-tables-dice-table? ()
"Return non-nil if current buffer contains a dice-table"
(goto-char (point-min))
(re-search-forward rpgdm-tables-dice-table-regexp nil t))
#+END_SRC
Assuming we just called that function, we can call =match-string= to pick up that group and then parse the rest of the buffer as a table:
#+BEGIN_SRC emacs-lisp :results silent
(defun rpgdm-tables--parse-as-dice-table ()
"Return `dice-table' of lines matching `rpgdm-tables-dice-table-rows'."
(let ((dice (match-string-no-properties 1)) ; Grab expression before moving on
(rows ()) ; Modify this with add-to-list
(row-splitter (rx (* space) "|" (* space)))) ; Split rest of table row
(while (re-search-forward rgpdm-tables-dice-table-rows nil t)
(let* ((levelstr (match-string-no-properties 1))
(level (string-to-number levelstr))
(row (match-string-no-properties 2))
(choices (split-string row row-splitter t)))
(add-to-list 'rows (cons level choices))))
(make-dice-table :dice dice
:rows (sort rows (lambda (a b) (< (first a) (first b)))))))
#+END_SRC
This function relies on a regular expression for parsing the tables:
#+BEGIN_SRC emacs-lisp :results silent
(setq rgpdm-tables-dice-table-rows (rx bol
(zero-or-more space) "|" (zero-or-more space)
(optional (one-or-more digit)
(one-or-more "-"))
(group
(one-or-more digit))
(zero-or-more space) "|" (zero-or-more space)
(group (+? any))
(zero-or-more space) "|" (zero-or-more space)
eol))
#+END_SRC
Let's read the following table into a buffer:
#+begin_example
Roll on Table: 3d6
| 3 | Chaotic evil | chaotic neutral |
| 4--5 | Lawful evil | |
| 6--8 | Neutral evil | |
| 9--12 | Neutral | |
| 13--15 | Neutral good | |
| 16--17 | Lawful good | lawful neutral |
| 18 | Chaotic good | chaotic neutral |
#+end_example
#+BEGIN_SRC emacs-lisp
(provide 'rpgdm-tables-dice)
;;; rpgdm-tables-dice.el ends here
#+END_SRC
# Local Variables:
# eval: (add-hook 'after-save-hook #'org-babel-tangle t t)
# End:

329
docs/rpgdm-tables-freq.org Normal file
View file

@ -0,0 +1,329 @@
#+title: Frequency Tables for Games
#+author: Howard X. Abrams
#+email: howard.abrams@gmail.com
#+FILETAGS: :org-mode:emacs:rpgdm:
#+STARTUP: inlineimages yes
#+PROPERTY: header-args:emacs-lisp :tangle ../rpgdm-tables-freq.el :comments yes
#+PROPERTY: header-args :eval no-export
#+PROPERTY: header-args :results silent
#+PROPERTY: header-args :exports both
#+BEGIN_SRC emacs-lisp
;;; 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:
#+END_SRC
* 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:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
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.
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
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:
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
* 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:
#+BEGIN_SRC emacs-lisp :results silent :tangle no
((4 "often")
(3 "seldom" "sometimes")
(2 "scarcely" "scarce" "hardly ever")
(1 "rarely"))
#+END_SRC
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:
#+begin_quote
each weight = the number of items * relative weight
#+end_quote
So if we had 11 items in the table tagged as "often", and 8 rare
items, we would have a tag table as:
#+BEGIN_SRC emacs-lisp :results silent :tangle no
((44 "often") (27 "seldom") (22 "scarcely") (8 "rarely"))
#+END_SRC
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?
#+BEGIN_SRC emacs-lisp
(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"))))
#+END_SRC
* Choosing an Item
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
#+RESULTS:
: rpgdm-tables--choose-tag
* Match Table with Tag Group
#+BEGIN_SRC emacs-lisp
(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))))))
#+END_SRC
* 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 ...
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
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:
#+begin_example
"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 ...
#+end_example
And then calculate the average of each _level_, we see that the items occur as we would expect:
#+BEGIN_SRC emacs-lisp :results silent :tangle no
(/ (+ 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
#+END_SRC
Good enough for now.
#+BEGIN_SRC emacs-lisp
(provide 'rpgdm-tables-freq)
;;; rpgdm-tables-freq.el ends here
#+END_SRC
# Local Variables:
# eval: (add-hook 'after-save-hook #'org-babel-tangle t t)
# End:

18
rpgdm-dice.el
View file

@ -155,6 +155,24 @@ average value of AVG, if given."
(rpgdm--test-roll-series 'rpgdm--roll dice-args lowest highest))))) (rpgdm--test-roll-series 'rpgdm--roll dice-args lowest highest)))))
;; For programmatic reasons, we need a quick way to roll dice and get a
;; numeric value.
(defun rpgdm-roll-sum (first &optional dice-type modifier)
"Return a number value from rolling some dice.
The FIRST can be one of the following values:
- A dice expression as a string, e.g. 2d4+2
- A roll-combo tuple list
- A single number of dice to roll (but this requires more values)
If FIRST is an integer, then DICE-TYPE is the number of dice sides.
MODIFIER, if given, is added to roll."
(cond
((stringp first) (rpgdm--sum (rpgdm--roll-expression first)))
((listp first) (rpgdm--sum first))
(t (rpgdm--sum (rpgdm--roll first dice-type modifier)))))
;; Now that we can roll a die with distinct numbers, let's now deal with dice ;; Now that we can roll a die with distinct numbers, let's now deal with dice
;; strings, e.g. 2d10+4. Can we have a regular expression that could identify ;; strings, e.g. 2d10+4. Can we have a regular expression that could identify
;; as well as pull apart the individual numbers? ;; as well as pull apart the individual numbers?

169
rpgdm-npc.el Normal file
View file

@ -0,0 +1,169 @@
;;; rpgdm-npc.el --- Random NPC Generation -*- 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:
;;
;; Choosing a good NPC is about the location:
;; - City
;; - Town
;; - Village
;; - Road
;; - Feywild, etc.
;;
;; As this will really affect the occupation.
;;
;; Also, the /purpose/ may also change whether we are looking for a companion
;; or guild, or just a random person on the street.
;;
;; Obviously, I won't worry about giving incorrect answers, as anything that
;; doesn't /fit/ will just be ignored.
;;
;;;
;;; CCode:
(defvar rpgdm-base ".")
(require 'rpgdm-dice (expand-file-name "rpgdm-dice.el" rpgdm-base) t)
(require 'rpgdm-dice (expand-file-name "rpgdm-tables.el" rpgdm-base) t)
(defun rpgdm-npc-gender-name ()
"Return nil or non-nil for male or female names."
(= (random 2) 0))
(defun rpgdm-npc-choose (&rest choices)
"Randomly return from from CHOICES, one of the parameters."
(seq-random-elt choices))
(defun rpgdm-npc-adventuring-age ()
"Return string representing the age of an NPC available to physically aide the adventures."
(let ((roll (rpgdm--roll-die 100)))
(cond
((= roll 1) "Very young (child)")
((<= roll 10) "Coming of age")
((<= roll 60) "Young adult")
((<= roll 90) "Middle Aged")
((<= roll 99) "Old")
(t "Past normal lifespan (very old)"))))
(defun rpgdm-npc-age ()
"Return string representing an age of a random NPC."
(let ((roll (rpgdm--roll-die 100)))
(cond
((= roll 1) "Very young (child)")
((<= roll 10) "Coming of age")
((<= roll 40) "Young adult")
((<= roll 70) "Middle Aged")
((<= roll 96) "Old")
(t "Past normal lifespan (very old)"))))
(defun rpgdm-npc-known-parents ()
"Return non-nil if PC knew their parents."
(< (rpgdm--roll-die 100) 96))
(defun rpgdm-npc--parents ()
"Return a tuple of `father' and `mother' in either order."
(seq-random-elt '((father mother) (mother father))))
(defun rpgdm-npc--parent-assignment (x y)
"Given two parental types, X and Y, assign them to father or mother."
(seq-let (a b) (rpgdm-npc--parents)
(format "%s was %s, and %s was %s" a x b y)))
(defun rpgdm-npc-halfelf-parents ()
(let ((roll (rpgdm--roll-die 8)))
(cond
((<= roll 5) (rpgdm-npc--parent-assignment "an elf" "human"))
((= roll 6) (rpgdm-npc--parent-assignment "an elf" "half-elven"))
((= roll 7) (rpgdm-npc--parent-assignment "human" "half-elven"))
((= roll 8) "both parents were half-elven"))))
(defun rpgdm-npc-halforc-parents ()
(let ((roll (rpgdm--roll-die 8)))
(cond
((<= roll 3) (rpgdm-npc--parent-assignment "an orc" "human"))
((= roll 5) (rpgdm-npc--parent-assignment "an orc" "a half-orc"))
((= roll 7) (rpgdm-npc--parent-assignment "human" "a half-orc"))
((= roll 8) "both parents were half-orcs"))))
(defun rpgdm-npc-tiefling-parents ()
(let ((roll (rpgdm--roll-die 8)))
(cond
((<= roll 4) "both parents were human, their infernal heritage dormant until their child was born")
((= roll 6) (rpgdm-npc--parent-assignment "a tiefling" "human"))
((= roll 7) (rpgdm-npc--parent-assignment "a tiefling" "a devil"))
((= roll 8) (rpgdm-npc--parent-assignment "human" "a devil")))))
(defun rpgdm-npc-birthplace ()
"Return string of a random birthplace."
(let ((roll (rpgdm--roll-die 100)))
(cond
((<= roll 50) "at home")
((<= roll 55) "in the home of a family friend")
((<= roll 63) "in the home of a healer or midwife")
((<= roll 65) (format "in a %s" (rpgdm-npc-choose "carriage" "cart or wagon")))
((<= roll 68) "in a barn, shed, or other outbuilding")
((<= roll 70) "in a cave")
((<= roll 72) "in a field")
((<= roll 74) "in a forest")
((<= roll 77) "in a Temple")
((= roll 78) "in a battlefield")
((<= roll 80) "in an alley or street")
((<= roll 82) "in a brothel, tavern, or inn")
((<= roll 84) "in a castle, keep, tower, or palace")
((= roll 85) (format "in %s" (rpgdm-npc-choose "the sewers" "a rubbish heap")))
((<= roll 88) (format "among people of a different race: %s" (rpgdm-tables-choose "npc-race")))
((<= roll 91) (format "on board a %s" (rpgdm-npc-choose "boat" "ship")))
((<= roll 93) (format "in %s of a secret organization" (rpgdm-npc-choose "a prison" "the headquarters")))
((<= roll 95) "in a sage’s laboratory")
((= roll 96) "in the Feywild")
((= roll 97) "in the Shadowfell")
((= roll 98) (format "on the %s Plane" (rpgdm-npc-choose "Astral" "Ethereal")))
((= roll 99) "on an Inner Plane")
(t "on an Outer Plane"))))
(defun rpgdm-npc--cause-of-death ()
"Return string from a random cause of death."
(let ((roll (rpgdm--roll-die 12)))
(cond
((= roll 1) "unknown")
((= roll 2) "murdered")
((= roll 3) "killed in battle")
((= roll 4) (format "accident related to %s"
(rpgdm-npc-choose "class" "occupation")))
((= roll 5) "accident unrelated to class or occupation")
((= roll 6) "disease, natural causes")
((= roll 7) "old age, natural causes")
((= roll 8) "apparent suicide")
((= roll 9) (rpgdm-npc-choose "torn apart by an animal" "natural disaster"))
((= roll 10) "consumed by a monster")
((= roll 11) (rpgdm-npc-choose "executed for a crime" "tortured to death"))
((= roll 12) "bizarre event, such as being hit by a meteorite, struck down by an angry god, or killed by a hatching slaad egg"))))
(defun rpgdm-npc-siblings ()
"Return string of the number of siblihngs.
I am not sure why Xanathar's Guide had such a complicated
way of rolloing for siblings. But I recreated it."
(let ((roll (rpgdm--roll-die 10)))
(cond
((<= roll 2) 0)
((<= roll 4) (rpgdm-roll-sum "1d3"))
((<= roll 6) (rpgdm-roll-sum "1d4+1"))
((<= roll 8) (rpgdm-roll-sum "1d6+2"))
((<= roll 10) (rpgdm-roll-sum "1d8+3")))))
(defun rpgdm-npc-birth-order ()
"A string results of whether a sibling is older or younger."
(let ((roll (rpgdm-roll-sum "2d6")))
(cond
((= roll 2) "Twin, triplet, or quadruplet")
((<= roll 7) "Older")
(t "Younger"))))
(provide 'rpgdm-npc)
;;; rpgdm-npc.el ends here

14
rpgdm-tables-dice.el Normal file
View file

@ -0,0 +1,14 @@
;; [[file:docs/rpgdm-tables-dice.org::+BEGIN_SRC emacs-lisp][No heading:1]]
;;; rpgdm-tables-dice.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

217
rpgdm-tables-freq.el Normal file
View 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

308
rpgdm-tables.el
View file

@ -27,6 +27,9 @@
(defvar rpgdm-base ".") (defvar rpgdm-base ".")
(require 'rpgdm-dice (expand-file-name "rpgdm-dice.el" rpgdm-base) t) (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 (defvar rpgdm-tables-directory
(expand-file-name "tables" rpgdm-base) (expand-file-name "tables" rpgdm-base)
@ -47,13 +50,28 @@
(message "Read: %s" (s-join ", " (hash-table-keys rpgdm-tables)))) (message "Read: %s" (s-join ", " (hash-table-keys rpgdm-tables))))
(defun rpgdm-tables-choose (table-name) (defun rpgdm-tables-choose (table-name)
"Given a TABLE-NAME string, pick a random item from that table." "Return random item from a table of a given TABLE-NAME string.
(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))))
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 (defvar rpgdm-tables--line-parse
(rx bol (zero-or-more space) (rx bol (zero-or-more space)
@ -83,17 +101,22 @@
(when tag (when tag
(should (equal (match-string 2 line) tag)))))) (should (equal (match-string 2 line) tag))))))
(defun rpgdm-tables--read-table-file (table-file) (defun rpgdm-tables--read-table-file (table-file)
"Read and parse TABLE-FILE as data. Whatever that means." "Read and parse TABLE-FILE as data. Whatever that means."
(with-temp-buffer (when (and (file-regular-p table-file) (file-readable-p table-file))
(insert-file-contents table-file) (with-temp-buffer
(goto-char (point-min)) (insert-file-contents table-file)
(flush-lines (rx bol (zero-or-more space) "#")) (goto-char (point-min))
(when (re-search-forward rpgdm-tables--line-parse nil nil) (flush-lines (rx bol (zero-or-more space) "#"))
(if (match-string 2)
(rpgdm-tables--parse-as-hash) ;; The following predicates are not /pure functions/, as they scan the
(rpgdm-tables--parse-as-list))))) ;; 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 () (defun rpgdm-tables--parse-as-list ()
"Return list of lines matching `rpgdm-tables--line-parse'." "Return list of lines matching `rpgdm-tables--line-parse'."
@ -103,261 +126,6 @@
(setq results (cons entry results)))) (setq results (cons entry results))))
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) (provide 'rpgdm-tables)
;;; rpgdm-tables.el ends here ;;; rpgdm-tables.el ends here