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 gsubs 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==