Recently I’ve seen some interesting posts showing how to make ASCII art in R (see here and here). Why limit ourselves to ASCII, I thought. Lincoln’s portrait could be drawn with the Gettysberg Address instead of commas and semicolons. And Trump’s portrait really deserves his tweets1.

Lincoln/Gettysberg

Let’s load Lincoln’s image using the imager package. I’ll resize it because it’s huge, and convert it to grayscale:

library(tidyverse)
library(stringr)
library(imager)
library(abind)

img <- load.image("~/lincoln.jpg") %>%
  resize(700, 500) %>%
  grayscale()

plot(img)

Now let’s get the Gettysberg Address from here using the rvest package:

library(rvest)

text <- read_html("http://avalon.law.yale.edu/19th_century/gettyb.asp") %>%
  html_nodes("p") %>%
  html_text()

text
## [1] "\"Fourscore and seven years ago our fathers brought forth on this continent a new nation, conceived in liberty and dedicated to the proposition that all men are created equal. Now we are engaged in a great civil war, testing whether that nation or any nation so conceived and so dedicated can long endure. We are met on a great battlefield of that war. We have come to dedicate a portion of that field as a final resting-place for those who here gave their lives that that nation might live. It is altogether fitting and proper that we should do this. But in a larger sense, we cannot dedicate, we cannot consecrate, we cannot hallow this ground. The brave men, living and dead who struggled here have consecrated it far above our poor power to add or detract. The world will little note nor long remember what we say here, but it can never forget what they did here. It is for us the living rather to be dedicated here to the unfinished work which they who fought here have thus far so nobly advanced. It is rather for us to be here dedicated to the great task remaining before us--that from these honored dead we take increased devotion to that cause for which they gave the last full measure of devotion--that we here highly resolve that these dead shall not have died in vain, that this nation under God shall have a new birth of freedom, and that government of the people, by the people, for the people shall not perish from the earth.\"  "

Now let’s convert Lincoln’s image into a 500 x 700 (transposed) matrix. It is now in grayscale mode, so there is only a single color channel, with values randing from 0 to 1:

imgGSMat <- img %>% as.matrix() %>% t()

dim(imgGSMat)
## [1] 500 700
summary(c(imgGSMat))
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## 0.03137 0.09804 0.60000 0.46649 0.80784 0.99608

Let’s suppose the region we’ll print the text in, is where the pixels value is lower (= darker) than a certain threshold, say 0.5, and let’s plot this region to see it makes sense:

plot(as.cimg(imgGSMat > 0.5))

Don’t worry about the image being rotated, this will work out eventually. For now I just wanted to make sure the “dark” region with our chosen threshold looks OK, and it appears so.

To fill the dark region with the Gettysberg Address let’s split the text into characters. Then, we’ll loop over the entire matrix and text, and when we’re in the “dark” region, we’ll plot the current text character. We’ll use the grid package for plotting.

library(grid)

text <- str_split(text, "")[[1]]

grid.newpage()

counter <- 0

for (i in seq(1, nrow(imgGSMat), 13)) {
  for (j in seq(1, ncol(imgGSMat), 5)) {
    if (imgGSMat[i, j] < 0.5) {
      counter <- ifelse(counter < length(text), counter + 1, 1)
      grid.text(text[counter],
                x = j / ncol(imgGSMat),
                y = 1 - i / nrow(imgGSMat),
                gp = gpar(fontsize = 10),
                just = "left")
    }
  }
}

This is a good start, but a failure nonetheless. A few things to notice:

  • We’re not really looping through the entire matrix of pixels. Since the font size is currently 10, we’re looping through rows (image height) with the i variable in steps of 13 pixels.
  • We’re looping through columns (image width) with the j variable in fixed steps of 5 - which is clearly a problem, since there’s a variablity in the characters width.
  • Once the text is over we start from the beginning.
  • The grid.text function does not want our i and j as pixels, but as fractions from the image’s height and width respectively.

So the main issue here is the assumption of fixed width for all letters. Let’s change that with distinguishing between “fat” and “skinny” letters (the rest will be “regular”):

