More WGU code

web/src/com/darklimericks/linguistics/core.clj

@@ -10,7 +10,8 @@
             [com.owoga.phonetics.stress-manip :as stress-manip]
             [clojure.math.combinatorics :as combinatorics]
             [com.owoga.prhyme.nlp.core :as nlp]
-            [com.owoga.prhyme.data-transform :as data-transform]))
+            [com.owoga.prhyme.data-transform :as data-transform]
+            [com.owoga.trie :as trie]))
 
 (defn gen-artist []
   (->> [(rand-nth (seq dict/adjectives))
@@ -322,6 +323,7 @@
   )
 
 (defn rhymes-by-quality
+  "Returns rhyming word, pronunciation, rhyme quality, and n-gram frequency."
   [seed-phrase]
   (->> seed-phrase
        (prhyme/phrase->all-phones)
@@ -345,14 +347,62 @@
               [phones1 (sort-by (fn [[_ _ quality]]
                                   (- quality))
                                 words)]))
-       (mapcat second)
+       (reduce
+        (fn convert-to-hashmap [acc [pronunciation rhyming-words]]
+          (reduce (fn [acc [phones word rhyme-quality]]
+                    (assoc-in acc [pronunciation phones] {:word word :rhyme-quality rhyme-quality}))
+                  acc
+                  rhyming-words))
+        {})
+       #_#_#_#_(mapcat second)
        (sort-by #(- (nth % 2)))
        (take 20)
        (map second)))
 
 (comment
-  (rhymes-by-quality "bother me")
+  (rhymes-by-quality "boss hog")
+
+  )
 
+(defn add-frequency-to-rhymes
+  [rhymes trie database]
+  (reduce
+   (fn [acc [pronunciation rhyming-words]]
+     (reduce
+      (fn [acc [phones word]]
+        (assoc-in acc [pronunciation phones :freq] (second (get trie [(database (:word word))]))))
+      acc
+      rhyming-words))
+   rhymes
+   rhymes))
+
+(defn rhymes-with-quality-and-frequency
+  [phrase]
+  (-> (rhymes-by-quality phrase)
+      (add-frequency-to-rhymes models/markov-trie models/database)))
+
+(comment
+  (-> (rhymes-by-quality "boss hog")
+      (add-frequency-to-rhymes models/markov-trie models/database))
+
+  {("B" "AA1" "S" "HH" "AA1" "G")
+   {("D" "EH1" "M" "AH0" "G" "AA2" "G")
+    {:word "demagogue", :rhyme-quality 1, :freq 20},
+    ("B" "AE1" "K" "L" "AA2" "G") {:word "backlog", :rhyme-quality 2, :freq 1},
+    ("HH" "EH1" "JH" "HH" "AA2" "G")
+    {:word "hedgehog", :rhyme-quality 2, :freq 2},
+    ,,,
+    ("AA1" "G") {:word "og", :rhyme-quality 4, :freq 134},
+    ("P" "R" "OW1" "L" "AA0" "G")
+    {:word "prologue", :rhyme-quality 2, :freq 25}},
+   ("B" "AO1" "S" "HH" "AA1" "G")
+   {("D" "EH1" "M" "AH0" "G" "AA2" "G")
+    {:word "demagogue", :rhyme-quality 1, :freq 20},
+    ("B" "AE1" "K" "L" "AA2" "G") {:word "backlog", :rhyme-quality 2, :freq 1},
+    ("HH" "EH1" "JH" "HH" "AA2" "G")
+    {:word "hedgehog", :rhyme-quality 2, :freq 2},
+    ,,,
+    ("P" "R" "OW1" "L" "AA0" "G") {:word "prologue", :rhyme-quality 2, :freq 25}}}
   )
 
 (defn open-nlp-perplexity

web/src/com/darklimericks/server/handlers.clj

@@ -23,7 +23,9 @@
 (defmethod ig/init-key ::handler [_ {:keys [router]}]
   (http/ring-handler
    router
-   (ring/create-default-handler)
+   (ring/routes
+    (ring/redirect-trailing-slash-handler)
+    (ring/create-default-handler))
    {:executor sieppari/executor}))
 
 (defn home-handler
@@ -298,3 +300,16 @@
               (views/show-rhyme-suggestion
                request
                suggestions))})))
