Day 51-52: Kabling

by Danielle Navarro, 16 Jun 2018



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,] "If I were to ask you out?"
## [2,] "I don’t know you."        
## [3,] "Hello."                   
##      [,2]                                                                       
## [1,] "If I had a rose for every time I thought of you, I have a price tighting."
## [2,] "Your beauty have a fine to me."                                           
## [3,] "I have to give you a book, because you’re the only thing in your eyes."   
##      [,3]                                                         
## [1,] "I had a come to got your heart."                            
## [2,] "Hey baby, you’re to be a key? Because I can bear your toot?"
## [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)
Are you a candle? Because you’re so hot of the looks with you. Are you a 4loce? Because you’re so hot! You must be a tringle? Cause you’re the only thing here.
Hey baby, I’m swirked to gave ever to say it for drive. If I had a rose for every time I thought of you, I have a price tighting. You are so beautiful that you know what I mean.
I’m not on your wears, but I want to see your start. You look like a thing and I love you. I have a cenver? Because I just stowe must your worms.

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;"> You are so beautiful that you know what I mean. </td>
##    <td style="text-align:left;"> You’re so beautiful that you say a bat on me and baby. </td>
##    <td style="text-align:left;"> I want to get my heart with you. </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> Hello. </td>
##    <td style="text-align:left;"> I have a cenver? Because I just stowe must your worms. </td>
##    <td style="text-align:left;"> I have a really falling for you. </td>
##   </tr>
##   <tr>
##    <td style="text-align:left;"> I have to give you a book, because you’re the only thing in your eyes. </td>
##    <td style="text-align:left;"> If I were to ask you out? </td>
##    <td style="text-align:left;"> You are so beautiful that you make me feel better to see you. </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 are so beautiful that you know what I mean. You look like a thing and I love you. If I were to ask you out?
I’m not on your wears, but I want to see your start. I want to get my heart with you. Hello.
I don’t know you. Hey baby, you’re to be a key? Because I can bear your toot? I have to give you a book, because you’re the only thing in your eyes.

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 !important;" >You must be a tringle? Cause you’re the only thing here.</span> <span style=" font-weight: bold; color: #88398A !important;" >I don’t know you.</span> <span style=" font-weight: bold; color: #88398A !important;" >You are so beautiful that you make me feel better to see you.</span>
<span style=" font-weight: bold; color: #88398A !important;" >Are you a candle? Because you’re so hot of the looks with you.</span> <span style=" font-weight: bold; color: #88398A !important;" >I have a cenver? Because I just stowe must your worms.</span> <span style=" font-weight: bold; color: #88398A !important;" >Are you a 4loce? Because you’re so hot!</span>
<span style=" font-weight: bold; color: #88398A !important;" >If I were to ask you out?</span> <span style=" font-weight: bold; color: #88398A !important;" >I have a really falling for you.</span> <span style=" font-weight: bold; color: #88398A !important;" >I want to see you to my heart.</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)
I want to see you to my heart. I have a really falling for you. I want to get my heart with you.
You look like a thing and I love you. Are you a 4loce? Because you’re so hot! I’m not on your wears, but I want to see your start.
Hey baby, I’m swirked to gave ever to say it for drive. You’re so beautiful that you say a bat on me and baby. Are you a candle? Because you’re so hot of the looks with you.

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!