fatChars <- c(LETTERS[-which(LETTERS == "I")], "m", "w", "@")
skinnyChars <- c("l", "I", "i", "t", "'", "f")
  
grid.newpage()
  
counter <- 0
  
for (i in seq(1, nrow(imgGSMat), 13)) {
  for (j in seq(1, ncol(imgGSMat), 10)) {
    if (imgGSMat[i, j] < 0.5) {
      counter <- ifelse(counter < length(text), counter + 1, 1)
      beforeLastChar <- ifelse(counter > 2, lastChar, " ")
      lastChar <- ifelse(counter > 1, char, " ")
      char <- text[counter]
      grid.text(char,
                x = j/ncol(imgGSMat) +
                  0.004 * (lastChar %in% fatChars) -
                  0.003 * (lastChar %in% skinnyChars) +
                  0.003 * (beforeLastChar %in% fatChars) -
                  0.002 * (beforeLastChar %in% skinnyChars),
                y = 1 - i / nrow(imgGSMat),
                gp = gpar(fontsize = 10),
                just = "left")
    }
  }
}

Looks much better although the “algorithm” is somewhat dirty.

Let’s put it in a function anyway, making the threshold, font size and some other parameters configurable:

drawImageWithText <- function(img, text, thresh, fontSize = 10,
                              fileName = "myfile.png",
                              resize = TRUE, saveToDisk = FALSE) {
  
  text <- paste(text, collapse = " ")
  text <- str_replace_all(text, "\n+", " ")
  text <- str_replace_all(text, " +", " ")
  
  text <- str_split(text, "")[[1]]
  
  if (resize) img <- resize(img, 700, 500)
  
  imgGSMat <- img %>% grayscale %>% as.matrix %>% t()
  
  fatChars <- c(LETTERS[-which(LETTERS == "I")], "m", "w", "@")
  skinnyChars <- c("l", "I", "i", "t", "'", "f")
  
  if (saveToDisk) png(fileName, width(img), height(img))
  
  grid.newpage()
  
  counter <- 0
  
  for (i in seq(1, nrow(imgGSMat) - fontSize, fontSize + floor(fontSize / 3))) {
    for (j in seq(1, ncol(imgGSMat) - fontSize, fontSize)) {
      if (imgGSMat[i, j] < thresh) {
        counter <- ifelse(counter < length(text), counter + 1, 1)
        beforeLastChar <- ifelse(counter > 2, lastChar, " ")
        lastChar <- ifelse(counter > 1, char, " ")
        char <- text[counter]
        grid.text(char,
                  x = 0.01 + j/ncol(imgGSMat) +
                    0.004 * (lastChar %in% fatChars) -
                    0.003 * (lastChar %in% skinnyChars) +
                    0.003 * (beforeLastChar %in% fatChars) -
                    0.002 * (beforeLastChar %in% skinnyChars),
                  y = 1 - i / nrow(imgGSMat) - 0.01,
                  gp = gpar(fontsize = fontSize),
                  just = "left")
      }
    }
  }
  
  if (saveToDisk) dev.off()
}

Martin Luther King Jr./I Have A Dream

Let’s test our function on Martin Luther King Jr. and his iconic speech taken from here:

img <- load.image("~/mlkj.jpg")

text <- read_lines("~/ihaveadream.txt")

drawImageWithText(img, text, thresh = 0.3, fontSize = 5)

Free, at last.

Marylin Monroe/Her Wikipedia Article

img <- load.image("~/marylin.jpg")

text <- read_html("https://en.wikipedia.org/wiki/Marilyn_Monroe") %>%
  html_nodes("p") %>%
  html_text() %>%
  str_replace_all(., "\\[[0-9]+\\]", "")

drawImageWithText(img, text, thresh = 0.5, fontSize = 8)

Adele/Rolling In The Deep

img <- load.image("~/adele.jpg")

text <- read_lines("~/rollinginthedeep.txt")

drawImageWithText(img, text, thresh = 0.5, fontSize = 10)

Hadley Wickham/The dplyr code

img <- load.image("~/hadley.jpg")

