Add limerick gen

src/com/owoga/corpus/darklyrics.clj

@@ -139,11 +139,8 @@
      {}
      ((util/window (inc n)) tokens))))
 
-(def darkov-2
-    (into
-     {}
-     (map (fn [[k v]] (vector (list k) v))
-          (make-markov (slurp "darklyrics.txt") 2))))
+(def darkov-2 (util/read-markov "dark-corpus-2.edn"))
+
 
 (defn norm-filepath [text]
   (-> text

src/com/owoga/prhyme/core.clj

@@ -136,19 +136,28 @@
        (map reverse)))
 
 (defn rimes? [a b]
-  (if (and (= 1 (count (last (:rimes a))))
-           (= 1 (count (last (:rimes b))))
-           (or (= (last (:rimes a)) '("ER"))
-               (= (last (:rimes a)) '("AA"))
-               (= (last (:rimes a)) '("AE"))
-               (= (last (:rimes a)) '("AO"))
-               (= (last (:rimes a)) '("AW"))
-               (= (last (:rimes a)) '("EH"))
-               (= (last (:rimes a)) '("IH"))
-               (= (last (:rimes a)) '("UH"))
-               (= (last (:rimes a)) '("AH"))))
-    (= (last (:onsets a)) (last (:onsets b)))
-    (= (last (:rimes a)) (last (:rimes b)))))
+  (cond
+    (and (= 1 (count (last (:rimes a))))
+         (= 1 (count (last (:rimes b))))
+         (or (= (last (:rimes a)) '("ER"))
+             (= (last (:rimes a)) '("AA"))
+             (= (last (:rimes a)) '("AE"))
+             (= (last (:rimes a)) '("AO"))
+             (= (last (:rimes a)) '("AW"))
+             (= (last (:rimes a)) '("EH"))
+             (= (last (:rimes a)) '("IH"))
+             (= (last (:rimes a)) '("UH"))
+             (= (last (:rimes a)) '("AH"))))
+    (= (list (first (take-last 2 (:nuclei a)))
+             (last (:onsets a)))
+       (list (first (take-last 2 (:nuclei b)))
+             (last (:onsets b))))
+
+    (and (= 1 (count (last (:rimes a))))
+         (= 1 (count (last (:rimes b)))))
+    (= (take-last 2 (:nuclei a)) (take-last 2 (:nuclei b)))
+
+    :else (= (last (:rimes a)) (last (:rimes b)))))
 
 (defn onset+nucleus [syllables]
   (->> syllables

src/com/owoga/prhyme/gen.clj

@@ -206,6 +206,26 @@
          result])
       [words target result])))
 
+(defn attempt-gen-target-by-syllable-count [adj syllable-count words]
+  (loop [result '()]
+    (cond
+      (<= syllable-count (apply + (cons 0 (map :syllable-count result))))
+      result
+      :else
+      (let [[weighted-words target result] (adj [words nil result])]
+        (recur (cons (weighted-rand/weighted-selection :weight weighted-words) result))))))
+
+(defn gen-sentence-with-syllable-count [adj syllable-count words]
+  (->> (repeatedly
+        (fn []
+          (attempt-gen-target-by-syllable-count adj syllable-count words)))
+       (filter #(= syllable-count (apply + (map :syllable-count %))))
+       (map #(map :norm-word %))
+       (map #(string/join " " %))
+       (filter nlp/valid-sentence?)
+       first))
+
+
 (defn prhyme
   "2020-10-21 iteration"
   [words weights-adjuster target stop?]
@@ -233,6 +253,24 @@
               result (cons selection result)]
           (recur new-target result (inc sentinel)))))))
 
+(defn attempt-gen-rhyme-with-syllable-count [adj syllable-count words target]
+  (prhyme
+   words
+   adj
+   target
+   (fn [target result]
+     (<= syllable-count (apply + (map :syllable-count result))))))
+
+(defn gen-rhyme-with-syllable-count [adj syllable-count words target]
+  (->> (repeatedly
+        (fn []
+          (attempt-gen-rhyme-with-syllable-count adj syllable-count words target)))
+       (filter #(= syllable-count (apply + (map :syllable-count %))))
+       (map #(map :norm-word %))
+       (map #(string/join " " %))
+       (filter nlp/valid-sentence?)
+       first))
+
 (defn prhymer [words weights-adjuster target stop]
   (cons (prhyme
          words

src/com/owoga/prhyme/lymeric.clj

@@ -0,0 +1,107 @@
+(ns com.owoga.prhyme.lymeric
+  (:require [com.owoga.prhyme.gen :as gen]
+            [com.owoga.prhyme.util :as util]
+            [com.owoga.prhyme.util.weighted-rand :as weighted-rand]
+            [clojure.string :as string]
+            [com.owoga.prhyme.frp :as frp]
+            [com.owoga.prhyme.util.nlp :as nlp]
+            [com.owoga.corpus.darklyrics :as darklyrics]))
+
+
+(defn rhyme-from-scheme
+  "scheme of format [[A 9] [A 9] [B 5] [B 5] [A 9]]"
+  [rhymer scheme]
+  (let [base-words (map #(assoc % :weight 1) frp/popular)]
+    (loop [scheme scheme
+           rhymes {}
+           result []]
+      (cond
+        (empty? scheme) result
+        :else
+        (let [[pattern syllable-count] (first scheme)
+              banned-words (into #{} (->> result
+                                          (map #(string/split % #" "))
+                                          (map #(last %))))
+              adj (apply
+                   comp
+                   (remove
+                    nil?
+                    [(gen/adjust-for-markov-with-boundaries darklyrics/darkov-2 0.9)
+                     (when (rhymes pattern)
+                       (gen/adjust-for-tail-rimes util/words-map 0.9))]))
+              rhyme (if (nil? (get rhymes pattern))
+                      (gen/gen-sentence-with-syllable-count
+                       adj
+                       syllable-count
+                       base-words)
+                      (gen/gen-rhyme-with-syllable-count
+                       adj
+                       syllable-count
+                       (remove #(banned-words (:norm-word %))
+                               base-words)
+                       (frp/phrase->word frp/words (get rhymes pattern))))]
+          (println banned-words)
+          (recur (rest scheme)
+                 (assoc rhymes pattern rhyme)
+                 (conj result rhyme)))))))
+
+
+(comment
+  (rhyme-from-scheme nil '((A 8) (A 8) (B 5) (B 5) (A 8)))
+
+  (first (filter #(= "abba" (:norm-word %)) frp/words))
+
+  (gen/gen-sentence-with-syllable-count darklyrics/darkov-2 8 (map #(assoc % :weight 1) frp/popular))
+  (def adj
+    (comp (gen/adjust-for-markov-with-boundaries darklyrics/darkov-2 0.9)
+          (gen/adjust-for-tail-rimes util/words-map 0.99)))
+  (repeatedly
+   10
+   (fn []
+     (gen/gen-rhyme-with-syllable-count
+      adj
+      8
+      frp/popular
+      (frp/phrase->word frp/words "famed watched waterloo"))))
+
+  )
+
+(comment
+  ["romancing realized too late"
+   "my crown revive my withered state"
+   "reign is obsolete"
+   "i sit in the street"
+   "but nobody cares of my fate"]
+  ["flesh is hacked to get me sedate"
+   "demonstration obsessed with hate"
+   "justice will be written in stone"
+   "and you will be shown"
+   "bedrooms of icons suffocate"]
+  ["you will bow to their hungry gods"
+   "come will come whatever the odds"
+   "now we see the light"
+   "you can't put it right"
+   "recklessly chopping firing squads"]
+  ["untimely they fool their poor life"
+   "it wither away with this knife"
+   "hate is my virtue"
+   "my feelings are well overdue"
+   "war we await the afterlife"]
+  )
+(->> (repeatedly
+      (fn []
+        (gen/gen-target-by-syllable-count darklyrics/darkov-2 8 (map #(assoc % :weight 1) frp/popular))))
+     (filter #(= 8 (apply + (map :syllable-count %))))
+     (map #(map :norm-word %))
+     (map #(string/join " " %))
+     (filter nlp/valid-sentence?)
+     (take 5))
+
+(take 3 frp/popular)
+(defn genlymeric []
+  (let [adj (comp (gen/adjust-for-markov darklyrics/darkov-2)
+                  (gen/adjust-for-tail-rimes util/words-map))]))
+
+(apply (fnil + 0) '())
+
+(map :syllable-count '())

src/com/owoga/prhyme/util/weighted_rand.clj

@@ -71,6 +71,18 @@
                   (map #(/ % tot) ws))]
     (make-vose (vec dist))))
 
+(defn weighted-selection
+  ([coll]
+   (let [rng (from-weights coll)
+         index (nextr rng nil)
+         selection (nth coll index)]
+     selection))
+  ([key-fn coll]
+   (let [rng (from-weights (map key-fn coll))
+         index (nextr rng nil)
+         selection (nth coll index)]
+     selection)))
+
 (comment
   (let [ws [1 2 4 8]
         rng (from-weights ws)]