Tables for rhymes, rhyming lyrics, and lyrics

main
Eric Ihli 3 years ago
parent 67dd3a0010
commit 3f7e94f607

@ -359,7 +359,6 @@
(comment
(rhymes-by-quality "boss hog")
)
(defn add-frequency-to-rhymes
@ -413,8 +412,7 @@
(string/join " ")
(nlp/most-likely-parse)
((fn [[line perplexity]]
[line (/ perplexity (count (string/split line #" ")))]))
second))
[line perplexity (/ perplexity (count (string/split line #" ")))]))))
(defn lyric-suggestions [seed-phrase trie database]
(let [realize-seed (fn [seed]
@ -432,6 +430,12 @@
(partial remove (fn [child]
(= (.key child) (database prhyme/EOS)))))))))))
(comment
(->> "democracy </s>"
(#(lyric-suggestions % models/markov-trie models/database)))
)
(defn phrase->quality-of-rhyme
"Gets the quality of rhyme of the thie highest quality pronunciation of all
combinations of phrases."
@ -449,9 +453,32 @@
first)))
(defn wgu-lyric-suggestions
"Returns lyrics rhyming with a seed phrase.
Groups rhymes by quality then orders each grouping by frequency.
Selects top 5 (Up to 20 total) from each grouping to generate lyrics.
Returns the [seed, [lyric, [it's parse, open-nlp perplexity, open-nlp per-word perplexity]]]
sorted by the per-word perplexity."
[phrase]
(let [rhymes (rhymes-by-quality phrase)
seeds (map vector rhymes (repeat "</s>"))
(let [rhymes (->> (for [[phones1 rhymes] (rhymes-with-quality-and-frequency phrase)]
(for [[phones2 rhyme] rhymes]
rhyme))
flatten
distinct)
grouped-by-quality (group-by :rhyme-quality rhymes)
top-20-by-quality (reduce
(fn [acc [_ rhymes]]
(into acc (take 5 (sort-by
(comp - :freq)
rhymes))))
[]
grouped-by-quality)
top-20-rhyme (take 20 (sort-by
(juxt (comp - :rhyme-quality)
(comp - :freq))
top-20-by-quality))
seeds (map vector (map :word top-20-rhyme) (repeat "</s>"))
lyrics (map #(lyric-suggestions
(string/join " " %)
models/markov-trie
@ -459,10 +486,14 @@
seeds)]
(->> lyrics
(map (juxt identity open-nlp-perplexity))
(sort-by (comp - second)))))
(map vector top-20-rhyme)
;; per-word perplexity
(sort-by (juxt
(comp - :rhyme-quality first)
(comp - last second second))))))
(comment
(wgu-lyric-suggestions "technology")
(take 5 (wgu-lyric-suggestions "technology"))
(phrase->quality-of-rhyme "boss hog" "brain fog")
@ -477,6 +508,7 @@
(map (juxt identity open-nlp-perplexity))
(sort-by (comp - second))))
(open-nlp-perplexity "bother me")
(->> #(lyric-suggestions "bother me </s>" models/markov-trie models/database)
repeatedly
(take 5)

@ -266,16 +266,17 @@
:opts {}}
(views/wgu request))}))
(defn lyric-suggestions [db cache]
(defn rhyming-lyric [db cache]
(fn [request]
(println (-> request :params :rhyming-lyric-target))
(let [suggestions
(repeatedly
5
10
#(linguistics/lyric-suggestions
(-> request :params :rhyme-target)
(str (-> request :params :rhyming-lyric-target) " </s>")
models/markov-trie
models/database))]
{:status 201
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (views/wrap-with-js
{:db db
@ -316,3 +317,16 @@
(comment
(linguistics/rhymes-with-quality-and-frequency "poverty"))
(defn lyrics-from-seed [db cache]
(fn [request]
(let [target (-> request :params :seed)]
{:status 200
:headers {"Content-Type" "text/html; charset=utf-8"}
:body (views/wrap-with-js
{:db db
:request request
:opts {}}
(views/lyrics-from-seed
request
(linguistics/wgu-lyric-suggestions target)))})))

@ -38,10 +38,16 @@
[""
{:name ::wgu
:get {:handler (handlers/wgu db cache)}
:post {:handler (handlers/lyric-suggestions db cache)}}]
:post {:handler (handlers/rhyming-lyric db cache)}}]
["/rhyme"
{:name ::rhyme
:get {:handler (handlers/rhymes-with-quality-and-frequency db cache)}}]]
:get {:handler (handlers/rhymes-with-quality-and-frequency db cache)}}]
["/rhyming-lyric"
{:name ::rhyming-lyric
:get {:handler (handlers/rhyming-lyric db cache)}}]
["/lyric-from-seed"
{:name ::lyric-from-seed
:get {:handler (handlers/lyrics-from-seed db cache)}}]]
["/.well-known/*" (ring/create-file-handler
{:root "resources/public/.well-known"})]]]
(timbre/info "Starting router.")

@ -5,7 +5,10 @@
[com.darklimericks.db.albums :as db.albums]
[com.darklimericks.db.artists :as db.artists]
[com.darklimericks.server.util :as util]
[com.darklimericks.server.models :as models]))
[com.darklimericks.server.models :as models]
[com.owoga.prhyme.core :as prhyme]
[com.owoga.corpus.markov :as markov]
[com.darklimericks.linguistics.core :as linguistics]))
(defn wrapper
([db request opts & body]
@ -278,7 +281,7 @@
[:div line])]]))])
(defn wgu
[request {:keys [rhymes rhyming-lyrics lyrics]}]
[request {:keys [rhymes rhyming-lyrics lyrics-from-seed]}]
[:div
[:h1 "WGU Capstone"]
[:div
@ -302,35 +305,39 @@
[:div
[:h2 "Generate Rhyming Lyric"]
(form/form-to
[:post (util/route-name->path
[:get (util/route-name->path
request
:com.darklimericks.server.router/wgu)]
:com.darklimericks.server.router/lyric-from-seed)]
(form/label
"rhyming-lyric-target"
"lyric-from-seed"
"Target word or phrase for which to find a rhyming lyric")
" "
(form/text-field
{:placeholder "instead of war on poverty"}
"rhyming-lyric-target")
"seed")
(form/submit-button
{:class "ml2"}
"Show rhyming lyrics suggestions"))]
"Generate lyric from seed word or phrase"))
(when lyrics-from-seed
lyrics-from-seed)]
[:div
[:h2 "Generate Lyrics"]
[:h2 "Generate Lyric From Seed"]
(form/form-to
[:post (util/route-name->path
[:get (util/route-name->path
request
:com.darklimericks.server.router/wgu)]
:com.darklimericks.server.router/rhyming-lyric)]
(form/label
"lyric-target"
"Seed word or phrase from which to generate lyric")
"rhyming-lyric-target"
"Target word or phrase for which to find a rhyming lyric")
" "
(form/text-field
{:placeholder "instead of war on poverty"}
"lyric-target")
"rhyming-lyric-target")
(form/submit-button
{:class "ml2"}
"Show lyrics suggestions"))]
"Show rhyming lyrics suggestions"))
(when rhyming-lyrics
rhyming-lyrics)]
[:div#myChart]
[:iframe {:src "/assets/README_WGU.htm"
:style "background-color: white; width: 100%; height: 760px;"}]])
@ -338,8 +345,23 @@
(defn lyric-suggestions
[request suggestions]
[:div
(wgu request {:rhymes (for [suggestion suggestions]
[:div suggestion])})])
(wgu
request
{:rhyming-lyrics
[:table {:style "margin: auto;"}
[:tr
[:th "Lyric"]
[:th "OpenNLP Perplexity"]
[:th "Per-word OpenNLP Perplexity"]]
(let [suggestions
(for [suggestion suggestions]
(cons suggestion (linguistics/open-nlp-perplexity suggestion)))]
(for [[suggestion parse perplexity per-word-perplexity]
(sort-by (comp - last) suggestions)]
[:tr
[:td suggestion]
[:td perplexity]
[:td per-word-perplexity]]))]})])
(defn show-rhyme-suggestion
[request suggestions]
@ -369,7 +391,6 @@
(juxt (comp - :rhyme-quality)
(comp - :freq))
top-20-by-quality))]
[:div
(wgu
request
{:rhymes
@ -377,4 +398,21 @@
[:table {:style "margin: auto;"}
[:tr [:th "Rhyme"] [:th "Pronunciation"] [:th "Quality"] [:th "Frequency"]]
(for [{:keys [word pronunciation rhyme-quality freq]} top-20-rhyme]
[:tr [:td word] [:td (String/join "-" pronunciation)] [:td rhyme-quality] [:td freq]])]]})]))
[:tr [:td word] [:td (String/join "-" pronunciation)] [:td rhyme-quality] [:td freq]])]]})))
(defn lyrics-from-seed
[request seed]
(let [suggestions (linguistics/wgu-lyric-suggestions
(-> request :params :seed))]
(wgu
request
{:lyrics-from-seed
[:div
[:table {:style "margin: autoh"}
[:tr [:th "Rhyme"] [:th "Quality"] [:th "Lyric"] [:th "Perplexity"]]
(for [[seed [line [parse perp per-word-perp]]] suggestions]
[:tr
[:td (:word seed)]
[:td (:rhyme-quality seed)]
[:td line]
[:td per-word-perp]])]]})))

Loading…
Cancel
Save