Add linguistic rhyme quality code

README.org

@@ -0,0 +1,11 @@
+#+TITLE: Prhyme Rhyme Generation
+
+README is moving from RST to Org.
+
+[[https://github.com/eihli/prhyme]]
+
+* TODO
+- [X] Function to read/write tightly-packed-trie from/to file.
+- [X] Pull code out of Prhyme and into its own library.
+- [ ] Darklyrics Corpus as tightly-packed-trie
+- [ ] Instead of a value as the last element of the list, take a function.

deps.edn

@@ -19,7 +19,7 @@
         com.taoensso/timbre {:mvn/version "4.10.0"}
         com.owoga/tightly-packed-trie
         {:local/root "/home/eihli/src/clj-tightly-packed-trie"}
-        com.owoga/phonetics {:mvn/version "0.1.3"}}
+        com.owoga/phonetics {:local/root "/home/eihli/src/phonetics"}}
  :aliases {:dev {:extra-paths ["test" "examples" "dev"]
                  :extra-deps
                  {cljol/cljol {:git/url "https://github.com/jafingerhut/cljol"

dev/examples/scratch.clj

@@ -1,7 +1,10 @@
 (ns examples.scratch
   (:require [clojure.java.io :as io]
             [clojure.string :as string]
+            [com.owoga.phonetics :as phonetics]
+            [com.owoga.corpus.markov :as markov]
             [clojure.set]
+            [com.owoga.prhyme.core :as prhyme]
             [com.owoga.prhyme.data.dictionary :as dict]
             [com.owoga.prhyme.nlp.core :as nlp]
             [com.owoga.prhyme.generation.simple-good-turing :as sgt]
@@ -835,4 +838,25 @@
   )
 
 
+(def rhymetrie
+    (markov/->RhymeTrie
+     markov/rhyme-trie
+     (fn [phones]
+       (->> phones
+            prhyme/take-vowels-and-tail-consonants
+            prhyme/remove-non-primary-stress))
+     (fn [phones choices]
+       (every? phonetics/consonant (butlast phones)))))
 
+(comment
+  (->> (prhyme/phrase->all-phones "technology")
+       (map first)
+       (mapcat (partial markov/rhymes markov/rhymetrie))
+       (map second)
+       (reduce into #{}))
+
+  (markov/get-next-markov
+   markov/markov-tight-trie
+   [1 1])
+
+  )

src/com/owoga/corpus/markov.clj

@@ -1168,3 +1168,9 @@
   (trie/lookup markov-tight-trie [1 1 7 89])
   (map database [1 1 7])
   )
+
+
+;;;; WGU
+
+(defn gen-rhyme-tree
+  [trie database seed])

src/com/owoga/prhyme/core.clj

@@ -5,6 +5,7 @@
             [com.owoga.trie :as trie]
             [com.owoga.prhyme.util :as util]
             [com.owoga.phonetics :as phonetics]
+            [com.owoga.phonetics.stress-manip :as stress-manip]
             [com.owoga.phonetics.syllabify :as syllabify]
             [com.owoga.prhyme.util :as u]
             [com.owoga.prhyme.syllabify :as s]))
@@ -736,3 +737,141 @@
   ;; => (("AA" "R" "D") ("AA" "L")) 
   )
 
+(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]
+         (map reverse)
+         (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))
+         (map reverse)
+         (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 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)
+        same-number-of-syllables (if (same-number-of-syllables? phones1 phones2) 1 0)]
+    (+ perfect?
+       perfect-sans-consonants?
+       num-matching-stressed
+       num-matching-any-stress
+       same-number-of-syllables)))
+
+(comment
+  (->> [["economy" "ecology"]
+        ["biology" "ecology"]
+        ["bother me" "poverty"]
+        ["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))
+
+  )