diff --git a/web/src/com/darklimericks/linguistics/core.clj b/web/src/com/darklimericks/linguistics/core.clj index b0cafd2..99ed7bd 100644 --- a/web/src/com/darklimericks/linguistics/core.clj +++ b/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,12 +321,59 @@ ) +(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)) - butlast - rest)))] + (data-transform/untokenize + (-> (map database (reverse seed)) + butlast + rest)))] (loop [seed (vec (reverse (map #(get database % 0) (string/split seed-phrase #" "))))] (cond (< 20 (count seed)) (realize-seed seed) @@ -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 " models/markov-trie models/database) + (phrase->quality-of-rhyme "boss hog" "brain fog") + + (->> #(lyric-suggestions "bother me " models/markov-trie models/database) + repeatedly + (take 5) + (map (juxt identity open-nlp-perplexity (partial phrase->quality-of-rhyme "bother me")))) ) diff --git a/web/src/com/darklimericks/server/models.clj b/web/src/com/darklimericks/server/models.clj index 583dc27..ba1e2a6 100644 --- a/web/src/com/darklimericks/server/models.clj +++ b/web/src/com/darklimericks/server/models.clj @@ -29,28 +29,34 @@ (every? phonetics/consonant (butlast phones))))) (comment - (let [result {'[a 8] - [[[["P" "AE1" "S"] "pass"] - [["P" "ER0" "EH1" "N" "IY0" "AH0" "L" "IY0"] "perennially"] - [["Y" "UW1"] "you"] - [["T" "UW1"] "to"]] - [[["OW1" "V" "ER0" "P" "AE2" "S"] "overpass"] - [["AH0" "N"] "an"] - [["AO1" "N"] "on"] - [["M" "AH0" "N" "IH2" "P" "Y" "AH0" "L" "EY1" "SH" "AH0" "N"] - "manipulation"]] - [[["M" "IH1" "D" "AH0" "L" "K" "L" "AE1" "S"] "middle-class"] - [["HH" "AY1" "D" "IH0" "NG"] "hiding"] - [["M" "AA1" "N" "S" "T" "ER0"] "monster"] - [["K" "R" "UW1" "AH0" "L"] "cruel"]]], - '[b 5] - [[[["R" "EY1" "S"] "race"] - [["M" "AH0" "T" "IH1" "R" "IY0" "AH0" "L"] "material"]] - [[["B" "AO1" "R" "G" "EY0" "S"] "borges"] - [["IY2" "K" "W" "AH0" "L" "IH1" "B" "R" "IY0" "AH0" "M"] "equilibrium"]]]} - [[a1 a2 a2] [b1 b2]] (vals result)] - (->> [a1 a2 b1] - (map reverse) - (map (partial map second)))) + (->> ["AA1" "ER0" "IY0"] + (markov/rhymes rhyme-trie-unstressed-trailing-consonants) + (map (fn append-quality-of-rhyme [[phones1 words]] + [phones1 (->> (mapcat prhyme/phrase->all-phones words) + (map (fn [[phones2 word]] + [phones2 word (prhyme/quality-of-rhyme-phones phones1 phones2)])))])) + (mapcat (fn sort-by-quality-of-rhyme [[phones1 words]] + [phones1 (sort-by (fn [[_ _ quality]] + (- quality)) + words)])) + (take 20)) + + (->> "bother me" + (prhyme/phrase->all-phones) + (map first) + (map + (fn [phones] + [phones (markov/rhymes 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)) ) diff --git a/web/wgu-app/package-lock.json b/web/wgu-app/package-lock.json index 2e356cc..5edab95 100644 --- a/web/wgu-app/package-lock.json +++ b/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", diff --git a/web/wgu-app/package.json b/web/wgu-app/package.json index 0163f3e..0e68bc4 100644 --- a/web/wgu-app/package.json +++ b/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", diff --git a/web/wgu-app/shadow-cljs.edn b/web/wgu-app/shadow-cljs.edn index 7c514e9..6ce2520 100644 --- a/web/wgu-app/shadow-cljs.edn +++ b/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}}}}}}