text <- read_html("https://github.com/tidyverse/dplyr/blob/master/src/mutate.cpp") %>%
  html_nodes("div") %>%
  .[[47]] %>%
  html_text()

drawImageWithText(img, text, thresh = 0.75, fontSize = 5)

This example with Hadley is a bit different, because here the original image isn’t black and white. It has colors, and we could use some color, so let’s change the function a bit:

drawImageWithText <- function(img, text, thresh, color = FALSE,
                              fontSize = 10, fileName = "myfile.png",
                              resize = TRUE, saveToDisk = FALSE) {
  
  if (color) {
    if (spectrum(img) == 1) {
      warning("Image is in grayscale mode, setting color to FALSE.")
      color = FALSE
    }
  }
  
  text <- paste(text, collapse = " ")
  text <- str_replace_all(text, "\n+", " ")
  text <- str_replace_all(text, " +", " ")
  
  text <- str_split(text, "")[[1]]
  
  if (resize) img <- resize(img, 700, 500)
  
  imgMat <- img %>%  as.array() %>% adrop(3) %>% aperm(c(2, 1, 3))
  
  imgGSMat <- img %>% grayscale %>% as.matrix %>% t()
  
  fatChars <- c(LETTERS[-which(LETTERS == "I")], "m", "w", "@")
  skinnyChars <- c("l", "I", "i", "t", "'", "f")
  
  if (saveToDisk) png(fileName, width(img), height(img))
  
  grid.newpage()
  
  counter <- 0
  
  for (i in seq(1, nrow(imgGSMat) - fontSize, fontSize + 1)) {
    for (j in seq(1, ncol(imgGSMat) - fontSize, fontSize)) {
      if (imgGSMat[i, j] < thresh) {
        counter <- ifelse(counter < length(text), counter + 1, 1)
        beforeLastChar <- ifelse(counter > 2, lastChar, " ")
        lastChar <- ifelse(counter > 1, char, " ")
        char <- text[counter]
        grid.text(char,
                  x = 0.01 + j/ncol(imgGSMat) +
                    0.004 * (lastChar %in% fatChars) -
                    0.003 * (lastChar %in% skinnyChars) +
                    0.003 * (beforeLastChar %in% fatChars) -
                    0.002 * (beforeLastChar %in% skinnyChars),
                  y = 1 - i / nrow(imgGSMat) - 0.01,
                  gp = gpar(fontsize = fontSize, col = ifelse(!color, 
                                                        "black",
                                                        rgb(imgMat[i, j, 1],
                                                            imgMat[i, j, 2],
                                                            imgMat[i, j, 3]))),
                  just = "left")
      }
    }
  }
  
  if (saveToDisk) suppressMessages(dev.off())
}

drawImageWithText(img, text, thresh = 0.9, color = TRUE, fontSize = 5)

Nice! Sorry, Hadley.

Trump/His Tweets

Let’s write a wrapper around our drawImageWithText function that will automatically download a Twitter user’s image and tweets - and use those as img and text. We’ll use the wonderful rtweet package for this:

library(rtweet)

drawImageWithTextFromTwitter <- function(username, thresh, ...) {
  text <- get_timeline(username, n = 200) %>%
    select(text) %>%
    unlist() %>%
    discard(str_detect(., "^RT")) %>%
    str_replace(., "(http|https)[^([:blank:]|\"|<|&|#\n\r)]+", "") %>%
    str_extract_all(., "[a-zA-Z0-9[:punct:]]+") %>%
    unlist %>%
    paste(., collapse = " ")
  
  img <- load.image(lookup_users(username)$profile_image_url)
  
  drawImageWithText(img, text, thresh, ...)
}

Let’s do Trump:

drawImageWithTextFromTwitter("realDonaldTrump", 0.55, fontSize = 8)

Tyra Banks/Her Tweets

drawImageWithTextFromTwitter("tyrabanks", 0.9, color = TRUE, fontSize = 5)

Congratulations. You’re still in the running towards becoming America’s Next Top Model.

That’s It

Next step is, obviously, making T-shirts. Enjoy!


  1. Or is it the other way around.