Cleanup and organize namespaces
Eric Ihli
4 years ago
parent
7e461b3620
commit
f30686e95e
@ -0,0 +1,110 @@
|
|||||||
|
(ns com.owoga.prhyme.generation.weighted-selection
|
||||||
|
"Utilities for generation of rhymes by assigning weights to a collection of
|
||||||
|
words and randomly choosing words based on their weights.
|
||||||
|
|
||||||
|
For example, we might want the first word of the rhyme of a target phrase to
|
||||||
|
be selected from words that are highly weighted by their rhymeness. It's not
|
||||||
|
as important for subsequent words to rhyme, so we might want subsequent words
|
||||||
|
to be selected weighted by whether or not they are synonyms to some other
|
||||||
|
word, by how many syllables they have, by whether they are associated with a
|
||||||
|
markov value, etc..."
|
||||||
|
(:require [com.owoga.prhyme.core :as prhyme]))
|
||||||
|
|
||||||
|
;;;; Signature of "weight adjustment" functions
|
||||||
|
;;;
|
||||||
|
;;; A weight adjustment function gets called every time a decision needs to be
|
||||||
|
;;; made for which word to choose, so I think it's important to not be too slow.
|
||||||
|
;;;
|
||||||
|
;;; The function will receive:
|
||||||
|
;;; - a collection of the words from which to weight.
|
||||||
|
;;; - the target phrase we're rhyming for
|
||||||
|
;;; - the current result that we have so far
|
||||||
|
;;;
|
||||||
|
;;; By default, the weights of the passed in words will probably be 1. If you
|
||||||
|
;;; want future weights to be adjusted from past weights, that's up to you.
|
||||||
|
;;;
|
||||||
|
;;; The target phrase will change as words are chosen for the result.
|
||||||
|
;;; A good and strategy will be to chop off syllables from the target phrase
|
||||||
|
;;; for each syllable of a matching result.
|
||||||
|
|
||||||
|
(defn adjust-for-markov
|
||||||
|
"Works with a markov data structure that was generated taking into account
|
||||||
|
sentence boundaries (represented as nils).
|
||||||
|
|
||||||
|
A key in the markov structure of '(nil) would have a value that represents all
|
||||||
|
words that have occurred in position 1 of the raw data.
|
||||||
|
|
||||||
|
A key of '(nil \"foo\") would have a value that represents all words
|
||||||
|
that occurred in position 2 following \"foo\"
|
||||||
|
|
||||||
|
Automatically detects the order (window size) of the markov model. Does this
|
||||||
|
by counting the length of the first key.
|
||||||
|
"
|
||||||
|
[markov percent]
|
||||||
|
(let [markov-n (count (first (first markov)))]
|
||||||
|
(fn [[words target result]]
|
||||||
|
(let [key (let [k (map :norm-word (take markov-n result))]
|
||||||
|
(reverse
|
||||||
|
(if (> markov-n (count k))
|
||||||
|
(concat k (repeat (- markov-n (count k)) nil))
|
||||||
|
k)))
|
||||||
|
markov-options (markov key)
|
||||||
|
markov-option-avg (/ (apply + (vals markov-options))
|
||||||
|
(max 1 (count markov-options)))]
|
||||||
|
(if (nil? markov-options)
|
||||||
|
[words target result]
|
||||||
|
(let [[markovs non-markovs]
|
||||||
|
((juxt filter remove)
|
||||||
|
#(markov-options (:norm-word %))
|
||||||
|
words)
|
||||||
|
weight-non-markovs (apply + (map :weight non-markovs))
|
||||||
|
target-weight-markovs (- (/ weight-non-markovs (- 1 percent))
|
||||||
|
weight-non-markovs)
|
||||||
|
count-markovs (count markovs)
|
||||||
|
adjustment-markovs (if (= 0 count-markovs) 1 (/ target-weight-markovs count-markovs))]
|
||||||
|
[(concat
|
||||||
|
(map
|
||||||
|
(fn [m]
|
||||||
|
(let [option (markov-options (:norm-word m))]
|
||||||
|
(as-> m m
|
||||||
|
(assoc m :weight (* (/ option markov-option-avg) adjustment-markovs (:weight m)))
|
||||||
|
(assoc m :adjustment-for-markov (* (/ option markov-option-avg) adjustment-markovs)))))
|
||||||
|
markovs)
|
||||||
|
non-markovs)
|
||||||
|
target
|
||||||
|
result]))))))
|
||||||
|
|
||||||
|
(defn adjust-for-rhymes
|
||||||
|
"Weights words by whether or not they rhyme.
|
||||||
|
Once result contains something, becomes inactive. If you want to try to rhyme
|
||||||
|
every selection, you'll need a different function. This one will only rhyme
|
||||||
|
the tail of a target."
|
||||||
|
[percent]
|
||||||
|
(fn [[words target result]]
|
||||||
|
(if (empty? result)
|
||||||
|
(let [words-with-rime-count
|
||||||
|
(map
|
||||||
|
(fn [word]
|
||||||
|
(assoc word :num-matching (if (prhyme/rhymes? target word) 1 0)))
|
||||||
|
words)
|
||||||
|
|
||||||
|
[rhyming non-rhyming]
|
||||||
|
((juxt filter remove)
|
||||||
|
#(< 0 (:num-matching %))
|
||||||
|
words-with-rime-count)
|
||||||
|
|
||||||
|
weight-non-rhyming (apply + (map :weight non-rhyming))
|
||||||
|
target-weight-rhyming (* 100 percent weight-non-rhyming)
|
||||||
|
count-rhyming (count rhyming)
|
||||||
|
adjustment-rhyming (if (= 0 count-rhyming) 1 (/ target-weight-rhyming count-rhyming))]
|
||||||
|
[(concat
|
||||||
|
(map
|
||||||
|
(fn [word]
|
||||||
|
(as-> word word
|
||||||
|
(assoc word :weight (* adjustment-rhyming (:weight word)))
|
||||||
|
(assoc word :adjustment-for-rimes adjustment-rhyming)))
|
||||||
|
rhyming)
|
||||||
|
non-rhyming)
|
||||||
|
target
|
||||||
|
result])
|
||||||
|
[words target result])))
|
||||||
@ -0,0 +1,101 @@
|
|||||||
|
;; Fast weighted random selection thanks to the Vose algorithm.
|
||||||
|
;; https://gist.github.com/ghadishayban/a26cc402958ef3c7ce61
|
||||||
|
|
||||||
|
(ns com.owoga.prhyme.util.math
|
||||||
|
(:import clojure.lang.PersistentQueue))
|
||||||
|
|
||||||
|
|
||||||
|
;; Vose's alias method
|
||||||
|
;; http://www.keithschwarz.com/darts-dice-coins/
|
||||||
|
(defprotocol Rand
|
||||||
|
(nextr [_ rng]))
|
||||||
|
|
||||||
|
(deftype Vose [n ^ints alias ^doubles prob]
|
||||||
|
Rand
|
||||||
|
;; returns the index of the chosen weight
|
||||||
|
(nextr [_ rng] ;; not using the rng for now
|
||||||
|
(let [i (rand-int n)
|
||||||
|
p (aget prob i)]
|
||||||
|
(if (or (= p 1.0)
|
||||||
|
(< (rand) p))
|
||||||
|
i
|
||||||
|
(aget alias i)))))
|
||||||
|
|
||||||
|
(defn ^:private make-vose [dist]
|
||||||
|
(let [N (count dist)
|
||||||
|
alias (int-array N)
|
||||||
|
prob (double-array N)]
|
||||||
|
(if (zero? N)
|
||||||
|
(->Vose N alias prob)
|
||||||
|
(let [^doubles ps (->> dist
|
||||||
|
(map (partial * N))
|
||||||
|
(into-array Double/TYPE))
|
||||||
|
|
||||||
|
[small large] (loop [i 0
|
||||||
|
[small large] [PersistentQueue/EMPTY
|
||||||
|
PersistentQueue/EMPTY]
|
||||||
|
ps (seq ps)]
|
||||||
|
(if (seq ps)
|
||||||
|
(let [p (first ps)]
|
||||||
|
(if (< p 1)
|
||||||
|
(recur (inc i)
|
||||||
|
[(conj small i) large]
|
||||||
|
(rest ps))
|
||||||
|
(recur (inc i)
|
||||||
|
[small (conj large i)]
|
||||||
|
(rest ps))))
|
||||||
|
[small large]))
|
||||||
|
|
||||||
|
[small large] (loop [small small
|
||||||
|
large large]
|
||||||
|
(if (and (seq small) (seq large))
|
||||||
|
(let [l (first small)
|
||||||
|
g (first large)
|
||||||
|
small (pop small)
|
||||||
|
large (pop large)]
|
||||||
|
(aset-double prob l (aget ps l))
|
||||||
|
(aset-int alias l g)
|
||||||
|
(let [pg (- (+ (aget ps g) (aget ps l))
|
||||||
|
1.0)]
|
||||||
|
(aset-double ps g pg)
|
||||||
|
(if (< pg 1)
|
||||||
|
(recur (conj small g) large)
|
||||||
|
(recur small (conj large g)))))
|
||||||
|
[small large]))]
|
||||||
|
(doseq [g (concat large small)]
|
||||||
|
(aset-double prob g 1))
|
||||||
|
(->Vose N alias prob)))))
|
||||||
|
|
||||||
|
(defn from-weights [ws]
|
||||||
|
(let [N (count ws)
|
||||||
|
tot (reduce + 0.0 ws)
|
||||||
|
dist (if (zero? tot)
|
||||||
|
(repeat N (/ 1 tot))
|
||||||
|
(map #(/ % tot) ws))]
|
||||||
|
(make-vose (vec dist))))
|
||||||
|
|
||||||
|
(comment
|
||||||
|
(let [ws [1 2 1 3 3]
|
||||||
|
rng (from-weights ws)
|
||||||
|
chosen (repeatedly 1000000 #(nextr rng nil))
|
||||||
|
accuracy (mapv (comp float
|
||||||
|
#(/ % 100000)
|
||||||
|
(frequencies chosen))
|
||||||
|
(range (count ws)))]
|
||||||
|
accuracy))
|
||||||
|
|
||||||
|
(defn weighted-selection
|
||||||
|
"If given a coll, assumes the coll is weights and returns the selected index by
|
||||||
|
weighted random selection.
|
||||||
|
|
||||||
|
If given a key function and a collection, uses the key function to get a
|
||||||
|
collection of weights and returns the value at the randomly selected index."
|
||||||
|
([coll]
|
||||||
|
(let [rng (from-weights coll)
|
||||||
|
index (nextr rng nil)]
|
||||||
|
index))
|
||||||
|
([key-fn coll]
|
||||||
|
(let [rng (from-weights (map key-fn coll))
|
||||||
|
index (nextr rng nil)
|
||||||
|
selection (nth coll index)]
|
||||||
|
selection)))
|
||||||
Loading…
Reference in New Issue