diff --git a/docs/rpgdm-tables-dice.org b/docs/rpgdm-tables-dice.org new file mode 100644 index 0000000..95735c6 --- /dev/null +++ b/docs/rpgdm-tables-dice.org @@ -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 +;; Maintainer: Howard X. Abrams +;; 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: diff --git a/docs/rpgdm-tables-freq.org b/docs/rpgdm-tables-freq.org new file mode 100644 index 0000000..abc7412 --- /dev/null +++ b/docs/rpgdm-tables-freq.org @@ -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 +;; Maintainer: Howard X. Abrams +;; 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: diff --git a/rpgdm-dice.el b/rpgdm-dice.el index 169a8eb..a170c0c 100644 --- a/rpgdm-dice.el +++ b/rpgdm-dice.el @@ -155,6 +155,24 @@ average value of AVG, if given." (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 ;; strings, e.g. 2d10+4. Can we have a regular expression that could identify ;; as well as pull apart the individual numbers? diff --git a/rpgdm-npc.el b/rpgdm-npc.el new file mode 100644 index 0000000..680734b --- /dev/null +++ b/rpgdm-npc.el @@ -0,0 +1,169 @@ +;;; rpgdm-npc.el --- Random NPC Generation -*- lexical-binding: t; -*- +;; +;; Copyright (C) 2021 Howard X. Abrams +;; +;; Author: Howard X. Abrams +;; Maintainer: Howard X. Abrams +;; 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 diff --git a/rpgdm-tables-dice.el b/rpgdm-tables-dice.el new file mode 100644 index 0000000..bf81094 --- /dev/null +++ b/rpgdm-tables-dice.el @@ -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 +;; Maintainer: Howard X. Abrams +;; Created: February 5, 2021 +;; +;; This file is not part of GNU Emacs. +;; +;; +;;; Commentary: +;; No heading:1 ends here diff --git a/rpgdm-tables-freq.el b/rpgdm-tables-freq.el new file mode 100644 index 0000000..abc8ef6 --- /dev/null +++ b/rpgdm-tables-freq.el @@ -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 +;; Maintainer: Howard X. Abrams +;; 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 diff --git a/rpgdm-tables.el b/rpgdm-tables.el index e764efc..a4d56c7 100644 --- a/rpgdm-tables.el +++ b/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