diff --git a/web/src/com/darklimericks/linguistics/core.clj b/web/src/com/darklimericks/linguistics/core.clj index ba03e68..0fe5355 100644 --- a/web/src/com/darklimericks/linguistics/core.clj +++ b/web/src/com/darklimericks/linguistics/core.clj @@ -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 " + (#(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 "")) + (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 "")) 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 " models/markov-trie models/database) repeatedly (take 5) diff --git a/web/src/com/darklimericks/server/handlers.clj b/web/src/com/darklimericks/server/handlers.clj index 7cf9344..b6473e1 100644 --- a/web/src/com/darklimericks/server/handlers.clj +++ b/web/src/com/darklimericks/server/handlers.clj @@ -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) " ") 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)))}))) diff --git a/web/src/com/darklimericks/server/router.clj b/web/src/com/darklimericks/server/router.clj index d306ac2..4b15b15 100644 --- a/web/src/com/darklimericks/server/router.clj +++ b/web/src/com/darklimericks/server/router.clj @@ -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.") diff --git a/web/src/com/darklimericks/server/views.clj b/web/src/com/darklimericks/server/views.clj index 56518ca..ca88f53 100644 --- a/web/src/com/darklimericks/server/views.clj +++ b/web/src/com/darklimericks/server/views.clj @@ -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,12 +391,28 @@ (juxt (comp - :rhyme-quality) (comp - :freq)) top-20-by-quality))] - [:div - (wgu - request - {:rhymes - [:div - [: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]])]]})])) + (wgu + request + {:rhymes + [:div + [: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]])]]}))) + +(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]])]]})))