diff --git a/web/src/com/darklimericks/linguistics/core.clj b/web/src/com/darklimericks/linguistics/core.clj index 7759f11..603219a 100644 --- a/web/src/com/darklimericks/linguistics/core.clj +++ b/web/src/com/darklimericks/linguistics/core.clj @@ -6,7 +6,9 @@ [com.owoga.corpus.markov :as markov] [clojure.string :as string] [com.owoga.phonetics :as phonetics] - [com.owoga.phonetics.stress-manip :as stress-manip])) + [com.owoga.phonetics.syllabify :as syllabify] + [com.owoga.phonetics.stress-manip :as stress-manip] + [clojure.math.combinatorics :as combinatorics])) (defn gen-artist [] (->> [(rand-nth (seq dict/adjectives)) @@ -69,6 +71,7 @@ [phones1 phones2] (let [[vowels1 vowels2] (map (partial filter phonetics/vowel?) [phones1 phones2])] (->> [vowels1 vowels2] + (map reverse) (apply map vector) (filter (partial apply =)) (filter (comp (partial re-find #"1") first)) @@ -78,9 +81,11 @@ (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 @@ -88,6 +93,7 @@ (let [[vowels1 vowels2] (map (partial filter phonetics/vowel?) [phones1 phones2])] (->> [vowels1 vowels2] (map (partial map phonetics/remove-stress)) + (map reverse) (apply map vector) (filter (partial apply =)) count))) @@ -96,49 +102,99 @@ (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 same-number-of-syllables? + [phones1 phones2] + (apply = (map (comp count syllabify/syllabify) [phones1 phones2]))) + +(comment + (apply + same-number-of-syllables? + (map first (map phonetics/get-phones ["economy" "ecology"]))) + + (apply + same-number-of-syllables? + (map first (map phonetics/get-phones ["numerology" "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 + - Same number of syllables " [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) + num-matching-any-stress (number-of-matching-vowels-any-stress phones1 phones2) + same-number-of-syllables (same-number-of-syllables? phones1 phones2)] (+ perfect? perfect-sans-consonants? num-matching-stressed - num-matching-any-stress))) + num-matching-any-stress + same-number-of-syllables))) (comment (->> [["economy" "ecology"] ["biology" "ecology"] ["bother me" "poverty"] - ["property" "properly"]] + ["property" "properly"] + ["bother me" "invincibility"] + ["invincibility" "bother me"]] (map (partial map (comp first phonetics/phrase-phones))) (map (partial apply quality-of-rhyme-phones))) + (phonetics/phrase-phones "bother me") + (phonetics/phrase-phones "invincibility") + + (let [phones1 ["B" "AA1" "DH" "ER0" "M" "IY1"] + phones2 ["IH2" "N" "V" "IH2" "N" "S" "AH0" "B" "IH1" "L" "IH0" "T" "IY0"]] + (perfect-rhyme-sans-consonants? phones1 phones2)) + ) + (defn rhymes "All rhymes. Slightly flexible. Ordered by number of rhyming syllables. Most generic and likely desired rhyming algorithm." [target] (->> target - (phonetics/get-phones) + (phonetics/phrase-phones) (mapcat (partial markov/rhymes models/rhyme-trie-unstressed-trailing-consonants)) (mapcat second))) +(comment + (rhymes "bother me") + + ) + +(defn rhymes-with-phones + "All rhymes. Slightly flexible. Ordered by number of rhyming syllables. + Most generic and likely desired rhyming algorithm." + [target] + (let [pronunciations (phonetics/phrase-phones target)] + (->> pronunciations + (mapcat + (partial markov/rhymes models/rhyme-trie-unstressed-trailing-consonants)) + (mapcat second) + (mapcat + (fn [word] + (map #(vector word %) (phonetics/phrase-phones word))))))) + +(comment + (rhymes-with-phones + "technology") + + ) (defn rhymes-with-frequencies [target trie database] (let [rhymes- (rhymes target) @@ -152,6 +208,86 @@ rhymes-)] (distinct (sort-by (comp - second) (map vector rhymes- freqs))))) +(defn assoc-phrases-with-phones + [phrases] + (mapcat + (fn [phrase] + (map #(vector phrase %) (phonetics/get-phones phrase))) + phrases)) + +(comment + (assoc-phrases-with-phones ["foo" "bar"]);; => (["foo" ["F" "UW1"]] ["bar" ["B" "AA1" "R"]]) + ) + +(defn append-freqs + [database trie prefix phrase-phones] + (map + (fn [phrase-phone] + (let [id (database (first phrase-phone))] + (conj phrase-phone (second (get trie (conj prefix id) ['_ 0]))))) + phrase-phones)) + +(comment + (->> ["top" "bar"] + (assoc-phrases-with-phones) + (append-freqs models/database models/markov-trie [1 1 1])) + ;; => (["top" ["T" "AA1" "P"] 888] + ;; ["top" ["T" "AO1" "P"] 888] + ;; ["bar" ["B" "AA1" "R"] 220]) + ) + +(defn append-rhyme-quality + [target-phrase phrase-phones] + (mapcat + (fn [phrase-phone] + (map + (fn [phones] + (into phrase-phone [target-phrase phones (quality-of-rhyme-phones + (second phrase-phone) + phones)])) + (phonetics/phrase-phones target-phrase))) + phrase-phones)) + +(comment + (->> ["hog" "bog"] + (assoc-phrases-with-phones) + (append-freqs models/database models/markov-trie [1 1 1]) + (append-rhyme-quality "log")) + ;; => (["hog" ["HH" "AA1" "G"] 18 "log" ["L" "AO1" "G"] 0] + ;; ["bog" ["B" "AA1" "G"] 42 "log" ["L" "AO1" "G"] 0] + ;; ["bog" ["B" "AO1" "G"] 42 "log" ["L" "AO1" "G"] 4]) + ) + +(defn rhymes-with-frequencies-and-rhyme-quality + [target trie database] + (let [rhymes- (rhymes target) + rhymes-with-freqs-and-qualities + (->> rhymes- + (assoc-phrases-with-phones) + (append-freqs models/database models/markov-trie [1 1 1]) + (append-rhyme-quality target))] + (distinct + (sort-by + (fn [[w1 p1 f w2 p2 q]] + [(- q) (- f)]) + rhymes-with-freqs-and-qualities)))) + +(comment + (time + (rhymes-with-frequencies-and-rhyme-quality + "bother me" + models/markov-trie + models/database)) + + (apply quality-of-rhyme-phones + '(["B" "AA1" "DH" "ER0" "M" "IY1"] + ["IH2" "N" "V" "IH2" "N" "S" "AH0" "B" "IH1" "L" "IH0" "T" "IY0"])) + + (apply quality-of-rhyme-phones + '(["B" "AA1" "DH" "ER0" "M" "IY1"] + ["IH2" "N" "V" "IH2" "Z" "AH0" "B" "IH1" "L" "AH0" "T" "IY0"])) + + ) (comment (markov/rhymes models/rhyme-trie-unstressed-trailing-consonants (phonetics/get-phones "food")) (rhymes "food")