Just learned about the {rhymer} package and thought, I know what the
world needs, a quick way to mutilate any poem by replacing marked words
with words that rhyme with them.
library(rhymer)
library(tidyverse)
library(tidytext)
Number the verses (and title) – for ease of printing later:
verse_nums <- function(raw_text) {
is_line <- strsplit(raw_text, "\n")[[1]] != ""
verse_num <- rep(NA, length(is_line))
this_verse <- 1
for (i in seq_along(verse_num)) {
if (is_line[i])
verse_num[i] <- this_verse
else
this_verse <- this_verse + 1
}
na.omit(verse_num) |> as.vector()
}
Tokenize:
verse_tokens <- function(raw_text) {
tibble(str = raw_text) |>
unnest_lines(input = str,
output = line,
to_lower = FALSE) |>
mutate(line_i = 1:n(),
verse_i = verse_nums(raw_text)) |>
unnest_tokens(
input = line,
output = word,
to_lower = FALSE,
strip_punct = FALSE
)
}
The following function wanders off and finds rhymes for the @-ed
words:
rhymed_words <- function(in_words, search_limit, verbose = FALSE) {
rhyme_em <- which(in_words == "@") + 1
#stopifnot(length(rhyme_em) > 0)
#stopifnot(max(rhyme_em) <= length(in_words))
res <- in_words
for (i in rhyme_em) {
this_input <- in_words[i]
this_rhymes <- get_rhyme(str_to_lower(this_input),
limit = search_limit)
stopifnot(nrow(this_rhymes) > 0)
this_output <- sample(this_rhymes$word, 1)
res[i] <- case_when(
this_input == str_to_lower(this_input) ~ this_output,
this_input == str_to_title(this_input) ~ str_to_title(this_output)
)
if (verbose) {
cat(this_input)
cat(" -> ")
cat(res[i])
cat("\n")
}
}
res
}
This mutilates the poem and glues it together again. The sequence of
gsub
s makes me think there’s an easier way to undo the
tokenisation.
mutilate_poem <- function(raw_text, search_limit) {
verse_tokens(raw_text) |>
mutate(substituted_word = rhymed_words(word, search_limit = search_limit)) |>
filter(substituted_word != "@") |>
group_by(verse_i, line_i) |>
summarise(text = str_c(substituted_word, collapse = " "), .groups = "drop") |>
mutate(text = gsub("\\s\\.", ".", text)) |>
mutate(text = gsub("\\(\\s", "\\(", text)) |>
mutate(text = gsub("\\s\\)", "\\)", text)) |>
mutate(text = gsub("\\s,", ",", text)) |>
mutate(text = gsub("\\s;", ";", text)) |>
mutate(text = gsub("\\s:", ":", text)) |>
mutate(text = gsub("\\s\\-\\s", "-", text))
}
Print:
print_poem <- function(lines) {
this_verse <- 1
for (r in 1:nrow(lines)) {
if (lines[r, ]$verse_i != this_verse) {
this_verse <- lines[r, ]$verse_i
cat("\n")
}
cat(lines[r, ]$text)
cat("\n")
}
}
this_be_the_verse <- "This Be The @Verse
They @fuck you up, your @mum and @dad.
They may not mean to, but they do.
They fill you with the @faults they had
And add some extra, just for @you.
But they were @fucked up in their turn
By fools in old-style @hats and @coats,
Who half the time were soppy @stern
And half at one another’s @throats.
Man hands on misery to man.
It deepens like a coastal @shelf.
Get out as early as you can,
And don’t have any @kids yourself."
this_be_the_verse |>
mutilate_poem(5) |>
print_poem()
This Be The Averse
They luck you up, your become and ad.
They may not mean to, but they do.
They fill you with the defaults they had
And add some extra, just for blue.
But they were obstruct up in their turn
By fools in old-style flats and quotes,
Who half the time were soppy turn
And half at one another’s denotes.
Man hands on misery to man.
It deepens like a coastal self.
Get out as early as you can,
And don’t have any grandkids yourself.
maggie_et_al <- "maggie and milly and molly and may
went down to the @beach(to @play one day)
and maggie discovered a @shell that sang
so sweetly she couldn’t remember her @troubles,and
milly befriended a @stranded @star
whose rays five languid fingers were;
and molly was chased by a @horrible @thing
which raced sideways while @blowing bubbles: and
may came home with a smooth round @stone
as small as a world and as large as @alone.
For whatever we lose(like a @you or a @me)
it’s always ourselves we find in the @sea"
maggie_et_al |> mutilate_poem(5) |> print_poem()
maggie and milly and molly and may
went down to the breach (to lay one day)
and maggie discovered a cell that sang
so sweetly she couldn’t remember her kibbles, and
milly befriended a underhanded r
whose rays five languid fingers were;
and molly was chased by a deplorable cling
which raced sideways while outgoing bubbles: and
may came home with a smooth round loan
as small as a world and as large as tone.
For whatever we lose (like a into or a be)
it’s always ourselves we find in the me
Sometimes it works better than others… The trick seems to be to feed
it back into itself, keeping words that work…
"This Be The Worse
They duck you up, your bum and dyad.
They may not mean to, but they do.
They fill you with the schmaltz they had
And add some extra, just for two.
But they were construct up in their turn
By fools in old-style cats and anecdotes,
Who half the time were soppy sunburn
And half at one another’s quotes.
Man hands on misery to man.
It deepens like a coastal elf.
Get out as early as you can,
And don’t have any eyelids yourself." |>
mutilate_poem(20) |>
print_poem()
This Be The Worse
They duck you up, your bum and dyad.
They may not mean to, but they do.
They fill you with the schmaltz they had
And add some extra, just for two.
But they were construct up in their turn
By fools in old-style cats and anecdotes,
Who half the time were soppy sunburn
And half at one another’s quotes.
Man hands on misery to man.
It deepens like a coastal elf.
Get out as early as you can,
And don’t have any eyelids yourself.
LS0tDQp0aXRsZTogIlRoaXMgQmUgVGhlIEZ1biBXaXRoIHtyaHltZXJ9Ig0KYXV0aG9yOiAiQEFuZGlAdGVjaC5sZ2J0Ig0Kb3V0cHV0OiANCiAgaHRtbF9ub3RlYm9vazogDQogICAgY29kZV9mb2xkaW5nOiBub25lDQotLS0NCg0KSnVzdCBsZWFybmVkIGFib3V0IHRoZSB7cmh5bWVyfSBwYWNrYWdlIGFuZCB0aG91Z2h0LCBJIGtub3cgd2hhdCB0aGUgd29ybGQgbmVlZHMsIGEgcXVpY2sgd2F5IHRvIG11dGlsYXRlIGFueSBwb2VtIGJ5IHJlcGxhY2luZyBtYXJrZWQgd29yZHMgd2l0aCB3b3JkcyB0aGF0IHJoeW1lIHdpdGggdGhlbS4NCg0KDQpgYGB7cn0NCmxpYnJhcnkocmh5bWVyKQ0KbGlicmFyeSh0aWR5dmVyc2UpDQpsaWJyYXJ5KHRpZHl0ZXh0KQ0KYGBgDQoNCg0KTnVtYmVyIHRoZSB2ZXJzZXMgKGFuZCB0aXRsZSkgLS0gZm9yIGVhc2Ugb2YgcHJpbnRpbmcgbGF0ZXI6DQoNCmBgYHtyfQ0KdmVyc2VfbnVtcyA8LSBmdW5jdGlvbihyYXdfdGV4dCkgew0KICBpc19saW5lIDwtIHN0cnNwbGl0KHJhd190ZXh0LCAiXG4iKVtbMV1dICE9ICIiDQogIHZlcnNlX251bSA8LSByZXAoTkEsIGxlbmd0aChpc19saW5lKSkNCiAgDQogIHRoaXNfdmVyc2UgPC0gMQ0KICBmb3IgKGkgaW4gc2VxX2Fsb25nKHZlcnNlX251bSkpIHsNCiAgICBpZiAoaXNfbGluZVtpXSkNCiAgICAgIHZlcnNlX251bVtpXSA8LSB0aGlzX3ZlcnNlDQogICAgZWxzZQ0KICAgICAgdGhpc192ZXJzZSA8LSB0aGlzX3ZlcnNlICsgMQ0KICB9DQogIA0KICBuYS5vbWl0KHZlcnNlX251bSkgfD4gYXMudmVjdG9yKCkNCn0NCmBgYA0KDQoNClRva2VuaXplOg0KDQpgYGB7cn0NCnZlcnNlX3Rva2VucyA8LSBmdW5jdGlvbihyYXdfdGV4dCkgew0KICB0aWJibGUoc3RyID0gcmF3X3RleHQpIHw+DQogICAgdW5uZXN0X2xpbmVzKGlucHV0ICAgID0gc3RyLA0KICAgICAgICAgICAgICAgICBvdXRwdXQgICA9IGxpbmUsDQogICAgICAgICAgICAgICAgIHRvX2xvd2VyID0gRkFMU0UpIHw+DQogICAgbXV0YXRlKGxpbmVfaSA9IDE6bigpLA0KICAgICAgICAgICB2ZXJzZV9pID0gdmVyc2VfbnVtcyhyYXdfdGV4dCkpIHw+DQogICAgdW5uZXN0X3Rva2VucygNCiAgICAgIGlucHV0ICAgICAgID0gbGluZSwNCiAgICAgIG91dHB1dCAgICAgID0gd29yZCwNCiAgICAgIHRvX2xvd2VyICAgID0gRkFMU0UsDQogICAgICBzdHJpcF9wdW5jdCA9IEZBTFNFDQogICAgKQ0KfQ0KYGBgDQoNCg0KVGhlIGZvbGxvd2luZyBmdW5jdGlvbiB3YW5kZXJzIG9mZiBhbmQgZmluZHMgcmh5bWVzIGZvciB0aGUgQC1lZCB3b3JkczoNCg0KYGBge3J9DQpyaHltZWRfd29yZHMgPC0gZnVuY3Rpb24oaW5fd29yZHMsIHNlYXJjaF9saW1pdCwgdmVyYm9zZSA9IEZBTFNFKSB7DQogIHJoeW1lX2VtIDwtIHdoaWNoKGluX3dvcmRzID09ICJAIikgKyAxDQogICNzdG9waWZub3QobGVuZ3RoKHJoeW1lX2VtKSA+IDApDQogICNzdG9waWZub3QobWF4KHJoeW1lX2VtKSA8PSBsZW5ndGgoaW5fd29yZHMpKQ0KICANCiAgcmVzIDwtIGluX3dvcmRzDQogIA0KICBmb3IgKGkgaW4gcmh5bWVfZW0pIHsNCiAgICB0aGlzX2lucHV0ICA8LSBpbl93b3Jkc1tpXQ0KICAgIHRoaXNfcmh5bWVzIDwtIGdldF9yaHltZShzdHJfdG9fbG93ZXIodGhpc19pbnB1dCksDQogICAgICAgICAgICAgICAgICAgICAgICAgICAgIGxpbWl0ID0gc2VhcmNoX2xpbWl0KQ0KICAgIA0KICAgIHN0b3BpZm5vdChucm93KHRoaXNfcmh5bWVzKSA+IDApDQogICAgdGhpc19vdXRwdXQgPC0gc2FtcGxlKHRoaXNfcmh5bWVzJHdvcmQsIDEpDQogICAgDQogICAgcmVzW2ldIDwtIGNhc2Vfd2hlbigNCiAgICAgIHRoaXNfaW5wdXQgPT0gc3RyX3RvX2xvd2VyKHRoaXNfaW5wdXQpIH4gdGhpc19vdXRwdXQsDQogICAgICB0aGlzX2lucHV0ID09IHN0cl90b190aXRsZSh0aGlzX2lucHV0KSB+IHN0cl90b190aXRsZSh0aGlzX291dHB1dCkNCiAgICApDQogICAgaWYgKHZlcmJvc2UpIHsNCiAgICAgIGNhdCh0aGlzX2lucHV0KQ0KICAgICAgY2F0KCIgLT4gIikNCiAgICAgIGNhdChyZXNbaV0pDQogICAgICBjYXQoIlxuIikNCiAgICB9DQogIH0NCiAgDQogIHJlcw0KfQ0KYGBgDQoNCg0KVGhpcyBtdXRpbGF0ZXMgdGhlIHBvZW0gYW5kIGdsdWVzIGl0IHRvZ2V0aGVyIGFnYWluLiBUaGUgc2VxdWVuY2Ugb2YgYGdzdWJgcyBtYWtlcyBtZSB0aGluayB0aGVyZSdzIGFuIGVhc2llciB3YXkgdG8gdW5kbyB0aGUgdG9rZW5pc2F0aW9uLg0KDQpgYGB7cn0NCm11dGlsYXRlX3BvZW0gPC0gZnVuY3Rpb24ocmF3X3RleHQsIHNlYXJjaF9saW1pdCkgew0KICB2ZXJzZV90b2tlbnMocmF3X3RleHQpIHw+DQogIG11dGF0ZShzdWJzdGl0dXRlZF93b3JkID0gcmh5bWVkX3dvcmRzKHdvcmQsIHNlYXJjaF9saW1pdCA9IHNlYXJjaF9saW1pdCkpIHw+DQogIGZpbHRlcihzdWJzdGl0dXRlZF93b3JkICE9ICJAIikgIHw+DQogIGdyb3VwX2J5KHZlcnNlX2ksIGxpbmVfaSkgfD4NCiAgc3VtbWFyaXNlKHRleHQgPSBzdHJfYyhzdWJzdGl0dXRlZF93b3JkLCBjb2xsYXBzZSA9ICIgIiksIC5ncm91cHMgPSAiZHJvcCIpIHw+DQogIG11dGF0ZSh0ZXh0ID0gZ3N1YigiXFxzXFwuIiwgIi4iLCB0ZXh0KSkgfD4NCiAgbXV0YXRlKHRleHQgPSBnc3ViKCJcXChcXHMiLCAiXFwoIiwgdGV4dCkpIHw+DQogIG11dGF0ZSh0ZXh0ID0gZ3N1YigiXFxzXFwpIiwgIlxcKSIsIHRleHQpKSB8Pg0KICBtdXRhdGUodGV4dCA9IGdzdWIoIlxccywiLCAiLCIsIHRleHQpKSB8Pg0KICBtdXRhdGUodGV4dCA9IGdzdWIoIlxcczsiLCAiOyIsIHRleHQpKSB8Pg0KICBtdXRhdGUodGV4dCA9IGdzdWIoIlxcczoiLCAiOiIsIHRleHQpKSB8Pg0KICBtdXRhdGUodGV4dCA9IGdzdWIoIlxcc1xcLVxccyIsICItIiwgdGV4dCkpDQp9DQpgYGANCg0KUHJpbnQ6DQoNCmBgYHtyfQ0KcHJpbnRfcG9lbSA8LSBmdW5jdGlvbihsaW5lcykgew0KICB0aGlzX3ZlcnNlIDwtIDENCiAgZm9yIChyIGluIDE6bnJvdyhsaW5lcykpIHsNCiAgICBpZiAobGluZXNbciwgXSR2ZXJzZV9pICE9IHRoaXNfdmVyc2UpIHsNCiAgICAgIHRoaXNfdmVyc2UgPC0gbGluZXNbciwgXSR2ZXJzZV9pDQogICAgICBjYXQoIlxuIikNCiAgICB9DQogICAgY2F0KGxpbmVzW3IsIF0kdGV4dCkNCiAgICBjYXQoIlxuIikNCiAgfQ0KfQ0KYGBgDQoNCg0KYGBge3J9DQp0aGlzX2JlX3RoZV92ZXJzZSA8LSAiVGhpcyBCZSBUaGUgQFZlcnNlDQoNClRoZXkgQGZ1Y2sgeW91IHVwLCB5b3VyIEBtdW0gYW5kIEBkYWQuICAgDQogICAgVGhleSBtYXkgbm90IG1lYW4gdG8sIGJ1dCB0aGV5IGRvLiAgIA0KVGhleSBmaWxsIHlvdSB3aXRoIHRoZSBAZmF1bHRzIHRoZXkgaGFkDQogICAgQW5kIGFkZCBzb21lIGV4dHJhLCBqdXN0IGZvciBAeW91Lg0KDQpCdXQgdGhleSB3ZXJlIEBmdWNrZWQgdXAgaW4gdGhlaXIgdHVybg0KICAgIEJ5IGZvb2xzIGluIG9sZC1zdHlsZSBAaGF0cyBhbmQgQGNvYXRzLCAgIA0KV2hvIGhhbGYgdGhlIHRpbWUgd2VyZSBzb3BweSBAc3Rlcm4NCiAgICBBbmQgaGFsZiBhdCBvbmUgYW5vdGhlcuKAmXMgQHRocm9hdHMuDQoNCk1hbiBoYW5kcyBvbiBtaXNlcnkgdG8gbWFuLg0KICAgIEl0IGRlZXBlbnMgbGlrZSBhIGNvYXN0YWwgQHNoZWxmLg0KR2V0IG91dCBhcyBlYXJseSBhcyB5b3UgY2FuLA0KICAgIEFuZCBkb27igJl0IGhhdmUgYW55IEBraWRzIHlvdXJzZWxmLiINCmBgYA0KDQoNCmBgYHtyfQ0KdGhpc19iZV90aGVfdmVyc2UgfD4NCiAgbXV0aWxhdGVfcG9lbSg1KSB8Pg0KICBwcmludF9wb2VtKCkNCmBgYA0KDQoNCmBgYHtyfQ0KbWFnZ2llX2V0X2FsIDwtICJtYWdnaWUgYW5kIG1pbGx5IGFuZCBtb2xseSBhbmQgbWF5DQp3ZW50IGRvd24gdG8gdGhlIEBiZWFjaCh0byBAcGxheSBvbmUgZGF5KQ0KDQphbmQgbWFnZ2llIGRpc2NvdmVyZWQgYSBAc2hlbGwgdGhhdCBzYW5nDQpzbyBzd2VldGx5IHNoZSBjb3VsZG7igJl0IHJlbWVtYmVyIGhlciBAdHJvdWJsZXMsYW5kDQoNCm1pbGx5IGJlZnJpZW5kZWQgYSBAc3RyYW5kZWQgQHN0YXINCndob3NlIHJheXMgZml2ZSBsYW5ndWlkIGZpbmdlcnMgd2VyZTsNCg0KYW5kIG1vbGx5IHdhcyBjaGFzZWQgYnkgYSBAaG9ycmlibGUgQHRoaW5nDQp3aGljaCByYWNlZCBzaWRld2F5cyB3aGlsZSBAYmxvd2luZyBidWJibGVzOiBhbmQNCg0KbWF5IGNhbWUgaG9tZSB3aXRoIGEgc21vb3RoIHJvdW5kIEBzdG9uZQ0KYXMgc21hbGwgYXMgYSB3b3JsZCBhbmQgYXMgbGFyZ2UgYXMgQGFsb25lLg0KDQpGb3Igd2hhdGV2ZXIgd2UgbG9zZShsaWtlIGEgQHlvdSBvciBhIEBtZSkNCml04oCZcyBhbHdheXMgb3Vyc2VsdmVzIHdlIGZpbmQgaW4gdGhlIEBzZWEiDQpgYGANCg0KDQpgYGB7cn0NCm1hZ2dpZV9ldF9hbCB8PiBtdXRpbGF0ZV9wb2VtKDUpIHw+IHByaW50X3BvZW0oKQ0KYGBgDQoNClNvbWV0aW1lcyBpdCB3b3JrcyBiZXR0ZXIgdGhhbiBvdGhlcnMuLi4gVGhlIHRyaWNrIHNlZW1zIHRvIGJlIHRvIGZlZWQgaXQgYmFjayBpbnRvIGl0c2VsZiwga2VlcGluZyB3b3JkcyB0aGF0IHdvcmsuLi4NCg0KYGBge3J9DQoiVGhpcyBCZSBUaGUgV29yc2UNCg0KVGhleSBkdWNrIHlvdSB1cCwgeW91ciBidW0gYW5kIGR5YWQuDQpUaGV5IG1heSBub3QgbWVhbiB0bywgYnV0IHRoZXkgZG8uDQpUaGV5IGZpbGwgeW91IHdpdGggdGhlIHNjaG1hbHR6IHRoZXkgaGFkDQpBbmQgYWRkIHNvbWUgZXh0cmEsIGp1c3QgZm9yIHR3by4NCg0KQnV0IHRoZXkgd2VyZSBjb25zdHJ1Y3QgdXAgaW4gdGhlaXIgdHVybg0KQnkgZm9vbHMgaW4gb2xkLXN0eWxlIGNhdHMgYW5kIGFuZWNkb3RlcywNCldobyBoYWxmIHRoZSB0aW1lIHdlcmUgc29wcHkgc3VuYnVybg0KQW5kIGhhbGYgYXQgb25lIGFub3RoZXLigJlzIHF1b3Rlcy4NCg0KTWFuIGhhbmRzIG9uIG1pc2VyeSB0byBtYW4uDQpJdCBkZWVwZW5zIGxpa2UgYSBjb2FzdGFsIGVsZi4NCkdldCBvdXQgYXMgZWFybHkgYXMgeW91IGNhbiwNCkFuZCBkb27igJl0IGhhdmUgYW55IGV5ZWxpZHMgeW91cnNlbGYuIiB8Pg0KICBtdXRpbGF0ZV9wb2VtKDIwKSB8Pg0KICBwcmludF9wb2VtKCkNCmBgYA0KDQoNCg0KDQoNCg==