Add some functions for graphs

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

@@ -8,7 +8,9 @@
             [com.owoga.phonetics :as phonetics]
             [com.owoga.phonetics.syllabify :as syllabify]
             [com.owoga.phonetics.stress-manip :as stress-manip]
-            [clojure.math.combinatorics :as combinatorics]))
+            [clojure.math.combinatorics :as combinatorics]
+            [com.owoga.prhyme.nlp.core :as nlp]
+            [com.owoga.prhyme.data-transform :as data-transform]))
 
 (defn gen-artist []
   (->> [(rand-nth (seq dict/adjectives))
@@ -319,10 +321,57 @@
 
   )
 
+(defn rhymes-by-quality
+  [seed-phrase]
+  (->> seed-phrase
+       (prhyme/phrase->all-phones)
+       (map first)
+       (map
+        (fn [phones]
+          [phones (markov/rhymes
+                   models/rhyme-trie-unstressed-trailing-consonants
+                   phones)]))
+       (map (fn append-quality-of-rhyme [[phones1 words]]
+              [phones1 (->> (mapcat
+                             prhyme/phrase->all-phones
+                             (reduce into #{} (map second words)))
+                            (map (fn [[phones2 word]]
+                                   [phones2
+                                    word
+                                    (prhyme/quality-of-rhyme-phones
+                                     phones1
+                                     phones2)])))]))
+       (map (fn sort-by-quality-of-rhyme [[phones1 words]]
+              [phones1 (sort-by (fn [[_ _ quality]]
+                                  (- quality))
+                                words)]))
+       (mapcat second)
+       (sort-by #(- (nth % 2)))
+       (take 20)
+       (map second)))
+
+(comment
+  (rhymes-by-quality "bother me")
+
+  )
+
+(defn open-nlp-perplexity
+  "Returns the perplexity of the parse tree using OpenNLP.
+  This is an alternative to the perplexity of the Markov model.
+  Normalized per word because long sentences are naturally more perplex."
+  [phrase]
+  (->> phrase
+       nlp/tokenize
+       (string/join " ")
+       (nlp/most-likely-parse)
+       ((fn [[line perplexity]]
+          [line (/ perplexity (count (string/split line #" ")))]))
+       second))
 
 (defn lyric-suggestions [seed-phrase trie database]
   (let [realize-seed (fn [seed]
-                       (string/join " " (-> (map database (reverse seed))
+                       (data-transform/untokenize
+                        (-> (map database (reverse seed))
                             butlast
                             rest)))]
     (loop [seed (vec (reverse (map #(get database % 0) (string/split seed-phrase #" "))))]
@@ -335,7 +384,28 @@
                                  (partial remove (fn [child]
                                                    (= (.key child) (database prhyme/EOS)))))))))))
 
+(defn phrase->quality-of-rhyme
+  "Gets the quality of rhyme of the thie highest quality pronunciation of all
+  combinations of phrases."
+  [phrase1 phrase2]
+  (let [phones1 (prhyme/phrase->all-phones phrase1)
+        phones2 (prhyme/phrase->all-phones phrase2)
+        all-possible-rhyme-combinations (combinatorics/cartesian-product
+                                         phones1
+                                         phones2)]
+    (->> all-possible-rhyme-combinations
+         (map (partial map first))
+         (map (juxt identity
+                    (partial apply quality-of-rhyme-phones)))
+         (sort-by (comp - second))
+         first)))
+
 (comment
-  (lyric-suggestions "bother me </s>" models/markov-trie models/database)
+  (phrase->quality-of-rhyme "boss hog" "brain fog")
+
+  (->> #(lyric-suggestions "bother me </s>" models/markov-trie models/database)
+       repeatedly
+       (take 5)
+       (map (juxt identity open-nlp-perplexity (partial phrase->quality-of-rhyme "bother me"))))
 
   )

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

@@ -29,28 +29,34 @@
      (every? phonetics/consonant (butlast phones)))))
 
 (comment
-  (let [result {'[a 8]
+  (->> ["AA1" "ER0" "IY0"]
-                [[[["P" "AE1" "S"] "pass"]
+       (markov/rhymes rhyme-trie-unstressed-trailing-consonants)
-                  [["P" "ER0" "EH1" "N" "IY0" "AH0" "L" "IY0"] "perennially"]
+       (map (fn append-quality-of-rhyme [[phones1 words]]
-                  [["Y" "UW1"] "you"]
+              [phones1 (->> (mapcat prhyme/phrase->all-phones words)
-                  [["T" "UW1"] "to"]]
+                            (map (fn [[phones2 word]]
-                 [[["OW1" "V" "ER0" "P" "AE2" "S"] "overpass"]
+                                   [phones2 word (prhyme/quality-of-rhyme-phones phones1 phones2)])))]))
-                  [["AH0" "N"] "an"]
+       (mapcat (fn sort-by-quality-of-rhyme [[phones1 words]]
-                  [["AO1" "N"] "on"]
+                 [phones1 (sort-by (fn [[_ _ quality]]
-                  [["M" "AH0" "N" "IH2" "P" "Y" "AH0" "L" "EY1" "SH" "AH0" "N"]
+                                     (- quality))
-                   "manipulation"]]
+                                   words)]))
-                 [[["M" "IH1" "D" "AH0" "L" "K" "L" "AE1" "S"] "middle-class"]
+       (take 20))
-                  [["HH" "AY1" "D" "IH0" "NG"] "hiding"]
+
-                  [["M" "AA1" "N" "S" "T" "ER0"] "monster"]
+  (->> "bother me"
-                  [["K" "R" "UW1" "AH0" "L"] "cruel"]]],
+       (prhyme/phrase->all-phones)
-                '[b 5]
+       (map first)
-                [[[["R" "EY1" "S"] "race"]
+       (map
-                  [["M" "AH0" "T" "IH1" "R" "IY0" "AH0" "L"] "material"]]
+        (fn [phones]
-                 [[["B" "AO1" "R" "G" "EY0" "S"] "borges"]
+          [phones (markov/rhymes rhyme-trie-unstressed-trailing-consonants phones)]))
-                  [["IY2" "K" "W" "AH0" "L" "IH1" "B" "R" "IY0" "AH0" "M"] "equilibrium"]]]}
+       (map (fn append-quality-of-rhyme [[phones1 words]]
-        [[a1 a2 a2] [b1 b2]] (vals result)]
+              [phones1 (->> (mapcat prhyme/phrase->all-phones (reduce into #{} (map second words)))
-    (->> [a1 a2 b1]
+                            (map (fn [[phones2 word]]
-         (map reverse)
+                                   [phones2 word (prhyme/quality-of-rhyme-phones phones1 phones2)])))]))
-         (map (partial map second))))
+       (map (fn sort-by-quality-of-rhyme [[phones1 words]]
+              [phones1 (sort-by (fn [[_ _ quality]]
+                                  (- quality))
+                                words)]))
+       (mapcat second)
+       (sort-by #(- (nth % 2)))
+       (take 20))
 
   )

web/wgu-app/package-lock.json

@@ -649,6 +649,11 @@
         }
       }
     },
+    "highlight.js": {
+      "version": "11.1.0",
+      "resolved": "https://registry.npmjs.org/highlight.js/-/highlight.js-11.1.0.tgz",
+      "integrity": "sha512-X9VVhYKHQPPuwffO8jk4bP/FVj+ibNCy3HxZZNDXFtJrq4O5FdcdCDRIkDis5MiMnjh7UwEdHgRZJcHFYdzDdA=="
+    },
     "hmac-drbg": {
       "version": "1.0.1",
       "resolved": "https://registry.npmjs.org/hmac-drbg/-/hmac-drbg-1.0.1.tgz",

web/wgu-app/package.json

@@ -7,6 +7,7 @@
   },
   "dependencies": {
     "chart.js": "^3.4.0",
+    "highlight.js": "11.1.0",
     "react": "16.13.0",
     "react-dom": "16.13.0",
     "vega": "^5.20.2",

web/wgu-app/shadow-cljs.edn

@@ -6,11 +6,26 @@
 
  :dependencies
  [[metasoarous/oz "1.6.0-alpha34"]
-  [cljs-ajax/cljs-ajax "0.8.3"]]
+  [cljs-ajax/cljs-ajax "0.8.3"]
-
+  [day8.re-frame/re-frame-10x "1.1.11"]
+  [bidi "2.1.6"]
+  [clj-commons/pushy "0.3.10"]
+  [binaryage/devtools "1.0.3"]
+  [reagent "1.1.0"]
+  [re-frame "1.2.0"]
+  [day8.re-frame/tracing "0.6.2"]]
  :builds
  {:frontend
   {:target :browser
    :output-dir "../resources/public/wgu/"
    :assets-path "/assets/"
-   :modules {:main {:init-fn wgu.app/init}}}}}
+   :modules {:main {:init-fn wgu.app/init}}
+   :devtools {:preloads [day8.re-frame-10x.preload]}
+   :dev {:compiler-options
+         {:closure-defines
+          {re-frame.trace.trace-enabled? true
+           day8.re-frame.tracing.trace-enabled? true}}}
+   :release
+   {:build-options
+    {:ns-aliases
+     {day8.re-frame.tracing day8.re-frame.tracing-stubs}}}}}}