Add functions for different rhyme types

src/com/owoga/corpus/markov.clj

@@ -200,8 +200,14 @@
    (let [files (->> "dark-corpus"
                     io/file
                     file-seq
-                    (eduction (xf-file-seq 0 10000)))
-         [trie database] (train-backwards files 1 4 "/tmp/trie.bin" "/tmp/database.bin" "/tmp/tpt.bin")]))
+                    (eduction (xf-file-seq 0 1000)))
+         [trie database] (train-backwards
+                          files
+                          1
+                          5
+                          "/tmp/markov-trie-4-gram-backwards.bin"
+                          "/tmp/markov-database-4-gram-backwards.bin"
+                          "/tmp/markov-tightly-packed-trie-4-gram-backwards.bin")]))
 
   (def markov-trie (into (trie/make-trie) (nippy/thaw-from-file "/tmp/trie.bin")))
   (def database (nippy/thaw-from-file "/tmp/database.bin"))
@@ -220,10 +226,22 @@
       (println (take 5 loaded-trie)))))
 
 (comment
-  (let [database (atom (nippy/thaw-from-file "/tmp/database.bin"))]
-    (gen-rhyme-model prhyme/phrase->all-flex-rhyme-tailing-consonants-phones database "/tmp/rhyme-trie.bin"))
-
-  (def rhyme-trie (into (trie/make-trie) (nippy/thaw-from-file "/tmp/rhyme-trie.bin")))
+  (time
+   (let [database (atom (nippy/thaw-from-file "/tmp/database.bin"))]
+     (gen-rhyme-model
+      prhyme/phrase->all-flex-rhyme-tailing-consonants-phones
+      database
+      "/tmp/rhyme-trie-primary-stressed-vowels-and-trailing-consonants.bin")
+     (gen-rhyme-model
+      prhyme/phrase->unstressed-vowels-and-tailing-consonants
+      database
+      "/tmp/rhyme-trie-unstressed-vowels-and-trailing-consonants.bin")))
+
+  (def rhyme-trie
+    (into
+     (trie/make-trie)
+     (nippy/thaw-from-file
+      "/tmp/rhyme-trie-primary-stressed-vowels-and-trailing-consonants.bin")))
   )
 
 
@@ -260,6 +278,11 @@
        (map #(update % 0 vec))))
 
 (comment
+  (->>  (prhyme/phrase->all-flex-rhyme-tailing-consonants-phones "bog")
+        (map first)
+        (map reverse)
+        (mapcat (partial rhyme-choices rhyme-trie)))
+
   (let [rhyme-trie (trie/make-trie ["G" "AA1" "B"] "bog" ["G" "AO1" "B"] "bog"
                                    ["T" "AA1" "H"] "hot" ["G" "AO1" "F"] "fog")]
     [(rhyme-choices rhyme-trie ["G" "AO1"])
@@ -837,7 +860,12 @@
          (map reverse)
          (map (partial map second))
          (map data-transform/untokenize)))
-
+  (->> "overdrive"
+       (prhyme/phrase->all-flex-rhyme-tailing-consonants-phones)
+       (map first)
+       (map reverse)
+       (map (partial rhyme-choices-walking-target-rhyme rhyme-trie)))
+  (trie/lookup rhyme-trie ["V" "AY1"])
   (trie/lookup markov-tight-trie nil)
   (tightly-generate-n-syllable-sentence-rhyming-with
    database

src/com/owoga/prhyme/core.clj

@@ -135,7 +135,6 @@
                     word))))
          (merge-phrase-words phrase))))
 
-
 (defn phrase->perfect-rhyme-trie
   [words]
   (transduce
@@ -175,7 +174,8 @@
 
   Returns all possible pronunciations. For hog -> haog, haag.
 
-  ROBOT -> '(OW1 AA)"
+  bog => ([[AA1] bog] [[AO1] bog])
+  "
   [phrase]
   (->> phrase
        (#(string/split % #" "))
@@ -262,18 +262,89 @@
   ;; => ("OW1" "AA2" "T")
   )
 
+(defn remove-all-stress
+  [phones]
+  (mapv
+   #(string/replace % #"\d" "")
+   phones))
+
 (defn remove-non-primary-stress
   [phones]
   (mapv
    #(string/replace % #"[02-9]" "")
    phones))
 
+(defn phones->rhyme-vowels-sans-stress
+  [phones]
+  (remove-all-stress phones))
+
 (defn phones->all-flex-rhyme-tailing-consonants-phones
   [phones]
   (->> phones
        take-vowels-and-tail-consonants
        remove-non-primary-stress))
 
+(defn phrase->all-phones
+  "Since each word in a phrase might have several different possible pronunciations,
+  this function returns a cartesian product of all possible phones of the phrase.
+
+  (phrase->all-phones hog in a bog)
+  ;; => ([(HH AA1 G IH0 N AH0 B AA1 G) hog in a bog]
+  ;;     [(HH AA1 G IH0 N AH0 B AO1 G) hog in a bog]
+  ;;     [(HH AA1 G IH0 N EY1 B AA1 G) hog in a bog]
+  ;;     [(HH AA1 G IH0 N EY1 B AO1 G) hog in a bog]
+  ;;     [(HH AA1 G IH1 N AH0 B AA1 G) hog in a bog]
+  ;;     [(HH AA1 G IH1 N AH0 B AO1 G) hog in a bog]
+  ;;     [(HH AA1 G IH1 N EY1 B AA1 G) hog in a bog]
+  ;;     [(HH AA1 G IH1 N EY1 B AO1 G) hog in a bog])
+  "
+  [phrase]
+  (->> phrase
+       (#(string/split % #" "))
+       (map (fn [word]
+              (let [phones (phonetics/get-phones word)]
+                (map #(vector % word) phones))))
+       ;; Lots of nesting here.
+       ;; We have phrase -> word pronunciations -> word pronunciation -> [phones word]
+       ;; The rest will be easier if we get rid of a level of nesting
+       ;; by mapcatting the cross product of pronunciations.
+       (apply combinatorics/cartesian-product)
+       ;; Now we have [phrases [pronunciations [[phones] word]]]
+       (map (partial apply map vector))
+       (map (fn [[phones words]]
+              [(apply concat phones)
+               (string/join " " words)]))))
+
+(comment
+  (phrase->all-phones "hog in a bog")
+  ;; => ([("HH" "AA1" "G" "IH0" "N" "AH0" "B" "AA1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH0" "N" "AH0" "B" "AO1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH0" "N" "EY1" "B" "AA1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH0" "N" "EY1" "B" "AO1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH1" "N" "AH0" "B" "AA1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH1" "N" "AH0" "B" "AO1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH1" "N" "EY1" "B" "AA1" "G") "hog in a bog"]
+  ;;     [("HH" "AA1" "G" "IH1" "N" "EY1" "B" "AO1" "G") "hog in a bog"])
+  )
+
+(defn phrase->unstressed-vowels-and-tailing-consonants
+  "an => ([[AE N] an] [[AH N] an])"
+  [phrase]
+  (->> phrase
+       phrase->all-phones
+       (map (fn [[phones word]]
+              [(->> phones
+                    take-vowels-and-tail-consonants
+                    remove-all-stress)
+               word]))
+       distinct))
+
+(comment
+  (phrase->unstressed-vowels-and-tailing-consonants
+   "an")
+  ;; => ([["AE" "N"] "an"] [["AH" "N"] "an"])
+  )
+
 (defn phrase->all-flex-rhyme-tailing-consonants-phones
   "Takes a space-seperated string of words
   and returns the concatenation of the words