Simulate some nice rhymes with '-1' fns

main
Eric Ihli 4 years ago
parent 98ffd872ba
commit b6bdba58ad

@ -333,6 +333,27 @@
(assoc rhyme :adjust-for-rhyme-factor adjustment-rhyme))) (assoc rhyme :adjust-for-rhyme-factor adjustment-rhyme)))
rhymes))))) rhymes)))))
(defn adjust-for-membership-1
[set_ percent]
(let [ratio (- 1 percent)]
(fn [words]
(let [[members non-members]
((juxt filter remove)
#(set_ (:norm-word %))
words)
weight-non-members (apply + (map :weight non-members))
target-weight-members (* ratio weight-non-members)
count-members (count members)
adjustment-members (/ target-weight-members count-members)]
(concat
(map
(fn [member]
(as-> member member
(assoc member :weight (* adjustment-members (:weight member)))
(assoc member :adjustment-for-membership adjustment-members)))
members)
non-members)))))
(comment (comment
(let [words (->> ["distort" "kiss" "sport"] (let [words (->> ["distort" "kiss" "sport"]
(map #(frp/phrase->word frp/words %)) (map #(frp/phrase->word frp/words %))
@ -382,6 +403,49 @@
(comment (comment
(let [markov-adjuster (adjust-for-markov (lovecraft-markov '("help")))] (let [markov-adjuster (adjust-for-markov (lovecraft-markov '("help")))]
(take 5 (markov-adjuster frp/words)))) (take 5 (markov-adjuster frp/words))))
(defn adjust-for-membership-1
[set_ percent]
(let [ratio (- 1 percent)]
(fn [words]
(let [[members non-members]
((juxt filter remove)
#(set_ (:norm-word %))
words)
weight-non-members (apply + (map :weight non-members))
target-weight-members (* ratio weight-non-members)
count-members (count members)
adjustment-members (/ target-weight-members count-members)]
(concat
(map
(fn [member]
(as-> member member
(assoc member :weight (* adjustment-members (:weight member)))
(assoc member :adjustment-for-membership adjustment-members)))
members)
non-members)))))
(defn adjust-for-markov-1
[markov-options percent]
(let [ratio (- 1 percent)]
(fn [words]
(if (nil? markov-options)
words
(let [[markovs non-markovs]
((juxt filter remove)
#(markov-options (:norm-word %))
words)
weight-non-markovs (apply + (map :weight non-markovs))
target-weight-markovs (* ratio weight-non-markovs)
count-markovs (count markovs)
adjustment-markovs (/ target-weight-markovs count-markovs)]
(concat
(map
(fn [markov]
(as-> markov markov
(assoc markov :weight (* adjustment-markovs (:weight markov)))
(assoc markov :adjustment-for-markov adjustment-markovs)))
markovs)
non-markovs))))))
(defn e-prhyme (defn e-prhyme
"2020-10-21 iteration" "2020-10-21 iteration"
@ -395,15 +459,13 @@
(if (or (stop? target result) (if (or (stop? target result)
(> sentinel 5)) (> sentinel 5))
result result
(let [markov-options (markov (list (first result))) (let [markov-options (markov (list (:norm-word (first result))))
markov-adjuster (adjust-for-markov markov-options) markov-adjuster (adjust-for-markov-1 markov-options 0.8)
syllable-count-adjuster (adjust-for-over-syllables target) syllable-count-adjuster (adjust-for-over-syllables target)
rhyme-adjuster (adjust-for-rhymes-1 target 0.8) rhyme-adjuster (adjust-for-rhymes-1 target 0.8)
lovecraft-set (into #{} (map (comp first first) lovecraft-markov)) lovecraft-set (into #{} (map (comp first first) lovecraft-markov))
lovecraft-adjuster (adjust-for-membership lovecraft-set) lovecraft-filter (adjust-for-membership-1 lovecraft-set 0.8)
lovecraft-filter (filter-for-membership lovecraft-set) adjust (comp rhyme-adjuster
adjust (comp lovecraft-adjuster
rhyme-adjuster
syllable-count-adjuster syllable-count-adjuster
markov-adjuster markov-adjuster
lovecraft-filter) lovecraft-filter)
@ -427,15 +489,38 @@
(def words (map #(assoc % :weight 1) frp/words)) (def words (map #(assoc % :weight 1) frp/words))
(defn main [poem-lines]
(map
(fn [line]
(let [orig-target (frp/phrase->word frp/words line)]
(e-prhyme
frp/popular
lovecraft-markov
orig-target
(fn [target result]
(<= (count (:syllables orig-target))
(apply + (map :syllable-count result)))))))
poem-lines))
(comment (comment
(let [orig-target (frp/phrase->word frp/words "please turn on your magic beam")] (let [poem-lines ["mister sandman"
"give me a dream"
"make him the cutest"
"that i've ever seen"
"give him two lips"
"like roses in clover"
"please tell me that"
"these lonesome nights are over"]]
(map (fn [line] (map :norm-word line)) (main poem-lines)))
(let [orig-target (frp/phrase->word frp/words "mister sandman give me a dream")]
(repeatedly (repeatedly
10 10
(fn [] (fn []
(e-prhyme (e-prhyme
frp/words frp/popular
lovecraft-markov lovecraft-markov
(frp/phrase->word frp/words "please turn on your magic beam") orig-target
(fn [target result] (fn [target result]
(<= (count (:syllables orig-target)) (<= (count (:syllables orig-target))
(apply + (map :syllable-count result))))))))) (apply + (map :syllable-count result)))))))))

Loading…
Cancel
Save