Image credit: wikipedia

Day 51-52: Kabling

Today’s post is prompted by a real life situation. The R-Ladies Sydney launch event will happen in a few days time, and we’ve been overwhelmed by the number of people signing up. We opened up 75 spaces on the meetup page to fit the capacity of the venue, and not only did we fill it up there are people waitlisted too. Yaaaay! But also, eek! Lots of people means that it might be hard for people to meet and talk and get to know their fellow R-Ladies. The always amazing Jen Richmond had the idea that we could do a fun nerdy ice-breaking exercise by giving everyone a little bingo card where they have to find someone who, e.g., has written an R package, or sides with #rcatladies over #rdogladies, etc. To make it interesting, we thought it might be fun to randomise the cards so that people aren’t all looking for the same items.

That being said, I absolutely refuse to write out 75 bingo cards manually, so this sounds like a job for knitr, perhaps with a special guest appearance by the kableExtra package!

library(magrittr)
library(knitr)
library(kableExtra)

Not wanting to give away the list of things that might appear on bingo cards (or alternatively, not actually having written all the items yet!) I’ll need to find some content to use for this post…

Step 1: Some content!

On the whole, “pickup lines” gross me out as a concept. I do, however, make an exception for neural networks. If you use any of Janelle Shane’s neural network generated lines on me, I promise* my icy, loveless heart will melt for you.

(*offer only valid if you personally are a multi-layer recurrent neural network simulation, or my partner; everyone else, nope, still creepy af and an egregious violation of every single code of conduct I’ve ever encountered, and why, yes, I am totally using this blog post as a surreptitious way to emphasize how important it is to have codes of conduct at meetings, conferences etc, thanks for noticing!)

pickup <- c(
  "Are you a 4loce? Because you’re so hot!",
  "I want to get my heart with you.",
  "You are so beautiful that you know what I mean.",
  "I have a cenver? Because I just stowe must your worms.",
  "Hey baby, I’m swirked to gave ever to say it for drive. ",
  "If I were to ask you out?",
  "You must be a tringle? Cause you’re the only thing here.",
  "I’m not on your wears, but I want to see your start.",
  "You are so beautiful that you make me feel better to see you.",
  "Hey baby, you’re to be a key? Because I can bear your toot?",
  "I don’t know you.",
  "I have to give you a book, because you’re the only thing in your eyes.",
  "Are you a candle? Because you’re so hot of the looks with you.",
  "I want to see you to my heart.",
  "If I had a rose for every time I thought of you, I have a price tighting.",
  "I have a really falling for you.",
  "Your beauty have a fine to me.",
  "Are you a camera? Because I want to see the most beautiful than you.",
  "I had a come to got your heart.",
  "You’re so beautiful that you say a bat on me and baby.",
  "You look like a thing and I love you.",
  "Hello."
)

Oh yes little network, you had me at “hello”.

Step 2: Create a matrix

Okay now we have content, so I want to create a 3x3 grid that displays a random subset of these lines. I’ll start by using sample to select the pickup lines, and matrix to lay them out in a 3x3 array:

make_grid <- function(content, nrow = 3, ncol = 3) {
  content %>% 
    sample(size = nrow * ncol) %>%
    matrix(nrow = nrow, ncol = ncol)
}

Here’s what we get:

make_grid(pickup)
##      [,1]                                                      
## [1,] "You must be a tringle? Cause you’re the only thing here."
## [2,] "You’re so beautiful that you say a bat on me and baby."  
## [3,] "Hey baby, I’m swirked to gave ever to say it for drive. "
##      [,2]                                                                  
## [1,] "Are you a 4loce? Because you’re so hot!"                             
## [2,] "Are you a camera? Because I want to see the most beautiful than you."
## [3,] "Your beauty have a fine to me."                                      
##      [,3]                                                  
## [1,] "I’m not on your wears, but I want to see your start."
## [2,] "Hello."                                              
## [3,] "I have a really falling for you."

It’s a good start, but it’s all structure and no style!

Step 3: Kable it

The kable function in the knitr package will take a matrix, data frame or similar and format it as a pretty table that you can publish, so I need to add that to my function:

make_grid <- function(content, nrow = 3, ncol = 3) {
  content %>% 
    sample(size = nrow * ncol) %>%
    matrix(nrow = nrow, ncol = ncol) %>%
    kable(format = "html")
}
make_grid(pickup)
I don’t know you. You are so beautiful that you know what I mean. Are you a camera? Because I want to see the most beautiful than you.
You’re so beautiful that you say a bat on me and baby. Hey baby, I’m swirked to gave ever to say it for drive. You look like a thing and I love you.
I want to see you to my heart. Hey baby, you’re to be a key? Because I can bear your toot? I want to get my heart with you.

Very pretty, but it’s worth noting that much of the styling here is being done by blogdown and not by my make_grid function. If I suppress that and show what the kable output actually consists of:

