tl;dr
Now you can use a function to deep fry memes in R.
Extra crispy
You can make memes in R with packages like Guangchang Yu’s {meme}. You could even post them to Twitter with #RStatsMemes for @rstatsmemes to find.
However, it’s no longer enough to present memes as-is. They must be deep-fried to become modern and ironic. It will help people think that your meme is so edgy that it’s been re-saved thousands of times.
Get to temperature
You’ll need image-manipulation wizardry from the {magick} package, along with {extrafont} to let you use fonts from your system.
At time of writing there is an issue with importing fonts, which requires an earlier version of {Rttf2pt1} to be installed.
install.packages(c("magick", "extrafont", "remotes"))
remotes::install_version("Rttf2pt1", version = "1.3.8")
You can then import fonts from your system.
extrafont::font_import()
Now we can use important joke fonts—like Impact, Papyrus or Calibri—in our memes.
Small fry
I’ve cooked up a single, low-quality function, fry()
, that:
- Reads a meme template image (or any image) from a path
- Adds top/bottom text in Impact font
- Reads from a URL a specific (cursed) cry/laugh emoji that’s popular in deep-frying and places it in a random location (corners or left/right sides)
- Adjusts the image contrast, saturation, etc,1, tints it orange and bulges it from the centre
- Writes the image to a temporary jpeg file—compressing it horribly—and then reads it back in
- Outputs a
magick-image
object that you can save withmagick::image_write()
and send to all your friend (sic)
It does what I want it to do; adjust it as you please.
suppressPackageStartupMessages(library(magick))
fry <- function(
img_path, emoji_path,
text_top, text_bottom,
depth = c("shallow", "deep")) {
depth <- match.arg(depth)
cat("Heating oil... ")
emoji <- magick::image_read(emoji_path)
emoji_where <- sample(c(
paste0("north", c("east", "west")),
paste0("south", c("east", "west")),
"east", "west" # e.g. 'east' is right
), 1)
img <- image_read(img_path) |>
image_annotate(
text_top, "north", size = 80, font = "Impact",
color = "white", strokecolor = "black"
) |>
image_annotate(
text_bottom, "south", size = 80, font = "Impact",
color = "white", strokecolor = "black"
) |>
image_scale("1000") |>
image_composite(emoji, gravity = emoji_where) |>
image_colorize(30, "orange") |> # tint
image_modulate(brightness = 80, saturation = 120, hue = 90) |>
image_contrast(sharpen = 100) |>
image_noise()
cat("dunking meme... ")
if (depth == "shallow") {
img <- img %>% image_implode(-0.5) # bulge
compress <- 8
} else if (depth == "deep") {
img <- img %>% image_implode(-1) # more bulge
compress <- 1 # maximum compression
}
path_out <- tempfile("meme", fileext = ".jpeg")
image_write(img, path_out, "jpeg", compress)
cat("crisp.")
image_read(path_out)
}
Get cooking
What spicy meme shall I make? Well, the =
versus <-
assignment-operator flamewar has been cold for a few days, so time to heat it up again.2 And why not incorporate the world’s most famous fry cook (in sarcastic form)?
sponge_path <- paste0( # URL to meme image
"https://raw.githubusercontent.com/matt-dray/rostrum-blog/",
"master/static/post/2021-11-07-deepfry_files/spongebob.jpg"
)
emoji_path <- paste0( # URL to cry/laugh emoji
"https://raw.githubusercontent.com/matt-dray/rostrum-blog/",
"master/static/post/2021-11-07-deepfry_files/deepfry-emoji.jpg"
)
bot_txt <- "= sAvEs KeYsTrOkEs Vs <-" # sarcastic text
top_txt <- tolower(bot_txt)
First, a nice shallow fry.
fry(sponge_path, emoji_path, top_txt, bot_txt, "shallow")
## Heating oil... dunking meme... crisp.
And now we deep fry.
fry(sponge_path, emoji_path, top_txt, bot_txt, "deep")
## Heating oil... dunking meme... crisp.
*Fry-cook’s kiss*
Session info
## ─ Session info ───────────────────────────────────────────────────────────────
## setting value
## version R version 4.1.1 (2021-08-10)
## os macOS Mojave 10.14.6
## system x86_64, darwin17.0
## ui X11
## language (EN)
## collate en_GB.UTF-8
## ctype en_GB.UTF-8
## tz Europe/London
## date 2021-12-01
##
## ─ Packages ───────────────────────────────────────────────────────────────────
## package * version date lib source
## blogdown 1.5 2021-09-02 [1] CRAN (R 4.1.0)
## bookdown 0.24 2021-09-02 [1] CRAN (R 4.1.0)
## bslib 0.3.1 2021-10-06 [1] CRAN (R 4.1.0)
## cli 3.1.0 2021-10-27 [1] CRAN (R 4.1.0)
## curl 4.3.2 2021-06-23 [1] CRAN (R 4.1.0)
## digest 0.6.28 2021-09-23 [1] CRAN (R 4.1.0)
## evaluate 0.14 2019-05-28 [1] CRAN (R 4.1.0)
## fastmap 1.1.0 2021-01-25 [1] CRAN (R 4.1.0)
## highr 0.9 2021-04-16 [1] CRAN (R 4.1.0)
## htmltools 0.5.2 2021-08-25 [1] CRAN (R 4.1.0)
## jquerylib 0.1.4 2021-04-26 [1] CRAN (R 4.1.0)
## jsonlite 1.7.2 2020-12-09 [1] CRAN (R 4.1.0)
## knitr 1.36 2021-09-29 [1] CRAN (R 4.1.0)
## magick * 2.7.3 2021-08-18 [1] CRAN (R 4.1.0)
## magrittr 2.0.1 2020-11-17 [1] CRAN (R 4.1.0)
## png 0.1-7 2013-12-03 [1] standard (@0.1-7)
## R6 2.5.1 2021-08-19 [1] CRAN (R 4.1.0)
## Rcpp 1.0.7 2021-07-07 [1] CRAN (R 4.1.0)
## rlang 0.4.12 2021-10-18 [1] CRAN (R 4.1.0)
## rmarkdown 2.11 2021-09-14 [1] CRAN (R 4.1.0)
## rstudioapi 0.13 2020-11-12 [1] CRAN (R 4.1.0)
## sass 0.4.0 2021-05-12 [1] CRAN (R 4.1.0)
## sessioninfo 1.1.1 2018-11-05 [1] CRAN (R 4.1.0)
## stringi 1.7.5 2021-10-04 [1] CRAN (R 4.1.0)
## stringr 1.4.0 2019-02-10 [1] CRAN (R 4.1.0)
## withr 2.4.3 2021-11-30 [1] CRAN (R 4.1.1)
## xfun 0.26 2021-09-14 [1] CRAN (R 4.1.0)
## yaml 2.2.1 2020-02-01 [1] CRAN (R 4.1.0)
##
## [1] /Users/matt.dray/Library/R/x86_64/4.1/library
## [2] /Library/Frameworks/R.framework/Versions/4.1/Resources/library
Did I arrive at these settings scientifically? Yes, they were the ones that made me laugh when I saw the resulting output.↩︎
I have written before about this very serious topic. I developed a method to detect
=
for assignment without you having to open a script that contains it.↩︎