+
+(defn rhymes-with-quality-and-frequency [db cache]
+  (fn [request]
+    (let [target (-> request :params :rhyme-target)]
+      {:status 200
+       :headers {"Content-Type" "text/html; charset=utf-8"}
+       :body (views/wrap-with-js
+              {:db db
+               :request request
+               :opts {}}
+              (views/rhymes-with-quality-and-frequency
+               request
+               (linguistics/rhymes-with-quality-and-frequency target)))})))

web/src/com/darklimericks/server/router.clj

@@ -35,9 +35,13 @@
                    :get {:handler (handlers/artist-get-handler db)}}]]
                 ["/assets/*" handlers/file-handler]
                 ["/wgu"
+                 [""
                   {:name ::wgu
                    :get {:handler (handlers/wgu db cache)}
                    :post {:handler (handlers/lyric-suggestions db cache)}}]
+                 ["/rhyme"
+                  {:name ::rhyme
+                   :get {:handler (handlers/lyric-suggestions db cache)}}]]
                 ["/.well-known/*" (ring/create-file-handler
                                    {:root "resources/public/.well-known"})]]]
     (timbre/info "Starting router.")

web/src/com/darklimericks/server/views.clj

@@ -277,9 +277,11 @@
            [:div line])]]))])
 
 (defn wgu
-  [request]
+  [request {:keys [rhymes rhyming-lyrics lyrics]}]
   [:div
    [:h1 "WGU Capstone"]
+   [:div
+    [:h2 "Generate Rhyme"]
     (form/form-to
      [:post (util/route-name->path
              request
@@ -294,6 +296,40 @@
      (form/submit-button
       {:class "ml2"}
       "Show rhyme suggestions"))
+    (when rhymes
+      rhymes)]
+   [:div
+    [:h2 "Generate Rhyming Lyric"]
+    (form/form-to
+     [:post (util/route-name->path
+             request
+             :com.darklimericks.server.router/wgu)]
+     (form/label
+      "rhyming-lyric-target"
+      "Target word or phrase for which to find a rhyming lyric")
+     " "
+     (form/text-field
+      {:placeholder "instead of war on poverty"}
+      "rhyming-lyric-target")
+     (form/submit-button
+      {:class "ml2"}
+      "Show rhyming lyrics suggestions"))]
+   [:div
+    [:h2 "Generate Lyrics"]
+    (form/form-to
+     [:post (util/route-name->path
+             request
+             :com.darklimericks.server.router/wgu)]
+     (form/label
+      "lyric-target"
+      "Seed word or phrase from which to generate lyric")
+     " "
+     (form/text-field
+      {:placeholder "instead of war on poverty"}
+      "lyric-target")
+     (form/submit-button
+      {:class "ml2"}
+      "Show lyrics suggestions"))]
    [:div#myChart]
    [:iframe {:src "/assets/README_WGU.htm"
              :style "background-color: white; width: 100%; height: 760px;"}]])
@@ -301,13 +337,17 @@
 (defn lyric-suggestions
   [request suggestions]
   [:div
-   (wgu request)
+   (wgu request {:rhymes (for [suggestion suggestions]
-   (for [suggestion suggestions]
+                           [:div suggestion])})])
-     [:div suggestion])])
 
 (defn show-rhyme-suggestion
   [request suggestions]
   [:div
-   (wgu request)
+   (wgu
+    request
+    {:rhymes
      (for [[suggestion p1 freq _ p2 quality] suggestions]
-     [:div (string/join " - " [suggestion freq p1 p2])])])
+       [:div (string/join " - " [suggestion freq p1 p2])])})])
+
+(defn rhymes-with-quality-and-frequency
+  [])