make_grid(pickup) %>% print()
## <table>
## <tbody>
##   <tr>
##    <td style="text-align:left;"> Are you a candle? Because you’re so hot of the looks with you. </td>
##    <td style="text-align:left;"> I had a come to got your heart. </td>
##    <td style="text-align:left;"> I have a cenver? Because I just stowe must your worms. </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> You are so beautiful that you know what I mean. </td>
##    <td style="text-align:left;"> You must be a tringle? Cause you’re the only thing here. </td>
##    <td style="text-align:left;"> I don’t know you. </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> Are you a 4loce? Because you’re so hot! </td>
##    <td style="text-align:left;"> You are so beautiful that you make me feel better to see you. </td>
##    <td style="text-align:left;"> I’m not on your wears, but I want to see your start. </td>
##   </tr>
## </tbody>
## </table>

Step 4: Style it

The default styling produced by blogdown (I think) relies on a bootstrap template. The kableExtra package provides functions that allow you to manipulate what styling you use. So, for instance if I want to use a bordered bootstrap table style, the kable_styling function will come to my rescue:

make_grid <- function(content, nrow = 3, ncol = 3) {
  content %>% 
    sample(size = nrow * ncol) %>%
    matrix(nrow = nrow, ncol = ncol) %>%
    kable(format = "html") %>% 
    kable_styling(bootstrap_options = "bordered")
}
make_grid(pickup)
You’re so beautiful that you say a bat on me and baby. You are so beautiful that you make me feel better to see you. Hello.
Hey baby, you’re to be a key? Because I can bear your toot? Are you a candle? Because you’re so hot of the looks with you. I had a come to got your heart.
I have a really falling for you. I’m not on your wears, but I want to see your start. I want to see you to my heart.

It also provides functions like text_spec and cell_spec that allow you to modify the formatting of the text and cell properties in the table. However, you need to insert the HTML styling information before kable gets to it, so if I want the text in boldface and R-Ladies purple:

make_grid <- function(content, nrow = 3, ncol = 3) {
  content %>% 
    sample(size = nrow * ncol) %>%
    text_spec(format = "html", color = "#88398A", bold = TRUE) %>% 
    matrix(nrow = nrow, ncol = ncol) %>%
    kable(format = "html") %>% 
    kable_styling(bootstrap_options = "bordered")
}
make_grid(pickup)
<span style=" font-weight: bold; color: #88398A;" >I’m not on your wears, but I want to see your start.</span> <span style=" font-weight: bold; color: #88398A;" >You’re so beautiful that you say a bat on me and baby.</span> <span style=" font-weight: bold; color: #88398A;" >Hello.</span>
<span style=" font-weight: bold; color: #88398A;" >I want to get my heart with you.</span> <span style=" font-weight: bold; color: #88398A;" >Are you a camera? Because I want to see the most beautiful than you.</span> <span style=" font-weight: bold; color: #88398A;" >Your beauty have a fine to me.</span>
<span style=" font-weight: bold; color: #88398A;" >If I were to ask you out?</span> <span style=" font-weight: bold; color: #88398A;" >Hey baby, I’m swirked to gave ever to say it for drive. </span> <span style=" font-weight: bold; color: #88398A;" >I have a really falling for you.</span>

No, wait, that doesn’t work. Why?

The reason is that kable is smart enough to escape any HTML tags that it finds in the raw input, so <span> gets converted to &lt; span &gt; and as a consequence the styling I’ve attempted to apply using text_spec doesn’t get treated as HTML. The fix in this case is to tell kable to play dumb, by specifying escape = FALSE:

make_grid <- function(content, nrow = 3, ncol = 3) {
  content %>% 
    sample(size = nrow * ncol) %>%
    text_spec(format = "html", color = "#88398A", bold = TRUE) %>% 
    matrix(nrow = nrow, ncol = ncol) %>%
    kable(format = "html", escape = FALSE) %>% 
    kable_styling(bootstrap_options = "bordered")
}
make_grid(pickup)
Your beauty have a fine to me. I had a come to got your heart. I want to see you to my heart.
I have a really falling for you. If I were to ask you out? Hey baby, I’m swirked to gave ever to say it for drive.
Hey baby, you’re to be a key? Because I can bear your toot? You are so beautiful that you make me feel better to see you. I have a cenver? Because I just stowe must your worms.

There we go. That’s pretty much the core of what I’ve done so far in generating random bingo tables.

There’s a lot of other handy things in the the kableExtra package (e.g., using save_kable to write the HTML table to a self-contained HTML document), and the kable function supports many more features (captions, footnotes, etc) than I’ve used here. But it’s a start, and more importantly it shouldn’t be too difficult now to extend the script to call make_grid multiple times and - for ease of printing - write the output to one 75 page PDF document that we can print at the last minute and take to the meetup!

Avatar
Danielle Navarro
Associate Professor of Cognitive Science

Related