Tables for rhymes, rhyming lyrics, and lyrics

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 </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)

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) " </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)))})))

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.")

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]])]]})))