From a5d3bbabb68c5d0d189c95dd62c5e7eb841263f0 Mon Sep 17 00:00:00 2001 From: Eric Ihli Date: Thu, 24 Jun 2021 13:55:57 -0500 Subject: [PATCH] Add ability to grade rhymes by quality --- web/deps.edn | 2 +- .../com/darklimericks/linguistics/core.clj | 141 +++++++++++++++++- web/src/com/darklimericks/server/handlers.clj | 8 +- .../com/darklimericks/server/limericks.clj | 40 +---- web/src/com/darklimericks/server/models.clj | 39 +++++ web/src/com/darklimericks/server/views.clj | 4 +- 6 files changed, 183 insertions(+), 51 deletions(-) diff --git a/web/deps.edn b/web/deps.edn index 5380f90..e2abb1f 100644 --- a/web/deps.edn +++ b/web/deps.edn @@ -19,7 +19,7 @@ ring/ring-core {:mvn/version "1.8.2"} environ {:mvn/version "1.2.0"} prhyme {:local/root "/home/eihli/src/prhyme"} - com.owoga/phonetics {:mvn/version "0.1.3"}} + com.owoga/phonetics {:local/root "/home/eihli/src/phonetics"}} :paths ["src" "resources"] :aliases {:dev {:extra-paths ["dev"] :extra-deps {hawk {:mvn/version "0.2.11"} diff --git a/web/src/com/darklimericks/linguistics/core.clj b/web/src/com/darklimericks/linguistics/core.clj index 4e70187..7759f11 100644 --- a/web/src/com/darklimericks/linguistics/core.clj +++ b/web/src/com/darklimericks/linguistics/core.clj @@ -1,9 +1,12 @@ (ns com.darklimericks.linguistics.core (:require [com.owoga.prhyme.data.dictionary :as dict] [com.owoga.prhyme.core :as prhyme] + [com.owoga.prhyme.util :as util] [com.darklimericks.server.models :as models] [com.owoga.corpus.markov :as markov] - [clojure.string :as string])) + [clojure.string :as string] + [com.owoga.phonetics :as phonetics] + [com.owoga.phonetics.stress-manip :as stress-manip])) (defn gen-artist [] (->> [(rand-nth (seq dict/adjectives)) @@ -17,19 +20,143 @@ (map string/capitalize) (string/join " "))) +(defn perfect-rhyme + [phones] + (->> phones + reverse + (util/take-through stress-manip/primary-stress?) + first + reverse + (#(cons (first %) + (stress-manip/remove-any-stress-signifiers (rest %)))))) +(comment + (perfect-rhyme (first (phonetics/get-phones "technology"))) + ;; => ("AA1" "L" "AH" "JH" "IY") + ) + +(defn perfect-rhyme-sans-consonants + [phones] + (->> phones + perfect-rhyme + (remove phonetics/consonant))) + +(comment + (perfect-rhyme-sans-consonants (first (phonetics/get-phones "technology"))) + ;; => ("AA1" "AH" "IY") + ) + +(defn perfect-rhyme? + [phones1 phones2] + (apply = (map perfect-rhyme [phones1 phones2]))) + +(defn perfect-rhyme-sans-consonants? + [phones1 phones2] + (apply = (map perfect-rhyme-sans-consonants [phones1 phones2]))) + +(comment + (apply perfect-rhyme? (map (comp first phonetics/get-phones) ["technology" "ecology"]));; => true + (apply perfect-rhyme? (map (comp first phonetics/get-phones) ["technology" "economy"]));; => false + (apply perfect-rhyme-sans-consonants? (map (comp first phonetics/get-phones) ["technology" "economy"]));; => true + (apply perfect-rhyme-sans-consonants? (map (comp first phonetics/get-phones) ["technology" "trilogy"]));; => false + (apply perfect-rhyme? (map (comp first phonetics/get-phones) ["bother me" "poverty"])) + (apply perfect-rhyme? (map (comp first phonetics/phrase-phones) ["bother me" "poverty"])) + (phonetics/phrase-phones "bother me");; => [["B" "AA1" "DH" "ER0" "M" "IY1"]] + (phonetics/phrase-phones "poverty");; => [["P" "AA1" "V" "ER0" "T" "IY0"]] + ) + +(defn number-of-matching-vowels-with-stress + [phones1 phones2] + (let [[vowels1 vowels2] (map (partial filter phonetics/vowel?) [phones1 phones2])] + (->> [vowels1 vowels2] + (apply map vector) + (filter (partial apply =)) + (filter (comp (partial re-find #"1") first)) + count))) + +(comment + (apply + number-of-matching-vowels-with-stress + (map first (map phonetics/get-phones ["technology" "ecology"]))) + (apply + number-of-matching-vowels-with-stress + (map first (map phonetics/get-phones ["biology" "ecology"]))) + ) + +(defn number-of-matching-vowels-any-stress + [phones1 phones2] + (let [[vowels1 vowels2] (map (partial filter phonetics/vowel?) [phones1 phones2])] + (->> [vowels1 vowels2] + (map (partial map phonetics/remove-stress)) + (apply map vector) + (filter (partial apply =)) + count))) + +(comment + (apply + number-of-matching-vowels-any-stress + (map first (map phonetics/get-phones ["economy" "ecology"]))) + (apply + number-of-matching-vowels-any-stress + (map first (map phonetics/get-phones ["biology" "ecology"]))) + ) + +(defn quality-of-rhyme-phones + "Points for: + - Perfect rhyme + - Perfect rhyme sans consonants + - Number of matching stressed vowels + - Number of matching any-stressed vowels + " + [phones1 phones2] + (let [perfect? (if (perfect-rhyme? phones1 phones2) 1 0) + perfect-sans-consonants? (if (perfect-rhyme-sans-consonants? phones1 phones2) 1 0) + num-matching-stressed (number-of-matching-vowels-with-stress phones1 phones2) + num-matching-any-stress (number-of-matching-vowels-any-stress phones1 phones2)] + (println perfect? perfect-sans-consonants? num-matching-stressed num-matching-any-stress) + (+ perfect? + perfect-sans-consonants? + num-matching-stressed + num-matching-any-stress))) + +(comment + (->> [["economy" "ecology"] + ["biology" "ecology"] + ["bother me" "poverty"] + ["property" "properly"]] + (map (partial map (comp first phonetics/phrase-phones))) + (map (partial apply quality-of-rhyme-phones))) + + ) (defn rhymes "All rhymes. Slightly flexible. Ordered by number of rhyming syllables. Most generic and likely desired rhyming algorithm." [target] - (->> (prhyme/phrase->all-flex-rhyme-tailing-consonants-phones target) - (map first) - (map reverse) - (mapcat (partial markov/rhyme-choices models/rhyme-trie)) - (sort-by (comp - count first)) - (mapcat second))) + (->> target + (phonetics/get-phones) + (mapcat (partial + markov/rhymes + models/rhyme-trie-unstressed-trailing-consonants)) + (mapcat second))) + +(defn rhymes-with-frequencies + [target trie database] + (let [rhymes- (rhymes target) + freqs (map + (comp + (fnil int 0) + second + (partial get models/markov-trie) + (partial conj [1 1 1]) + database) + rhymes-)] + (distinct (sort-by (comp - second) (map vector rhymes- freqs))))) (comment + (markov/rhymes models/rhyme-trie-unstressed-trailing-consonants (phonetics/get-phones "food")) (rhymes "food") + (get models/markov-trie [(models/database "food")]) + (rhymes-with-frequencies "technology" models/markov-trie models/database) + ) diff --git a/web/src/com/darklimericks/server/handlers.clj b/web/src/com/darklimericks/server/handlers.clj index b3e6f98..c94b94f 100644 --- a/web/src/com/darklimericks/server/handlers.clj +++ b/web/src/com/darklimericks/server/handlers.clj @@ -17,7 +17,8 @@ [com.darklimericks.db.artists :as db.artists] [com.darklimericks.server.views :as views] [com.darklimericks.server.limericks :as limericks] - [com.darklimericks.linguistics.core :as linguistics])) + [com.darklimericks.linguistics.core :as linguistics] + [com.darklimericks.server.models :as models])) (defmethod ig/init-key ::handler [_ {:keys [router]}] (http/ring-handler @@ -265,7 +266,10 @@ (defn show-rhyme-suggestion [db cache] (fn [request] - (let [suggestions (linguistics/rhymes (:rhyme-target (:params request)))] + (let [suggestions (linguistics/rhymes-with-frequencies + (:rhyme-target (:params request)) + models/markov-trie + models/database)] {:status 201 :headers {"Content-Type" "text/html; charset=utf-8"} :body (views/wrapper diff --git a/web/src/com/darklimericks/server/limericks.clj b/web/src/com/darklimericks/server/limericks.clj index a7366c3..41e5535 100644 --- a/web/src/com/darklimericks/server/limericks.clj +++ b/web/src/com/darklimericks/server/limericks.clj @@ -118,43 +118,6 @@ ) -(def rhyme-trie-unstressed-trailing-consonants - (markov/->RhymeTrie - models/rhyme-trie - (fn [phones] - (->> phones - prhyme/take-vowels-and-tail-consonants - prhyme/remove-all-stress)) - (fn [phones choices] - (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)))) - - ) (defn generate-limerick-worker [db message] (timbre/info "Begin generate limerick worker.") @@ -166,8 +129,7 @@ scheme models/database models/markov-trie - rhyme-trie-unstressed-trailing-consonants)) - + models/rhyme-trie-unstressed-trailing-consonants)) limerick (->> [a1 a2 b1 b2 a3] (map reverse) (map (partial map second)) diff --git a/web/src/com/darklimericks/server/models.clj b/web/src/com/darklimericks/server/models.clj index d238887..583dc27 100644 --- a/web/src/com/darklimericks/server/models.clj +++ b/web/src/com/darklimericks/server/models.clj @@ -2,6 +2,8 @@ (:require [taoensso.nippy :as nippy] [com.owoga.trie :as trie] [com.owoga.tightly-packed-trie :as tpt] + [com.owoga.prhyme.core :as prhyme] + [com.owoga.phonetics :as phonetics] [clojure.java.io :as io] [com.owoga.corpus.markov :as markov])) @@ -15,3 +17,40 @@ (def markov-trie (tpt/load-tightly-packed-trie-from-file (io/resource "models/markov-tightly-packed-trie-4-gram-backwards.bin") (markov/decode-fn database))) + +(def rhyme-trie-unstressed-trailing-consonants + (markov/->RhymeTrie + rhyme-trie + (fn [phones] + (->> phones + prhyme/take-vowels-and-tail-consonants + prhyme/remove-all-stress)) + (fn [phones choices] + (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)))) + + ) diff --git a/web/src/com/darklimericks/server/views.clj b/web/src/com/darklimericks/server/views.clj index 09f297a..1f3866f 100644 --- a/web/src/com/darklimericks/server/views.clj +++ b/web/src/com/darklimericks/server/views.clj @@ -210,5 +210,5 @@ [request suggestions] [:div (wgu request) - (for [suggestion suggestions] - [:div suggestion])]) + (for [[suggestion freq] suggestions] + [:div suggestion freq])])