The MockUp https://themockup.blog/index.html Data science tips brought to you by Tom Mock https://themockup.blog/themockup.png The MockUp https://themockup.blog/index.html quarto-1.4.193 Fri, 15 Sep 2023 05:00:00 GMT Removing background from GenAI art Tom Mock https://themockup.blog/posts/2023-09-15-removing-backgrounds-from-generated-art/index.html Generative AI created art from tools like Midjourney is quite fun for creating unique images. However, the background is typically at best a solid color.

This post is a quick but useful tip for removing the background from GenAI art. I’ll use the always helpful magick package.

library(magick)

raw_img <- image_read("howard-robot-goggles.png")

raw_img |> image_resize("400x")

library(magick)

make_transparent <- function(path, fuzz = 10){

  name <- fs::path_ext_remove(path)

  logo <- image_read(path)

  out_logo <- logo |>
    image_fill(
      color = "transparent",
      fuzz = fuzz,
      point = "+1+1"
    ) 
  
  image_write(out_logo, paste0(name, "_transparent.png"))
  
  return(image_resize(out_logo, "400x"))

}

Then we can actually apply the make_transparent() function on the image.

make_transparent("howard-robot-goggles.png")

]]> https://themockup.blog/posts/2023-09-15-removing-backgrounds-from-generated-art/index.html Fri, 15 Sep 2023 05:00:00 GMT Rolling summaries with {slider} in R Tom Mock https://themockup.blog/posts/2022-11-16-rolling-summaries-with-slider-in-r/index.html I have been a big fan of the slider package for a long time! It recently had a CRAN release for v0.3 - check out the package documentation at https://slider.r-lib.org/news/index.html.

While it is a useful tool for any time series or rolling summary analysis, I’ll demo an example with some sports data.

Libraries and data

We’ll use nflreadr to load the nflfastR database, along with the tidyverse and slider itself.

── Attaching packages ────────────────────────────────── tidyverse 1.3.2.9000 ──
✔ ggplot2   3.4.0      ✔ dplyr     1.0.10
✔ tibble    3.1.8      ✔ stringr   1.4.1 
✔ tidyr     1.2.1      ✔ forcats   0.5.1 
✔ readr     2.1.3      ✔ lubridate 1.8.0 
✔ purrr     0.3.5      
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
library(nflreadr)
library(slider)
library(ggridges)
library(ggtext)

# load the years when Mahomes has been active
pbp_db <- nflreadr::load_pbp(2017:2022)

Filter the data

We’ll limit ourselves to some of the top QBs in the NFL.

qb_names <- c(
  "P.Mahomes",
  "A.Rodgers",
  "J.Allen",
  "D.Prescott",
  "R.Tannehill",
  "D.Carr",
  "R.Wilson",
  "T.Brady",
  "M.Stafford",
  "L.Jackson",
  "M.Ryan",
  "K.Cousins"
)

And then figure out the last date/week:

cur_date <- pbp_db |> 
  filter(passer_player_name =="P.Mahomes") |> 
  distinct(game_date, .keep_all = TRUE) |> 
  slice_max(game_date, n = 1) |> 
  select(game_date, week, season)

And then get the values of interest for these specific QBs.

qb_tops <- pbp_db |>
  filter(
    !is.na(epa),
    play_type %in% c("pass", "run")
  ) |>
  filter(
    passer_player_name %in% qb_names |
      rusher_player_name %in% qb_names,
  ) |>
  mutate(
    name = if_else(
      is.na(passer_player_name), 
      rusher_player_name, 
      passer_player_name
      )
    ) |>
  select(name, posteam, defteam, season, game_id, epa)

glimpse(qb_tops)
Rows: 39,188
Columns: 6
$ name    <chr> "M.Stafford", "M.Stafford", "M.Stafford", "M.Stafford", "M.Sta…
$ posteam <chr> "DET", "DET", "DET", "DET", "DET", "DET", "DET", "DET", "DET",…
$ defteam <chr> "ARI", "ARI", "ARI", "ARI", "ARI", "ARI", "ARI", "ARI", "ARI",…
$ season  <int> 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 2017, 20…
$ game_id <chr> "2017_01_ARI_DET", "2017_01_ARI_DET", "2017_01_ARI_DET", "2017…
$ epa     <dbl> -11.6032015, -0.5463381, -1.5034251, -1.7764411, -0.1084029, -…

The data is now ready for some analysis! We hae the player’s name, season, game_id and their EPA (expected points added).

Slide across values

At a basic level, the slide_ functions allow you to reference a specific row along with previous rows (lagging) and the next rows (leading).

I find this most useful for rolling summarizing functions such as rolling means. From the slider docs:

slider is a package for rolling analysis using window functions. “Window functions” is a term that I’ve borrowed from SQL that means that some function is repeatedly applied to different “windows” of your data as you step through it. Typical examples of applications of window functions include rolling averages, cumulative sums, and more complex things such as rolling regressions.

Most typically, this will be used within an existing dataframe, but let’s show a quick example on a vector.

We can return a list of equal length to the input, that accumulates the current row plus 2 values before it. Note that it slides across the values and won’t return more than the 3 requested (current row + 2 rows before).

slide() will return a list object.

slide(1:4, ~.x, .before = 2)
[[1]]
[1] 1

[[2]]
[1] 1 2

[[3]]
[1] 1 2 3

[[4]]
[1] 2 3 4

Or more realistically, we can generate the rolling mean of the current row and up to two rows before. Note that I’ve now used slide_dbl() - similar to purrr there is specific type safety, and you specify what you want to return (character, dbl, list as default, etc).

slide_dbl(1:4, mean, .before = 2)
[1] 1.0 1.5 2.0 3.0

This is basically equivalent to the below:

c(
  mean(1),
  mean(1:2),
  mean(1:3),
  mean(2:4)
)
[1] 1.0 1.5 2.0 3.0

I also want to callout the .complete argument:

Should the function be evaluated on complete windows only? If FALSE, the default, then partial computations will be allowed.

.complete = TRUE will only generate complete computations of the current row and the specific .before or .after amount. See below where we need at least 3 observations to generate the mean, and the first two calculations return NA (since they are length 1 and length 2, respectively.)

slide_dbl(1:4, mean, .before = 2, .complete = TRUE)
[1] NA NA  2  3

Kind of like the below (but again much more safety/power in slider):

c(
  ifelse(length(1)   == 3, mean(1),   NA),
  ifelse(length(1:2) == 3, mean(1:2), NA),
  ifelse(length(1:3) == 3, mean(1:3), NA),
  ifelse(length(2:4) == 3, mean(2:4), NA)
)
[1] NA NA  2  3

Lastly, there are also specialized functions for typical summaries - great for the most common usecases!

slider::slide_mean(1:4, before = 2)
[1] 1.0 1.5 2.0 3.0
slider::slide_sum(1:4, before = 2)
[1] 1 3 6 9
slider::slide_max(1:4, before = 2, step = 2)
[1]  1 NA  3 NA

Slide across rows

Now vectors are fine, but we want to use it in a dataframe, across “windows” in a specific column.

We can read the below code as: - For each quarterback - Calculate the rolling average of EPA - Of the current row, and the 99 previous rows - and only for .complete windows - so it will return NA for windows < 100

test_slide <- qb_tops |>
  group_by(name) |>
  summarize(
    slide_mean = slide_dbl(
      .x = epa, .f = mean, 
      .before = 99L, .complete = TRUE
      ),
  )
`summarise()` has grouped output by 'name'. You can override using the
`.groups` argument.
test_slide
# A tibble: 39,188 × 2
# Groups:   name [12]
   name      slide_mean
   <chr>          <dbl>
 1 A.Rodgers         NA
 2 A.Rodgers         NA
 3 A.Rodgers         NA
 4 A.Rodgers         NA
 5 A.Rodgers         NA
 6 A.Rodgers         NA
 7 A.Rodgers         NA
 8 A.Rodgers         NA
 9 A.Rodgers         NA
10 A.Rodgers         NA
# … with 39,178 more rows

Notice that the first few rows are all NA since we have specified .complete = TRUE. For our analysis, we’ll want to exclude NA values after.

We can calculate the rolling mean and a lot more!

qb_sum <- qb_tops |>
  group_by(name) |>
  summarize(
    slide_mean = slide_dbl(.x = epa, .f = mean, .before = 99L, .complete = TRUE),
    slide_median = slide_dbl(.x = epa, .f = median, .before = 99L, .complete = TRUE),
    slide_sum = slide_dbl(.x = epa, .f = sum, .before = 99L, .complete = TRUE),
    absolute_median = median(epa),
    absolute_mean = mean(epa),
    absolute_sum = sum(epa),
    posteam = tail(posteam, n = 1)
  ) |>
  ungroup() |>
  filter(!is.na(slide_mean)) |>
  # sort by the overall best median
  arrange(desc(absolute_median))
`summarise()` has grouped output by 'name'. You can override using the
`.groups` argument.
qb_sum |> glimpse()
Rows: 38,000
Columns: 8
$ name            <chr> "P.Mahomes", "P.Mahomes", "P.Mahomes", "P.Mahomes", "P…
$ slide_mean      <dbl> 0.4677885, 0.4682522, 0.5148074, 0.4598741, 0.4597226,…
$ slide_median    <dbl> 0.2908019, 0.2908019, 0.3427478, 0.2908019, 0.2908019,…
$ slide_sum       <dbl> 46.77885, 46.82522, 51.48074, 45.98741, 45.97226, 45.7…
$ absolute_median <dbl> 0.1340611, 0.1340611, 0.1340611, 0.1340611, 0.1340611,…
$ absolute_mean   <dbl> 0.2810101, 0.2810101, 0.2810101, 0.2810101, 0.2810101,…
$ absolute_sum    <dbl> 993.6518, 993.6518, 993.6518, 993.6518, 993.6518, 993.…
$ posteam         <chr> "KC", "KC", "KC", "KC", "KC", "KC", "KC", "KC", "KC", …

Plot the rolling mean

We can then plot the distribution of the rolling mean. First we’ll generate a vector of colors to use for names and then join the team colors to the QB dataframe for plotting.

name_colors <- if_else(
  unique(qb_sum$name) == "P.Mahomes", 
  "#e31837", 
  "black"
  ) |> rev()

dens_df <- qb_sum |>
  group_by(name) |>
  mutate(
    median_of_slides = median(slide_mean),
    fill_color = if_else(name == "P.Mahomes", "#e31837", "grey"),
    out_color = if_else(name == "P.Mahomes", "#e31837", "white")
  ) |>
  ungroup() |>
  left_join(
    nflfastR::teams_colors_logos |> select(posteam = team_abbr, team_color),
    by = "posteam"
  )

Then we can arrange the data by the overall median, create density ridgelines, and add some context.

mahomes_plot <- dens_df |>
  ggplot(
    aes(
      x = slide_mean,
      y = fct_reorder(name, median_of_slides, .desc = FALSE),
      fill = team_color
    )
  ) +
  geom_density_ridges(
    quantile_lines = TRUE,
    quantiles = 2,
    color = "#f0f0f0",
    size = 0.5
  ) +
  geom_vline(xintercept = 0, linewidth = 1, alpha = 0.5) +
  coord_cartesian(xlim = c(-0.3, 0.65)) +
  theme_minimal() +
  scale_fill_identity(aesthetics = c("fill", "color")) +
  scale_x_continuous(breaks = scales::pretty_breaks(n = 8)) +
  labs(
    x = "Rolling 100 play mean EPA",
    y = "",
    caption = "\n**Plot**: @thomas_mock | **Data**: nflfastR",
    title = "Mahomes doesn't have bad streaks",
    subtitle = glue::glue("Distribution of rolling 100 play average passing/running EPA,\nthrough Week {cur_date$week} of {cur_date$season}")
  ) +
  tomtom::theme_538() +
  theme(
    axis.text.y = element_text(
      color = name_colors,
      face = c(rep("plain", 16), "bold"),
      size = 14,
      vjust = 0
    ),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    plot.caption = element_markdown(size = 12),
    plot.background = element_rect(fill = "white", color = "white")
  )

mahomes_plot

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.6
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-11-17
 pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
 quarto   1.2.242 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 dplyr       * 1.0.10     2022-09-01 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1      2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.4.0      2022-11-04 [1] CRAN (R 4.2.0)
 ggridges    * 0.5.3      2021-01-08 [1] CRAN (R 4.2.0)
 ggtext      * 0.1.1      2022-09-14 [1] Github (wilkelab/ggtext@50fdaba)
 lubridate   * 1.8.0      2021-10-07 [1] CRAN (R 4.2.0)
 nflreadr    * 1.3.0      2022-08-06 [1] CRAN (R 4.2.0)
 purrr       * 0.3.5      2022-10-06 [1] CRAN (R 4.2.0)
 readr       * 2.1.3      2022-10-01 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 slider      * 0.2.2      2021-07-01 [1] CRAN (R 4.2.0)
 stringr     * 1.4.1      2022-08-20 [1] CRAN (R 4.2.0)
 tibble      * 3.1.8      2022-07-22 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.1      2022-09-08 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.2.9000 2022-08-16 [1] Github (tidyverse/tidyverse@3be8283)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> https://themockup.blog/posts/2022-11-16-rolling-summaries-with-slider-in-r/index.html Wed, 16 Nov 2022 06:00:00 GMT Use R to generate a Quarto blogpost Tom Mock https://themockup.blog/posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/index.html I am a Quarto super fan for many reasons, and use Quarto for my personal blog. As such, I wanted to simplify the process of creating new blog posts for myself, so I wrote a quick function to do just that!

# possible arguments listed below
new_post <- function(
    title, 
    file = "index.qmd",
    description = "",
    author = "Tom Mock", 
    date = Sys.Date(), 
    draft = FALSE, 
    title_limit = 45,
    open_file = TRUE
    ){some_code}
new_post <- function(
    title, 
    file = "index.qmd",
    description = "",
    author = "Tom Mock", 
    date = Sys.Date(), 
    draft = FALSE, 
    title_limit = 40,
    open_file = TRUE
    ){

  # convert to kebab case and remove non space or alphanumeric characters
  title_kebab <- stringr::str_to_lower(title) |> 
    stringr::str_remove_all("[^[:alnum:][:space:]]") |> 
    stringr::str_replace_all(" ", "-")
  
  # warn if a very long slug
  if(nchar(title_kebab) >= title_limit){
    cli::cli_alert_warning("Warning: Title slug is longer than {.val {title_limit}} characters!")
  }
  
  # generate the slug as draft, prefix with _ which prevents
  # quarto from rendering/recognizing the folder
  if(draft){
    slug <- glue::glue("posts/_{date}-{title_kebab}")
    cli::cli_alert_info("Appending a '_' to folder name to avoid render while a draft, remove '_' when finished.")
  } else {
    slug <- glue::glue("posts/{date}-{title_kebab}")
  }
  
  # create and alert about directory
  fs::dir_create(
    path = slug
  )
  cli::cli_alert_success("Folder created at {.file {slug}}")
  
  # wrap description at 77 characters
  description <- stringr::str_wrap(description, width = 77) |> 
    stringr::str_replace_all("[\n]", "\n  ")
  
  # start generating file
  new_post_file <- glue::glue("{slug}/{file}")
  
  # build yaml core
  new_post_core <- c(
    "---",
    glue::glue('title: "{title}"'),
    "description: |",
    glue::glue('  {description}'),
    glue::glue("author: {author}"),
    glue::glue("date: {date}")
  )
  
  # add draft if draft
  if(draft){
    new_post_text <- c(
      new_post_core,
      "draft: true",
      "---\n"
      )
  } else {
    new_post_text <- c(
      new_post_core,
      "---\n"
    )
  }
  
  # finalize new post text
  new_post_text <- paste0(
    new_post_text,
    collapse = "\n"
    )
  
  # create file and alert
  fs::file_create(new_post_file)
  cli::cli_alert_success("File created at {.file {new_post_file}}")
  
  # print new post information
  cat(new_post_text)
  
  if(yesno::yesno2("Are you ready to write that to disk?")){
    writeLines(
    text = new_post_text,
    con = new_post_file
    )
  
  rstudioapi::documentOpen(new_post_file, line = length(new_post_text))
  }
  
}

I used it to write this meta blogpost:

new_post(
  "Use R to generate a Quarto blogpost", 
  description = "The {cli} and {fs} package make life easy!",
  draft = FALSE
  )

✔ Folder created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost
✔ File created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/index.qmd
---
title: "Use R to generate a Quarto blogpost"
description: |
  The {cli} and {fs} package make life easy!
author: Tom Mock
date: 2022-11-08
---

This function generates the core skeleton of a Quarto post, including the directory, the index.qmd and writes out some boilerplate information.

We’ll use a few packages to get this done.

library(stringr) # easy string manipulation
library(glue)    # easy adding of string together
library(fs)      # easy file manipulation
library(cli)     # easy and beautiful messages/warnings
library(yesno)   # easy binary decision prompts

Title of post

For the title, we want to convert a proper title to a kebab case title (kebab-case-like-this), with the date attached as well for easy sorting of folders.

title <- "Use R to generate a Quarto blogpost"
# convert to kebab case and remove non space or alphanumeric characters
title_kebab <- stringr::str_to_lower(title) |> 
  stringr::str_remove_all("[^[:alnum:][:space:]]") |> 
  stringr::str_replace_all(" ", "-")
title_kebab
[1] "use-r-to-generate-a-quarto-blogpost"

We can add a warning with cli if the title is too long. Too long is subjective, but we can arbitrary say 80 characters. My blog is at https://themockup.blog/posts/ and we want to add the date, so we have about 40 characters to work with.

80 - nchar("https://themockup.blog/posts/2022-11-08-")
[1] 40
title_limit <- 40
# we can put that into an if() to add the warning if criterion met
if(nchar(title_kebab) >= title_limit){
    cli::cli_alert_warning("Warning: Title slug is longer than {.val {title_limit}} characters!")
}

# we can force it to print like below
cli::cli_alert_warning("Warning: Title slug is longer than {.val {title_limit}} characters!")
! Warning: Title slug is longer than 40 characters!

After that, we can add the date and optionally the draft prefix, files with _ at the head are ignored by Quarto.

This is largely redundant with the draft: true YAML option - but this safeguards against additional files that could be rendered in that folder.
draft <- FALSE
date <- "2022-11-08" #< Sys.Date() for ISO date
if(draft){
  slug <- glue::glue("posts/_{date}-{title_kebab}")
  cli::cli_alert_info("Appending a '_' to folder name to avoid render while a draft, remove '_' when finished.")
} else {
  slug <- glue::glue("posts/{date}-{title_kebab}")
}

slug
posts/2022-11-08-use-r-to-generate-a-quarto-blogpost

Create folder

The folder name is what will end up as the URL “slug”, so we will end up with a url like:

https://themockup.blog/posts/2022-11-08-use-r-to-generate-a-quarto-blogpost

# create and alert about directory
fs::dir_create(
  path = slug
)
# print alert
cli::cli_alert_success("Folder created at {.file {slug}}")
✔ Folder created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost

Create blogpost file as index.qmd

We want to name our file index.qmd so that our slug is clean as:

https://themockup.blog/posts/2022-11-08-use-r-to-generate-a-quarto-blogpost

instead of:

https://themockup.blog/posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/some-file.html

Add description and wrap

We can take the description and limit the width to <= 80 characters (includes the spacing that YAML needs). We will replace the line breaks \n with leading spaces AND line breaks " \n" so that the alignment in the YAML is ok.

description <- "The {cli} and {fs} package make life easy!"
# wrap description at 77 characters
description <- stringr::str_wrap(description, width = 77) |> 
  stringr::str_replace_all("[\n]", "\n  ")
description
[1] "The {cli} and {fs} package make life easy!"

If the description were long…

long_desc <- "  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum" |> 
  stringr::str_wrap(width = 77) |> 
  stringr::str_replace_all("[\n]", "\n  ") 

paste0("description: |\n  ", long_desc)|> 
  cat()
description: |
  Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod
  tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam,
  quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo
  consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse
  cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non
  proident, sunt in culpa qui officia deserunt mollit anim id est laborum

Start file

We are using our default index.qmd to again avoid increasing the length of the slug.

file <- "index.qmd"
# start generating file
new_post_file <- glue::glue("{slug}/{file}")
new_post_file
posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/index.qmd

Build YAML core

Now we can start building up the YAML, using the glue package to insert the inputs:

author <- "Tom Mock"
new_post_core <- c(
  "---",
  glue::glue('title: "{title}"'),
  "description: |",
  glue::glue('  {description}'),
  glue::glue("author: {author}"),
  glue::glue("date: {date}")
)

new_post_core
[1] "---"                                           
[2] "title: \"Use R to generate a Quarto blogpost\""
[3] "description: |"                                
[4] "  The {cli} and {fs} package make life easy!"  
[5] "author: Tom Mock"                              
[6] "date: 2022-11-08"

Optionally adding the draft: true YAML option if needed…

# add draft if draft
if(draft){
  new_post_text <- c(
    new_post_core,
    "draft: true",
    "---\n"
    )
} else {
  new_post_text <- c(
    new_post_core,
    "---\n"
  )
}

Then we throw it all together and collapse with new lines (\n):

# finalize new post text
new_post_text <- paste0(
  new_post_text,
  collapse = "\n"
  )

new_post_text |> cat()
---
title: "Use R to generate a Quarto blogpost"
description: |
  The {cli} and {fs} package make life easy!
author: Tom Mock
date: 2022-11-08
---

Write out to the file

We can create a new file and then write out the YAML, I have this chunk as eval: false right now so that it doesn’t clobber our existing blog post…

fs::file_create(new_post_file) # <- don't want to recreate it :)
writeLines(
  text = new_post_text,
  con = new_post_file
  )
# create file and alert
# fs::file_create(new_post_file) <- don't want to recreate it :)
cli::cli_alert_success("File created at {.file {new_post_file}}")
✔ Folder created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost

Just for funsies we can also print out the raw text using cat() to accurately reflect what we’re adding with the new lines and spacing.

# print new post information
cat(new_post_text)
---
title: "Use R to generate a Quarto blogpost"
description: |
  The {cli} and {fs} package make life easy!
author: Tom Mock
date: 2022-11-08
---

Then we can have RStudio open the file we just wrote out!

rstudioapi::documentOpen(new_post_file, line = length(new_post_text))

For safety, we could use the {yesno} package to prompt the user that the cat() output looks correct:

if(yesno::yesno2("\nDoes that look correct and are you ready to write to disk?")){
    writeLines(
    text = new_post_text,
    con = new_post_file
    )
  
  rstudioapi::documentOpen(new_post_file, line = length(new_post_text))
  }
yesno::yesno2("\nDoes that look correct and are you ready to write to disk?")
Are you ready to write that to disk?
1: Yes
2: No

Selection: 1
[1] TRUE

All together

Putting it all together, we can create a new blogpost rapidly!

new_post(
  "Use R to generate a Quarto blogpost", 
  description = "The {cli} and {fs} package make life easy!",
  draft = FALSE
  )
✔ Folder created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost
✔ File created at posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/index.qmd
---
title: "Use R to generate a Quarto blogpost"
description: |
  The {cli} and {fs} package make life easy!
author: Tom Mock
date: 2022-11-08
---

The full function!

new_post <- function(
    title, 
    file = "index.qmd",
    description = "",
    author = "Tom Mock", 
    date = Sys.Date(), 
    draft = FALSE, 
    title_limit = 40,
    open_file = TRUE
    ){

  # convert to kebab case and remove non space or alphanumeric characters
  title_kebab <- stringr::str_to_lower(title) |> 
    stringr::str_remove_all("[^[:alnum:][:space:]]") |> 
    stringr::str_replace_all(" ", "-")
  
  # warn if a very long slug
  if(nchar(title_kebab) >= title_limit){
    cli::cli_alert_warning("Warning: Title slug is longer than {.val {title_limit}} characters!")
  }
  
  # generate the slug as draft, prefix with _ which prevents
  # quarto from rendering/recognizing the folder
  if(draft){
    slug <- glue::glue("posts/_{date}-{title_kebab}")
    cli::cli_alert_info("Appending a '_' to folder name to avoid render while a draft, remove '_' when finished.")
  } else {
    slug <- glue::glue("posts/{date}-{title_kebab}")
  }
  
  # create and alert about directory
  fs::dir_create(
    path = slug
  )
  cli::cli_alert_success("Folder created at {.file {slug}}")
  
  # wrap description at 77 characters
  description <- stringr::str_wrap(description, width = 77) |> 
    stringr::str_replace_all("[\n]", "\n  ")
  
  # start generating file
  new_post_file <- glue::glue("{slug}/{file}")
  
  # build yaml core
  new_post_core <- c(
    "---",
    glue::glue('title: "{title}"'),
    "description: |",
    glue::glue('  {description}'),
    glue::glue("author: {author}"),
    glue::glue("date: {date}")
  )
  
  # add draft if draft
  if(draft){
    new_post_text <- c(
      new_post_core,
      "draft: true",
      "---\n"
      )
  } else {
    new_post_text <- c(
      new_post_core,
      "---\n"
    )
  }
  
  # finalize new post text
  new_post_text <- paste0(
    new_post_text,
    collapse = "\n"
    )
  
  # create file and alert
  fs::file_create(new_post_file)
  cli::cli_alert_success("File created at {.file {new_post_file}}")
  
  # print new post information
  cat(new_post_text)
  
  if(yesno::yesno2("Are you ready to write that to disk?")){
    writeLines(
    text = new_post_text,
    con = new_post_file
    )
  
  rstudioapi::documentOpen(new_post_file, line = length(new_post_text))
  } 
  
}
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.6
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-11-08
 pandoc   2.19.2 @ /Applications/RStudio.app/Contents/Resources/app/quarto/bin/tools/ (via rmarkdown)
 quarto   1.2.242 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 cli         * 3.4.1   2022-09-23 [1] CRAN (R 4.2.0)
 fs          * 1.5.2   2021-12-08 [1] CRAN (R 4.2.0)
 glue        * 1.6.2   2022-02-24 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.1   2022-08-20 [1] CRAN (R 4.2.0)
 yesno       * 0.1.2   2020-07-10 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> meta quarto https://themockup.blog/posts/2022-11-08-use-r-to-generate-a-quarto-blogpost/index.html Tue, 08 Nov 2022 06:00:00 GMT Add a semi-transparent overlay to an image with {magick} Thomas Mock https://themockup.blog/posts/2022-06-22-magick-overlay/index.html I often find myself needing to apply a semi-transparent overlay in slides or reports to provide a better backdrop for text on top of a hero/splash image.

You can apply an overlay with CSS + background-image + gradients, but let’s do it natively in R with magick as that gives us more flexibility outside of a HTML environment.

Get an image

I’ll load magick and read in an example image of my coworker dog Howard.

Linking to ImageMagick 6.9.12.3
Enabled features: cairo, fontconfig, freetype, heic, lcms, pango, raw, rsvg, webp
Disabled features: fftw, ghostscript, x11
library(scales)

raw_img <- image_read("https://pbs.twimg.com/media/EabpU96WsAIJjG0?format=jpg&name=large")
raw_img

Quick overlay

You can apply a quick overlay of a single color with a simple “one liner” - but we’ll go a bit more custom in case as I’m sure I’ll want to know how someday!

image_colorize(raw_img, 37, "black") |> 
  image_resize(350)

Define overlay function

The basic idea is to draw a rectangle the exact size of the image OVER the image with some transparency.

The create_overlay() function takes a raw image url/path or magick-image and then applies your chosen color to it.

create_overlay <- function(img, overlay_color = "#00000060", out_file = NULL){
  if(!("magick-image" %in% class(img))){
    raw_img <- image_read(img)
  } else if ("magick-image" %in% class(img)){
    raw_img <- img
  }
  
  # get image dimensions
  img_info <- image_info(raw_img)
  
  # draw the raw image
  img_overlay <- image_draw(raw_img)
  # draw a rectangle of equal proportion to the raw image
  rect(0, 0, img_info$width, img_info$height, col = overlay_color, border = NA)
  # save the results
  dev.off()
  
  # return it or return + save out
  if(!is.null(out_file)){
    image_write(img_overlay, path = out_file)
    message(paste("Image saved as", out_file))
    return(img_overlay)
  } else {
    return(img_overlay)
  }
}

We can then use the function to apply some colors. Hex codes are typically 6 digits, but you can add transparency by varying the values at the end of string. So #000000 is black but #00000050 is black with 50% transparency.

scales::show_col(c("#000000", paste0("#000000", seq(90, 10, length.out = 5))))

Alternatively, you could use scales::alpha() to convert named colors like "red" to their alpha ranges.

scales::alpha("red", seq(1, 0.1, length.out = 6)) |> 
  scales::show_col()

Compare the image

Now we can use our function to generate the overlay image but it’s rather large… and I’d like to see it side-by-side with the original for easier comparison. We can use magick::image_append() + magick::image_resize().

faded_img <- create_overlay(raw_img, overlay_color = scales::alpha("black", 0.4))
image_info(faded_img)
  format width height colorspace matte filesize density
1   JPEG  1536   2048       sRGB  TRUE        0   72x72
image_append(
  image_resize(c(raw_img, faded_img), 350)
)

Now, let’s roll that into another function.

compare_img <- function(faded_img, img, px = 350){
  image_append(
    image_resize(c(img, faded_img), px)
  )
}

faded_compare <- compare_img(faded_img, raw_img)
faded_compare

We can also play around with other colors!

compare_img(create_overlay(raw_img, scales::alpha("red", 0.15)), raw_img)

compare_img(create_overlay(raw_img, scales::alpha("yellow", 0.15)), raw_img)

compare_img(create_overlay(raw_img, scales::alpha("blue", 0.15)), raw_img)

Looks great, but we should see how our text looks as well.

add_text  <- function(img, text = "Hello there!", font_size = 50, color = "white",
                      loc = c("+175+100", "+50+305")){
  img |> 
  image_annotate(text, size = font_size, color = color,
                 location = loc[1], gravity = "center") |> 
  image_annotate(text, size = font_size, color = color,
                 location = loc[2])
}

faded_compare |> 
  add_text()

In my opinion, it’s quite a bit easier to read the text with the faded overlay!

# save it out for use in another article
create_overlay(raw_img, scales::alpha("black", 0.4)) |> 
  image_resize(500) |> 
  image_annotate("Goodbye Howard!", "center", size = 60, color = "white", 
                 location = "+0+130")

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.4
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-08-01
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   1.0.37 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 magick      * 2.7.3   2021-08-18 [1] CRAN (R 4.2.0)
 scales      * 1.2.0   2022-04-13 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> magick https://themockup.blog/posts/2022-06-22-magick-overlay/index.html Wed, 22 Jun 2022 05:00:00 GMT Beautiful tables in R with gtExtras Thomas Mock https://themockup.blog/posts/2022-06-13-gtextras-cran/index.html I’m very excited to have the first release of gtExtras available on CRAN!

The goal of gtExtras is to provide opinionated helper functions to assist in creating beautiful and functional tables with gt.

The functions are generally wrappers around boilerplate table-making code or adding opinionated functions like data journalism inspired table themes and inline graphics. The gt package is amazing, make sure to go read the official documentation.

For installation:

install.packages("gtExtras")
# or if wanting the dev version
# if needed install.packages("remotes")
remotes::install_github("jthomasmock/gtExtras")

Using gtExtras

Overall, there are a lot of available functions in gtExtras:

length(ls.str('package:gtExtras', mode='function'))
[1] 65

You can read about each of the functions in the function reference.

Overall, there are four families of functions in gtExtras:

  • Themes: 7 themes that style almost every element of a gt table, built off of data journalism-styled tables
  • Utilities: Helper functions for aligning/padding numbers, adding fontawesome icons, images, highlighting, dividers, styling by group, creating two tables or two column layouts, extracting ordered data from a gt table internals, or generating a random dataset for reprex
  • Plotting: 12 plotting functions for inline sparklines, win-loss charts, distributions (density/histogram), percentiles, dot + bar, bar charts, confidence intervals, or summarizing an entire dataframe!
  • Colors: 3 functions, a palette for “Hulk” style scale (purple/green), coloring rows with good defaults from paletteer, or adding a “color box” along with the cell value

Also see the Plotting with gtExtras article for more examples of combining tables and graphics together.

A subset of functions are included below, or see the full function reference.

Importantly, gtExtras is not at all a replacement for gt, but rather is almost a “cookbook” where common or repeated function calls are grouped into their own respective functions. At a technical level, gtExtras is literally just gt functions under the hood and I’ll highlight a few examples of how to do the same thing in each package.

Load libraries

Themes

The package includes seven different themes, and 3 examples are the gt_theme_538() styled after FiveThirtyEight style tables, the gt_theme_espn() styled after ESPN style tables, and the gt_theme_nytimes() styled after The New York Times tables.

head(mtcars) %>%
  gt() %>% 
  gt_theme_538() %>% 
  tab_header(title = "Table styled like the FiveThirtyEight")
Table styled like the FiveThirtyEight
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
head(mtcars) %>%
  gt() %>% 
  gt_theme_guardian() %>% 
  tab_header(title = "Table styled like the Guardian")
Table styled like the Guardian
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
head(mtcars) %>% 
  gt() %>% 
  gt_theme_nytimes() %>% 
  tab_header(title = "Table styled like the NY Times")
Table styled like the NY Times
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

There are also themes that are bit more specific or somewhat “tongue in cheek”:

head(mtcars) %>% 
  gt() %>% 
  gt_theme_excel() %>% 
  tab_header(title = "Table styled like Excel")
Table styled like Excel
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
head(mtcars) %>% 
  gt() %>% 
  gt_theme_dot_matrix() %>% 
  tab_header(title = "Table styled like a dot matrix printer")
Table styled like a dot matrix printer
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

If you wanted to write your own gt_theme_YOURTHEME() function, you could do this with something like the below:

my_theme <- function(gt_object, ...){
  gt_object %>%
    tab_options(
      column_labels.background.color = "black",
      heading.align = "left",
      ...
    ) %>%
    tab_style(
      style = cell_text(color = "red", size = px(32)),
      locations = cells_title("title")
    )
}
head(mtcars) %>%
  gt() %>%
  my_theme() %>%
  tab_header("My own custom theme!")
My own custom theme!
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Hulk data_color

This is an opinionated diverging color palette. It diverges from low to high as purple to green. It is a good alternative to a red-green diverging palette as a color-blind friendly palette. The specific colors come from colorbrewer2.

Basic usage below, where a specific column is passed.

# basic use
head(mtcars) %>%
  gt::gt() %>%
  gt_hulk_col_numeric(mpg)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Trim provides a tighter range of purple/green so the colors are less pronounced.

head(mtcars) %>%
  gt::gt() %>%
  # trim gives smaller range of colors
  # so the green and purples are not as dark
  gt_hulk_col_numeric(mpg:disp, trim = TRUE)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Reverse makes higher values represented by purple and lower by green. The default is to have high = green, low = purple.

# option to reverse the color palette
# so that purple is higher
head(mtcars) %>%
  gt::gt() %>%
  # reverse = green for low, purple for high
  gt_hulk_col_numeric(mpg:disp, reverse = TRUE)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gt_color_rows()

The gt_color_rows() function is a more generic, thin boilerplate wrapper around gt::data_color(). A quick example of gt::data_color() is below.

Using named colors or hex colors is very simple!

head(mtcars) %>% 
  gt() %>% 
  gt::data_color(
    columns = mpg:disp, colors = c("white", "red")
  )
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Some complexity arises when wanting to use a color palette with tighter control. The code below is good but requires you to write out a lot of your own control.

color_fn <- scales::col_numeric(
    domain = NULL,
  palette = as.character(
    paletteer::paletteer_d(
      palette = "ggsci::red_material" ,
      type = "continuous"))
  )

head(mtcars) %>% 
  gt() %>% 
  gt::data_color(columns = mpg:disp, colors = color_fn)
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

gtExtras::gt_color_rows() simple to use but provides rich color choices thanks to the native inclusion of paletteer::paletteer_d(). This can provide 100s of discrete (ie categorical) or continuous color palettes.

Note that it is very close to the color_fn from above but throws a warning if domain is NULL since that will use range within EACH column rather than a shared range ACROSS columns.

# basic use
mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(mpg:disp)
Warning: Domain not specified, defaulting to observed range within each
specified column.
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

You can change the specific palette with palette = "package_name::palette_name"

# recognizes all of the dynamic palettes from paletteer
mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(mpg:disp, palette = "ggsci::blue_material")
Warning: Domain not specified, defaulting to observed range within each
specified column.
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

You can also use custom-defined palettes with named colors in R or hex color values however, this has minimal value over gt::data_color(). The main difference would be ability to specify a domain and throwing a warning without it.

mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(mpg:disp, palette = c("white", "green"))
Warning: Domain not specified, defaulting to observed range within each
specified column.
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1 
    # could also use palette = c("#ffffff", "##00FF00")

gt-native example gives you basically the same result.

mtcars %>%
  head() %>%
  gt() %>%
  gt::data_color(mpg:disp, colors = c("white", "green"))
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Lastly, you can also provide categorical or discrete data to be colored.

# provide type = "discrete"
mtcars %>%
  head() %>%
  gt() %>%
  gt_color_rows(
    cyl, 
    palette = "ggthemes::colorblind", 
    # note that you can manually define range like c(4, 6, 8)
    domain = range(mtcars$cyl),
    pal_type = "discrete"
   )
mpg cyl disp hp drat wt qsec vs am gear carb
21.0 6 160 110 3.90 2.620 16.46 0 1 4 4
21.0 6 160 110 3.90 2.875 17.02 0 1 4 4
22.8 4 108 93 3.85 2.320 18.61 1 1 4 1
21.4 6 258 110 3.08 3.215 19.44 1 0 3 1
18.7 8 360 175 3.15 3.440 17.02 0 0 3 2
18.1 6 225 105 2.76 3.460 20.22 1 0 3 1

Again, this function is an example of something that is easily possible with gt but would require a good chunk of repeated boilerplate code.

gt_highlight_rows()

This provides the ability to highlight and optionally bold entire rows within an existing gt table. Basic use defaults to a light-blue highlight which can be changed with the fill argument.

head_car <- head(mtcars[,1:5]) %>% 
  tibble::rownames_to_column("car")

gt(head_car) %>% 
  gt_highlight_rows(rows = 2, font_weight = "normal")
car mpg cyl disp hp drat
Mazda RX4 21.0 6 160 110 3.90
Mazda RX4 Wag 21.0 6 160 110 3.90
Datsun 710 22.8 4 108 93 3.85
Hornet 4 Drive 21.4 6 258 110 3.08
Hornet Sportabout 18.7 8 360 175 3.15
Valiant 18.1 6 225 105 2.76

You can optionally specify a target column with target_col that will be bold, while the rest of the row’s text will be default weight.

gt(head_car) %>% 
  gt_highlight_rows(
    rows = 5, 
    fill = "lightgrey",
    bold_target_only = TRUE,
    target_col = car
    )
car mpg cyl disp hp drat
Mazda RX4 21.0 6 160 110 3.90
Mazda RX4 Wag 21.0 6 160 110 3.90
Datsun 710 22.8 4 108 93 3.85
Hornet 4 Drive 21.4 6 258 110 3.08
Hornet Sportabout 18.7 8 360 175 3.15
Valiant 18.1 6 225 105 2.76

And because gtExtras is just using gt::tab_style() under the hood, it also accepts logical statements for specific rows.

gt(head_car) %>% 
  gt_highlight_rows(
    rows = drat == 3.08,# a logic statement
    fill = "lightgrey",
    bold_target_only = TRUE,
    target_col = car
    )
car mpg cyl disp hp drat
Mazda RX4 21.0 6 160 110 3.90
Mazda RX4 Wag 21.0 6 160 110 3.90
Datsun 710 22.8 4 108 93 3.85
Hornet 4 Drive 21.4 6 258 110 3.08
Hornet Sportabout 18.7 8 360 175 3.15
Valiant 18.1 6 225 105 2.76

The equivalent gt code - again, easy to figure out but some repeated calls.

gt(head_car) %>%
  tab_style(
    style = cell_fill(color = "lightgrey"), 
    locations = cells_body(everything(), rows = drat == 3.08)
    ) %>%
  tab_style(
    style = cell_text(weight = "bold"),
    locations = cells_body(car, rows = drat == 3.08)
  )
car mpg cyl disp hp drat
Mazda RX4 21.0 6 160 110 3.90
Mazda RX4 Wag 21.0 6 160 110 3.90
Datsun 710 22.8 4 108 93 3.85
Hornet 4 Drive 21.4 6 258 110 3.08
Hornet Sportabout 18.7 8 360 175 3.15
Valiant 18.1 6 225 105 2.76

Plotting in gt with gtExtras

As we get into plotting with gt the complexity really ramps up internally, as you’re wrapping gt + ggplot2 code internally.

Note that if you just want to create ggplot2 plots and embed them in gt, you can use gt::ggplot_image()! That gives you full and separate control of the two items, ie just use ggplot2 and use gt separately.

plot_object <-
  ggplot(
    data = gtcars,
    aes(x = hp, y = trq, size = msrp)
  ) +
  geom_point(color = "blue") +
  theme(legend.position = "none")

dplyr::tibble(
  text = "Here is a ggplot:",
  ggplot = NA
) %>%
  gt() %>%
  text_transform(
    locations = cells_body(columns = ggplot),
    fn = function(x) {
      plot_object %>%
        ggplot_image(height = px(200))
    }
  )
text ggplot
Here is a ggplot:

However, with the plotting functions in gtExtras, I’ve made some opinionated choices as to the output style/size/options - taking away some of your creativity for a simple to use user interface.

A side effect of these gtExtras functions is that almost exclusively they require you to pass datasets with list columns. These are easy enough to create!

mtcars %>%
   dplyr::group_by(cyl) %>%
   # must end up with list of data for each row in the input dataframe
   dplyr::summarize(mpg_data = list(mpg), .groups = "drop")
# A tibble: 3 × 2
    cyl mpg_data  
  <dbl> <list>    
1     4 <dbl [11]>
2     6 <dbl [7]> 
3     8 <dbl [14]>

gt_sparkline()

A typical sparkline for your table!

mtcars %>%
   dplyr::group_by(cyl) %>%
   # must end up with list of data for each row in the input dataframe
   dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
   gt() %>%
   gt_plt_sparkline(mpg_data)
cyl mpg_data
4 21.4
6 19.7
8 15.0

gt_plt_dist()

If you’d rather plot some distributions, you could use gt_plt_dist(). This functions defaults to an inline density plot, but accepts a type = "boxplot", "histogram", "rug_strip" or "density".

mtcars %>%
   dplyr::group_by(cyl) %>%
   # must end up with list of data for each row in the input dataframe
   dplyr::summarize(mpg_data = list(mpg), .groups = "drop") %>%
   gt() %>%
   gt_plt_dist(mpg_data)
cyl mpg_data
4
6
8

gt_bar_plot()

The gt_bar_plot function takes an existing gt_tbl object and adds horizontal barplots via native HTML. This is a wrapper around raw HTML strings, gt::text_transform() and gt::cols_align(). Note that values default to being normalized to the percent of the maximum observed value in the specified column. You can turn this off if the values already represent a percentage value representing 0-100.

mtcars %>%
  head() %>%
  dplyr::select(cyl, mpg) %>%
  dplyr::mutate(mpg_pct_max = round(mpg/max(mpg) * 100, digits = 2),
                mpg_scaled = mpg/max(mpg) * 100) %>%
  dplyr::mutate(mpg_unscaled = mpg) %>%
  gt() %>%
  gt_plt_bar_pct(column = mpg_scaled, scaled = TRUE) %>%
  gt_plt_bar_pct(column = mpg_unscaled, scaled = FALSE, fill = "blue", background = "lightblue") %>%
  cols_align("center", contains("scale")) %>%
  cols_width(4 ~ px(125),
             5 ~ px(125))
cyl mpg mpg_pct_max mpg_scaled mpg_unscaled
6 21.0 92.11
6 21.0 92.11
4 22.8 100.00
6 21.4 93.86
8 18.7 82.02
6 18.1 79.39

gt_merge_stack()

The gt_merge_stack() function takes an existing gt table and merges column 1 and column 2, stacking column 1’s text on top of column 2’s. Top text is in all caps with black bold text, while the lower text is smaller and dark grey.

Note that team_nick has the team nickname over the team’s division.

team_df <- readRDS(url("https://github.com/nflverse/nflfastR-data/raw/master/teams_colors_logos.rds"))

team_df %>%
  dplyr::select(team_nick, team_abbr, team_conf, team_division, team_wordmark) %>%
  head(8) %>%
  gt(groupname_col = "team_conf") %>%
  gt_merge_stack(col1 = team_nick, col2 = team_division) %>%
  gt_img_rows(team_wordmark)
team_nick team_abbr team_wordmark
NFC
Cardinals
NFC West
 ARI
Falcons
NFC South
 ATL
Panthers
AFC North
 CAR
Bears
AFC East
 CHI
AFC
Ravens
NFC South
 BAL
Bills
NFC North
 BUF
Bengals
AFC North
 CIN
Browns
AFC North
 CLE

gt_plt_winloss()

This function takes a list-column of win loss values (ie, 0=loss, 0.5 = tie, 1 = win) and ouputs an inline plot representing the win/loss squares with blue = win, red = loss, grey = tie. Points are also also redundantly coded with height, where wins are highest, ties are middle, and losses are at the bottom.

The example below generates an example dataset and then embeds a plot.

create_input_df <- function(repeats = 3){
  
  input_df <- dplyr::tibble(
    team = c("A1", "B2", "C3", "C4"),
    Wins = c(3, 2, 1, 1),
    Losses = c(2, 3, 2, 4),
    Ties = c(0, 0, 2, 0),
    outcomes = list(
      c(1, .5, 0) %>% rep(each = repeats),
      c(0, 1, 0.5) %>% rep(each = repeats),
      c(0, 0.5, 1) %>% rep(each = repeats),
      c(0.5, 1, 0) %>% rep(each = repeats)
    )
  )
  
  input_df
  
}

create_input_df(5) %>% 
  dplyr::glimpse()
Rows: 4
Columns: 5
$ team     <chr> "A1", "B2", "C3", "C4"
$ Wins     <dbl> 3, 2, 1, 1
$ Losses   <dbl> 2, 3, 2, 4
$ Ties     <dbl> 0, 0, 2, 0
$ outcomes <list> <1.0, 1.0, 1.0, 1.0, 1.0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.0, 0.0, …

Now that we have way to quickly generate example data, we can show the ability to incrementally add the win/losses.

Starting with 3 games. Please ignore the Wins/Loss/Ties columns, as they are simply placeholders. I am iterating the length of the outcomes list row.

create_input_df(1) %>% 
  gt() %>% 
  gt_plt_winloss(outcomes, max_wins = 15) %>% 
  tab_options(data_row.padding = px(2))
team Wins Losses Ties outcomes
A1 3 2 0
B2 2 3 0
C3 1 2 2
C4 1 4 0

And moving to 12 games, we can see that the scale is unchanged, and “empty” points are replaced with outcomes once the values are present in the data.

create_input_df(4) %>% 
  gt() %>% 
  gt_plt_winloss(outcomes, max_wins = 15) %>% 
  tab_options(data_row.padding = px(2))
team Wins Losses Ties outcomes
A1 3 2 0
B2 2 3 0
C3 1 2 2
C4 1 4 0

You can also switch over to ‘squares’ instead of ‘pills’ by changing the type argument.

create_input_df(4) %>% 
  gt() %>% 
  gt_plt_winloss(outcomes, max_wins = 15, type = "square") %>% 
  tab_options(data_row.padding = px(2))
team Wins Losses Ties outcomes
A1 3 2 0
B2 2 3 0
C3 1 2 2
C4 1 4 0

A more realistic use case is seen below with data from nflreadr:

Creating dataset 
library(dplyr)
library(tidyr)
library(nflreadr)

games_df <- nflreadr::load_schedules() %>% 
  filter(season == 2020, game_type == "REG") %>% 
  select(game_id, team_home = home_team, team_away = away_team, result, week) %>% 
  pivot_longer(contains('team'), names_to = 'home_away', values_to = 'team', names_prefix = 'team_') %>% 
  mutate(
    result = ifelse(home_away == 'home', result, -result),
    win = ifelse(result == 0 , 0.5, ifelse(result > 0, 1, 0))
  ) %>% 
  select(week, team, win) %>% 
  mutate(
    team = case_when(
      team == 'STL' ~ 'LA',
      team == 'OAK' ~ 'LV',
      team == 'SD' ~ 'LAC',
      T ~ team
    )
  )

team_df <- nflreadr::load_teams() %>% 
  select(team_wordmark, team_abbr, team_conf, team_division)

joined_df <- games_df %>% 
  group_by(team) %>% 
  summarise(
    Wins = length(win[win==1]),
    Losses = length(win[win==0]),
    outcomes = list(win), .groups = "drop") %>% 
  left_join(team_df, by = c("team" = "team_abbr")) %>% 
  select(team_wordmark, team_conf, team_division, Wins:outcomes)

final_df <- joined_df %>% 
  filter(team_conf == "AFC") %>% 
  group_by(team_division) %>% 
  arrange(desc(Wins)) %>% 
  ungroup() %>% 
  arrange(team_division)
final_df %>% 
  gt(groupname_col = "team_division") %>%
  gt_plt_winloss(outcomes, max_wins = 16) %>% 
  gt_img_rows(columns = team_wordmark) %>% 
  gt_theme_538() %>% 
  tab_header(title = "2020 Results by Division for the AFC")
2020 Results by Division for the AFC
team_wordmark team_conf Wins Losses outcomes
AFC East
AFC 13 3
AFC 10 6
AFC 7 9
AFC 2 14
AFC North
AFC 12 4
AFC 11 5
AFC 11 5
AFC 4 11
AFC South
AFC 11 5
AFC 11 5
AFC 4 12
AFC 1 15
AFC West
AFC 14 2
AFC 8 8
AFC 7 9
AFC 5 11

Closing

So that has been a brief overview of some of the possibilities of gtExtras - so go out, use gt, bring in gtExtras when you’d like to extend some of the work you’re doing and let me know if you enjoy the package!

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.577 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version  date (UTC) lib source
 dplyr       * 1.0.9    2022-04-28 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1    2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.6    2022-05-03 [1] CRAN (R 4.2.0)
 gt          * 0.6.0    2022-05-24 [1] CRAN (R 4.2.0)
 gtExtras    * 0.4.0    2022-06-09 [1] CRAN (R 4.2.0)
 nflreadr    * 1.2.0.12 2022-06-02 [1] Github (nflverse/nflreadr@94e3400)
 purrr       * 0.3.4    2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2    2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2    2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0    2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.7    2022-05-03 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0    2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1    2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> gt tables https://themockup.blog/posts/2022-06-13-gtextras-cran/index.html Mon, 13 Jun 2022 05:00:00 GMT Adding session info to blog posts Thomas Mock https://themockup.blog/posts/2022-04-18-session-info/index.html

Adding session info

Session info in R has lots of useful information on the state of your working environment at the moment you were coding. While tools such as renv or packrat can help you create project-specific libraries, sessionInfo() at least lets you capture the basic environment details. I’m not wanting to create project-specific libraries, but I’m rather wanting to share a nicely formatted output of my environment metadata.

Put another way, renv can be useful for someone (including yourself) to revert back to the specific package environment, whereas the session info simply returns the basic environment info. For a blogpost, I don’t imagine others trying to match to exact package environments, but rather confirm that their package environment is “similar enough”.

We can create and capture the session details like so:

base_sesh <- sessionInfo()

base_sesh
R version 4.2.0 (2022-04-22)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Monterey 12.2.1

Matrix products: default
BLAS:   /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
 [1] emo_0.0.0.9000    lubridate_1.8.0   here_1.0.1        digest_0.6.29    
 [5] crayon_1.5.1      rprojroot_2.0.3   assertthat_0.2.1  jsonlite_1.8.0   
 [9] magrittr_2.0.3    evaluate_0.15     rlang_1.0.2       stringi_1.7.6    
[13] cli_3.3.0         rstudioapi_0.13   generics_0.1.2    rmarkdown_2.14   
[17] rsthemes_0.3.1    tools_4.2.0       stringr_1.4.0     htmlwidgets_1.5.4
[21] glue_1.6.2        purrr_0.3.4       yaml_2.3.5        xfun_0.30        
[25] fastmap_1.1.0     compiler_4.2.0    htmltools_0.5.2   knitr_1.38.3

Since sessionInfo() generates a list, we can explore it like a list or even inject new objects into it.

base_sesh |> 
  str(max.level = 1)
List of 12
 $ R.version      :List of 14
 $ platform       : chr "aarch64-apple-darwin20 (64-bit)"
 $ locale         : chr "en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8"
 $ running        : chr "macOS Monterey 12.2.1"
 $ RNGkind        : chr [1:3] "Mersenne-Twister" "Inversion" "Rejection"
 $ basePkgs       : chr [1:7] "stats" "graphics" "grDevices" "utils" ...
 $ loadedOnly     :List of 28
 $ matprod        : chr "default"
 $ BLAS           : chr "/Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib"
 $ LAPACK         : chr "/Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib"
 $ system.codepage: chr "NULL"
 $ codepage       : chr "NULL"
 - attr(*, "class")= chr "sessionInfo"

For example, I can inject my current version of the quarto CLI into the session info.

base_sesh$quarto <- system("quarto -V", intern = TRUE)

base_sesh |>
  str(max.level = 1)
List of 13
 $ R.version      :List of 14
 $ platform       : chr "aarch64-apple-darwin20 (64-bit)"
 $ locale         : chr "en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8"
 $ running        : chr "macOS Monterey 12.2.1"
 $ RNGkind        : chr [1:3] "Mersenne-Twister" "Inversion" "Rejection"
 $ basePkgs       : chr [1:7] "stats" "graphics" "grDevices" "utils" ...
 $ loadedOnly     :List of 28
 $ matprod        : chr "default"
 $ BLAS           : chr "/Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRblas.0.dylib"
 $ LAPACK         : chr "/Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/lib/libRlapack.dylib"
 $ system.codepage: chr "NULL"
 $ codepage       : chr "NULL"
 $ quarto         : chr [1:2] "0.9.577" ""
 - attr(*, "class")= chr "sessionInfo"

We’ve now captured a lot of useful session info and even injected a new item, so that we can remember what version of the Quarto CLI I was using.

sessioninfo package

An alternative to using utils::sessionInfo() would be to use the sessioninfo package. Per the package docs:

Query and print information about the current R session. It is similar to utils::sessionInfo(), but includes more information about packages, and where they were installed from.

Differences from utils::sessionInfo()

  • Additional platform details: time zone, pandoc version, RStudio version, etc.
  • Information about package sources, e.g. GitHub repo and hash for packages installed from GitHub.
  • Highlight package installation problems, e.g. if the loaded and on-disk versions are different, if the MD5 checksum of the package DLL is wrong, etc.
  • Highlight packages from unusual sources.
  • Information about external software via external_info().
  • Information about the Python configuration is the reticulate package is loaded and configured.
  • Information about package libraries.
  • Compare two session info outputs with the session_diff() function.
  • Option to show loaded (default), attached or installed packages, or the recursive dependencies of the specified packages.
Note

Note that I’m really only interested in the session info and which packages were attached (ie via library(pkgname)), so I’ll use the pkgs = "attached" argument. This flexibility is nice!

library(sessioninfo)
session_info(pkgs = "attached")
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────

Now while information such as this is very useful for attaching to things like a reprex, it can also be useful to include for testing purposes or for “posterity” when rendering a document or writing a blogpost.

Adding to sessioninfo

Let’s also note one more thing - again I’d like to record the Quarto version, since I’m relying on quarto for rendering my blog. We can “inject” the quarto version and path to the sessioninfo list object.

I did go ahead and submit a feature request on the sessioninfo repo - maybe quarto info will be incorporated into sessioninfo in the near future!
# save the session info as an object
pkg_sesh <- session_info(pkgs = "attached")

# get the quarto version
quarto_version <- system("quarto --version", intern = TRUE)

# inject the quarto info
pkg_sesh$platform$quarto <- paste(
  system("quarto --version", intern = TRUE), 
  "@", 
  quarto::quarto_path()
  )

# print it out
pkg_sesh
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.577 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────

That’s looking good!

Include in docs

Now to add it to the end of our document, we can use a quick HTML <details> tag. This creates a small expandable section. We can also change the title of with the use of a <summary> tag. We can add this to all of our documents/blogposts and capture

<details><summary>Session Info</summary>

```{r, echo = FALSE}
library(sessioninfo)
# save the session info as an object
pkg_sesh <- session_info(pkgs = "attached")

# get the quarto version
quarto_version <- system("quarto --version", intern = TRUE)

# inject the quarto info
pkg_sesh$platform$quarto <- paste(
  system("quarto --version", intern = TRUE), 
  "@", 
  quarto::quarto_path()
  )

# print it out
pkg_sesh
```

</details>

Which generates something like the below (again note that you need to expand this <details> tag by clicking on it):

Session Info 
─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.577 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────

Quarto-native callouts

Quarto itself adds the ability to create boostrap-style callouts and collapsible callouts, so we can simplify our code a bit:

:::{.callout-tip collapse="true"}
## Expand for Session Info
```{r, echo = FALSE}
library(sessioninfo)
# save the session info as an object
pkg_sesh <- session_info(pkgs = "attached")

# get the quarto version
quarto_version <- system("quarto --version", intern = TRUE)

# inject the quarto info
pkg_sesh$platform$quarto <- paste(
  system("quarto --version", intern = TRUE), 
  "@", 
  quarto::quarto_path()
  )

# print it out
pkg_sesh
```

:::

Which will return a colored callout like below:

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.577 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────

Closing Notes

If you want to see some examples of similar concepts in action on other blogs, check out:

TJ also uses sessioninfo::session_info() while Danielle takes it a step further and generates a full renv lockfile.

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-06-13
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.577 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> meta quarto https://themockup.blog/posts/2022-04-18-session-info/index.html Mon, 18 Apr 2022 05:00:00 GMT Displaying verbatim code chunks in RMarkdown and Xaringan presentations Thomas Mock https://themockup.blog/posts/2021-08-27-displaying-verbatim-code-chunks-in-xaringan-presentations/index.html This will be a short article, but I wanted to note it for my own future use and hopefully a discoverable resource if folks get stuck trying to do the same thing!

New knitr verbatim options

Also note that since I originally published this article in 2021-08-27, {knitr} v1.37 introduced new options for verbatim, comment and asis chunks. See the full examples in the knitr News. They may make this article obsolete!

The last option that knitr recently introduced was the concept of curly-curly (ie {{r}}) verbatim code. This is by far one one of my favorite options! See it expanded upon in this knitr Issue.

Back to the original blogpost!

I recently gave a presentation on Advanced RMarkdown use, and part of what I was displaying in my RMarkdown generated xaringan slides was literal RMarkdown code chunks. These verbatim code chunks are very useful and in some cases necessary to accurately convey a teaching example.

Notably, while these verbatim code chunks are extremely useful some difficulty can arise as you’re essentially nesting R and RMarkdown code/logic inside a RMarkdown document. In order to “tell” RMarkdown to ignore the code and simply print it out verbatim you need to use a few different techniques.

More details can be found in the RMarkdown Cookbook.

Verbatim Code Chunks

The primary problem here is we need to “tell” RMarkdown not to parse the RMarkdown code chunk as real code. So we need to account for the 3x backticks that make up an R code chunk as seen below.

```{r, echo = TRUE}
...code_goes_here...
```

cat() to the rescue

You can use cat() to output specific code chunks verbatim as raw text. This can be very fast, but requires you to write code by hand in text.

output_code <-
"````
```{r, eval=TRUE}`r ''`
library(dplyr)
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg))
```\n````"

cat(output_code)
````
```{r, eval=TRUE}`r ''`
library(dplyr)
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg))
```
````

We need more backticks captain!

To return unevaluated verbatim code chunks code you need N + 1 of the max backticks, so for RMarkdown chunks that have 3x backticks, you need to wrap it in 4x backticks on either side of the code.

You also need to invalidate the code chunk by adding a blank r '' to the end of the existing code chunk (ie immediately after the {r} like so:

```{r}`r''`
...code_goes_here...
```

As a code example I can wrap my code in 4x backticks around the 3x backticks, also note the invalidated r expression after the {r}.

````
```{r}`r ''`
library(dplyr)
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg))
```
````

That rendered inside RMarkdown outputs:

```{r}
library(dplyr)
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg))
```

However you may notice that there’s no grey code background for the code chunk. To format it, we can also add the code type to the end of the 4x backticks for formatting purposes. I have a panelset of some of the various code types appended to the 4x backticks below. This affects some highlighting of specific functions/strings/etc in the code as well.

A note here is that my blog is written in distill, so what you see here is not identical to xaringan which is built on remark.js. As such, I’ve included the distill output below, and after that another embedded version of a minimal xaringan presentation. In xaringan there is also the highlightStyle argument in the YAML which allows for a lot of customization of the code chunk/code/comments colors. The various options for this argument are at the bottom of the remark.js wiki.

{distill} output

Add nothing to end of 4x backticks


````
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add the letter r to end of 4x backticks


````r
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add fortran to the end of the 4x backticks


````fortran
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add markdown or md to the end of the 4x backticks


````markdown
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add the letter c to the end of the 4x backticks


````c
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add haskell to the end of the 4x backticks


````haskell
````

Which returns code formatted like the below:

```{r}
# load library
library(dplyr)

# Execute code
mtcars %>% 
  group_by(cyl) %>% 
  summarize(n = n(), mean = mean(mpg)) %>% 
  mutate(cyl_name = paste(cyl, "Cylinders"))
```

Add python to the end of the 4x backticks


````python
````

Which returns code formatted like the below:

```{python}
# load library and data
import pandas as pd
import statsmodels.api as sm

mtcars = sm.datasets.get_rdataset("mtcars", "datasets", cache=True).data

# Execute code
(mtcars
  .groupby(['cyl'])
  .agg(['count', 'mean']))
```

Xaringan output

Add more complexity

Now you can also embed essentially entire RMarkdown documents, including inline code. For inline code such as 'r 1 + 1', you’ll need to use one more technique - also outlined in the RMarkdown Cookbook.

To display inline code like r 1+1 you’ll need to use knitr::inline_expr('1+1') which will convert the raw expression to the expected inline output of r 1+1 before it’s evaluated by RMarkdown.

A meta example from the RMarkdown Cookbook:

code = 'This will show a verbatim inline R expression `r knitr::inline_expr(\'knitr::inline_expr("1+1")\')` in the output.'

cat(code)
This will show a verbatim inline R expression `r knitr::inline_expr('knitr::inline_expr("1+1")')` in the output.

Which if used as code outputs:

This will show a verbatim inline R expression
`r knitr::inline_expr("1+1")` in the output.

We can use a full example below.

Generate inline code

To generate the verbatim inline code we actually used:

We have data about `r knitr::inline_expr("nrow(penguins)")` penguins.  Only 
`r knitr::inline_expr("nrow(penguins) - nrow(smaller)")` are classified as
`r knitr::inline_expr("params$species")`. The distribution of the 
`r knitr::inline_expr("params$species")` penguins are shown below:

Which generated the code below:


We have data about `r nrow(penguins)`  penguins.  Only 
`r nrow(penguins) - nrow(smaller)` are classified as
`r params$species`. The distribution of the 
`r params$species` penguins are shown below:

All together now

Here’s YAML + code chunks + inline R expression, all in one code block!

---
title: "Penguins"
date: 2020-08-11
output: html_document
params:
  species: Adelie
---
```{r setup, include = FALSE}
library(tidyverse)
library(palmerpenguins)
smaller <- penguins %>% 
  filter(species == params$species, 
         !is.na(body_mass_g))
```
We have data about `r nrow(penguins)` penguins.  Only 
`r nrow(penguins) - nrow(smaller)` are classified as
`r params$species`. The distribution of the 
`r params$species` penguins are shown below:

```{r, echo = FALSE}
smaller %>% 
  ggplot(aes(body_mass_g)) + 
  geom_histogram(binwidth = 100)
```

Make sure to keep track of your back ticks as the code can stop looking like “real” code after staring at for a while. I highly recommend checking yourself as you go, because if you miss a backtick it can be quite tricky to “find the needle in the haystack”…

Just for fun, I’ve included a link to the source code for the above embedded RMarkdown so you can explore it.

I also highly recommend exploring the source code of the RMarkdown Cookbook to figure out how they did all of their inline embedding.

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-05-11
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.387 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 quarto      * 1.1.0.9000 2022-04-26 [1] Github (quarto-dev/quarto-r@e06d096)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> meta xaringan rmarkdown https://themockup.blog/posts/2021-08-27-displaying-verbatim-code-chunks-in-xaringan-presentations/index.html Fri, 27 Aug 2021 05:00:00 GMT Reminder to test with a reprex Thomas Mock https://themockup.blog/posts/2021-07-28-reminder-to-test-with-a-reprex/index.html It’s been a while since my last post, so I wanted to get back into the swing of things with a shorter article. My goal was to get a new one up on the blog before August 1st.

As such, I was working late on a much longer form article and as part of this I wanted to display some smoothed lines for several players on one plot. A sneak peek of some of this below:

A 3x3 grid facetted by quarter of the observation number on the X axis and the rolling max, min, and average on the Y-axis. Now, I’ve been programming in R for quite some time, but for the life of me I couldn’t get my facets to align properly. This led to a bit of frustration as I “knew” what I was doing should be right but wasn’t returning the expected “correct” output.

This article walks through why I believe {reprex} driven testing is so useful for compartmentalizing a problem and getting at the specifics of why our expectation sometimes don’t match the output.

Like most useful ideas, I’m far from the first person to think of it!

That’s a few folks who I have a great deal of respect for, and as usual they have great advice for us! (Write a reprex and you’ll likely solve the problem as you go)

Who’s problem is this?

Now whenever I run into errors, mistakes, or unexpected outputs I ask myself:

Is this a “Tom” problem? Or is this R’s fault?

Principle skinner out of touch meme, with the text “Is it my code that is wrong?” and “No it must be an error with the forcats package” overlaid.

The short answer is that it’s almost always a “me” problem, as R is just diligently following the commands I gave to it. However, in some rare cases I do find a bug and can use the reprex testing I’ve done to quickly log a useful a bug report for the package developers.

If you haven’t run into the term “reprex” before, it is a:

“minimal reproducible example”

You can read more about the {reprex} package on the package documentation site.

If you’re asking for R help, reporting a bug, or requesting a new feature, you’re more likely to succeed if you include a good reprex.

That quote is from the reprex docs, and I’ll add to it that a reprex can help with you solving your own problems BEFORE even submitting the bug request!

The Goal

While writing the article, I wanted to create a scatter plot, and facet the players by their respective QBR (Quarterback ratings) average scores. However, I kept getting the players to facet_wrap() by somewhat of an alphabetical order instead of in descending ranked order. This was a hint that my factor ordering via forcats was not being respected. I have included the “wrong” plot below.

A 3x3 grid facetted by quarterback of the observation number on the X axis and the rolling max, min, and average on the Y-axis. The quarterbacks are facetted according to their alphabetical names.

This was of course frustrating, so I started doing some testing/troubleshooting of the complex plot as it was.

Initiate testing

Let’s reproduce the initial problem. We’ll load the necessary packages, bring in the data, and generate the respective dataframes/plots as well. I’m intentionally leaving the code without comments and as a single code chunk as this is supposed to be a bit like a random code review. In retrospect the error is quite clear to me, but I was honestly stumped for a good chunk of time.

library(slider)
library(tidyverse)
library(espnscrapeR)

all_qbr <- crossing(season = 2018:2020, week = 1:17) %>% 
  pmap_dfr(get_nfl_qbr)

all_college_qbr <- 2018:2020 %>% 
  map_dfr(~get_college_qbr(.x, type = "weekly"))

test_data <- all_qbr %>%
  select(player_id, qbr = qbr_total, team_abb, short_name) %>%
  mutate(pure_avg = mean(qbr)) %>%
  group_by(player_id) %>%
  filter(n() >= 30) %>% 
  mutate(
    short_name = fct_reorder(short_name, qbr, .fun= mean, .desc = TRUE),
    grp_avg = mean(qbr, na.rm = TRUE),
    diff_avg = qbr - pure_avg,
    roll_mean = slide_dbl(qbr, mean, .before = 8L),
    roll_max = slide_dbl(roll_mean, max, .before = Inf),
    roll_min = slide_dbl(roll_mean, min, .before = Inf),
    row = row_number()
  ) %>% 
  ungroup()

test_plot <- test_data %>% 
  filter(grp_avg >= 62) %>% 
  ggplot(aes(x = row, y = roll_max)) +
  geom_point(aes(y = qbr), alpha = 0.2) +
  geom_step() +
  geom_step(aes(y = roll_min), color = "red") +
  geom_line(aes(y = roll_mean), color = "blue") +
  geom_smooth(aes(y = qbr),method = "loess", size = 0.5, span = 0.35) +
  facet_wrap(~factor(short_name)) +
  coord_cartesian(ylim = c(0, 105), xlim = c(0, 50), expand = FALSE)

test_plot

A 3x3 grid facetted by quarterback of the observation number on the X axis and the rolling max, min, and average on the Y-axis. The quarterbacks are facetted according to their alphabetical names.

Maybe it’s a factor thing?

My initial thought is “it seems the factors are not being represented correctly”. Since I’m using forcats::fct_reorder(.f = short_name, .x = qbr, .fun = mean, .desc = TRUE) the Quarterback names should respect the “ranking” by their respective descending average QBR.

However, what I was getting out in ggplot2 is ordered as below. It’s not in any real order!

test_data %>% 
  filter(grp_avg >= 62) %>% 
  distinct(short_name, grp_avg) %>% 
  arrange(short_name)
# A tibble: 9 × 2
  short_name        grp_avg
  <fct>               <dbl>
1 R. Wilson            66.4
2 T. Brady             63.0
3 D. Prescott          62.9
4 D. Brees             71.4
5 D. Watson            63.4
6 P. Mahomes           77.2
7 L. Jackson           68.4
8 B. Roethlisberger    62.6
9 A. Rodgers           62.1

What I wanted, and how it “should” arrange like below:

test_data %>% 
  filter(grp_avg >= 62) %>% 
  mutate(short_name = fct_reorder(short_name, qbr, .fun = mean, .desc = TRUE)) %>% 
  distinct(short_name, grp_avg) %>% 
  arrange(short_name)
# A tibble: 9 × 2
  short_name        grp_avg
  <fct>               <dbl>
1 P. Mahomes           77.2
2 D. Brees             71.4
3 L. Jackson           68.4
4 R. Wilson            66.4
5 D. Watson            63.4
6 T. Brady             63.0
7 D. Prescott          62.9
8 B. Roethlisberger    62.6
9 A. Rodgers           62.1

So let’s take a look at the test_data object. The factors are simply “wrong”! We know we’re looking for “P. Mahomes” to always lead our rankings in this dataset. The results below are not in any “real” order!

test_data %>% 
  filter(grp_avg >= 62) %>% 
  distinct(short_name) %>% 
  arrange(short_name) %>% 
  pull() %>% 
  levels()
 [1] "M. Ryan"           "M. Stafford"       "C. Newton"        
 [4] "A. Dalton"         "R. Tannehill"      "K. Cousins"       
 [7] "R. Wilson"         "D. Carr"           "T. Brady"         
[10] "C. Wentz"          "D. Prescott"       "D. Brees"         
[13] "M. Trubisky"       "J. Goff"           "B. Mayfield"      
[16] "D. Watson"         "P. Mahomes"        "S. Darnold"       
[19] "L. Jackson"        "K. Murray"         "J. Allen"         
[22] "P. Rivers"         "B. Roethlisberger" "A. Rodgers"

I thought to try to correct it manually. I could just get a vector of the quarterbacks according to the ranking and then apply it with factor(short_names, levels = qb_lvls). This gets us the “right” order of the names BUT it doesn’t really solve our underlying problem or tell us why it’s not working out as expected. This is a “bandaid” instead of a “cure” to my problem! If I did that I would never know if I had a wrong mental model, if there was an actual bug in ggplot2 or forcats (unlikely), or if I was simply coding it all wrong.

qb_lvls <- test_data %>% 
  group_by(short_name) %>% 
  distinct(grp_avg) %>%
  arrange(desc(grp_avg)) %>% 
  pull(short_name) %>% 
  as.character()

qb_lvls
 [1] "P. Mahomes"        "D. Brees"          "L. Jackson"       
 [4] "R. Wilson"         "D. Watson"         "T. Brady"         
 [7] "D. Prescott"       "B. Roethlisberger" "A. Rodgers"       
[10] "M. Ryan"           "M. Stafford"       "J. Allen"         
[13] "P. Rivers"         "K. Murray"         "R. Tannehill"     
[16] "K. Cousins"        "B. Mayfield"       "D. Carr"          
[19] "J. Goff"           "C. Wentz"          "M. Trubisky"      
[22] "A. Dalton"         "C. Newton"         "S. Darnold"

Make a reprex

So far, I dove into a few troubleshooting steps but it didn’t clarify what my underlying problem was. What I should have done was create a reprex or break the problem down into smaller pieces! I was about to ask for some help, so I wanted to generate a reprex to use as the “ask”.

Now for the reprex, I don’t want to include data scraped from the internet as the data doesn’t really matter (and it requires a separate package - espnscrapeR). So let’s simulate data!

library(tidyverse)

set.seed(20210728)

sim_data <- crossing(
  grp = letters[1:4],
  series = 1:10
) %>% 
  mutate(
    val = rnorm(n = nrow(cur_data()), mean = 70, sd = 8)
  )

sim_data
# A tibble: 40 × 3
   grp   series   val
   <chr>  <int> <dbl>
 1 a          1  63.5
 2 a          2  82.0
 3 a          3  75.6
 4 a          4  64.8
 5 a          5  72.7
 6 a          6  74.2
 7 a          7  75.0
 8 a          8  70.3
 9 a          9  69.2
10 a         10  69.7
# … with 30 more rows

We also don’t need ALL the calculations we are doing, so let’s simplify it to just the minimal calculation:
- a grouped average
- an ordered factor according to that grouped average

sim_plot_df <- sim_data %>% 
  group_by(grp) %>% 
  mutate(
    grp_avg = mean(val, na.rm = TRUE),
    grp_fct = fct_reorder(grp, val, .fun = mean, .desc = TRUE)
  ) %>% 
  ungroup()

sim_plot_df
# A tibble: 40 × 5
   grp   series   val grp_avg grp_fct
   <chr>  <int> <dbl>   <dbl> <fct>  
 1 a          1  63.5    71.7 a      
 2 a          2  82.0    71.7 a      
 3 a          3  75.6    71.7 a      
 4 a          4  64.8    71.7 a      
 5 a          5  72.7    71.7 a      
 6 a          6  74.2    71.7 a      
 7 a          7  75.0    71.7 a      
 8 a          8  70.3    71.7 a      
 9 a          9  69.2    71.7 a      
10 a         10  69.7    71.7 a      
# … with 30 more rows

Let’s check what the order should be - looks like c > a > d > b

sim_plot_df %>% 
  distinct(grp, grp_avg) %>% 
  arrange(desc(grp_avg))
# A tibble: 4 × 2
  grp   grp_avg
  <chr>   <dbl>
1 c        72.7
2 a        71.7
3 d        71.0
4 b        67.4

Now, let’s confirm what are the returned levels?

sim_plot_df %>% 
  pull(grp_fct) %>% 
  levels()
[1] "a" "b" "c" "d"

Our reprex returned the “wrong” values! At this point, I thought I had legitimately found a bug…but I wanted to go one step further and check the plotting. I went ahead and added back in some complexity to check myself - specifically adding a horizontal line to indicate the group average and a label of the actual numeric group average on each facet.

STILL WRONG!

sim_plot_df %>% 
  ggplot(aes(x = series, y = val)) +
  geom_point() +
  geom_hline(aes(yintercept = grp_avg), color = "red") +
  geom_text(aes(x = 2.5, y = 100, label = round(grp_avg, digits = 1))) +
  facet_wrap(~grp_fct, ncol = 4)

Last step was to confirm I could get ggplot2 to return the expected behavior of c > a > d > b. I could get the “right” behavior by adding in the fct_reorder() across the overall data inside facet_wrap().

sim_plot_df %>% 
  ggplot(aes(x = series, y = val)) +
  geom_point() +
  geom_smooth() +
  geom_hline(aes(yintercept = grp_avg), color = "red") +
  geom_text(aes(x = 2.5, y = 100, label = round(grp_avg, digits = 1))) +
  facet_wrap(~fct_reorder(grp_fct, val, .fun = mean, .desc = TRUE), ncol = 4) 
`geom_smooth()` using method = 'loess' and formula 'y ~ x'

At this point the answer stared me right in the face!

I could get the “right” behavior by adding in the fct_reorder() across the overall data inside facet_wrap().

Emphasis there added on “overall data”. In my group_by + mutate I was applying a factor transformation WITHIN each group so each factor was basically a factor with only 1 level (the specific group), and when combined back into the dataframe it returned an overall factor with levels simply according to the order of the rows in the data.

Here’s a peek at the initial reprex.

sim_plot_df <- sim_data %>% 
  group_by(grp) %>% 
  mutate(
    grp_avg = mean(val, na.rm = TRUE),
    # this should be done BEFORE grouping
    grp_fct = fct_reorder(grp, val, .fun = mean, .desc = TRUE)
  ) %>% 
  ungroup()

and now after I’ve moved the fct_reorder() ahead of the group_by().

sim_plot_df_fixed <- sim_data %>% 
  # fct_reorder done BEFORE grouping
  mutate(grp_fct = fct_reorder(grp, val, .fun = mean, .desc = TRUE)) %>% 
  group_by(grp) %>% 
  mutate(
    grp_avg = mean(val, na.rm = TRUE)
  ) %>% 
  ungroup()

sim_plot_df_fixed %>% 
  ggplot(aes(x = series, y = val)) +
  geom_point() +
  geom_hline(aes(yintercept = grp_avg), color = "red") +
  geom_text(aes(x = 2.5, y = 100, label = round(grp_avg, digits = 1))) +
  facet_wrap(~fct_reorder(grp_fct, val, .fun = mean, .desc = TRUE), ncol = 4)

By breaking the problem down into the simplest version of itself, and carefully checking my assumptions as I went, I was able to get at the root of the problem.

In essence by preparing the reprex in preparation of asking for help, I was able to solve the problem.

In the words of Jenny Bryan:

it’s basically the rubber duck in disguise

A Giant floating yellow rubber duck in the ocean outside Hong Kong

Rubber duck debugging according to Wikipedia

In software engineering, rubber duck debugging is a method of debugging code. The name is a reference to a story in the book The Pragmatic Programmer in which a programmer would carry around a rubber duck and debug their code by forcing themselves to explain it, line-by-line, to the duck.

So go out, create your reprex, solve some of your own problems, and submit even better bug reports!

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 dplyr       * 1.0.8   2022-02-08 [1] CRAN (R 4.2.0)
 espnscrapeR * 0.6.5   2022-04-26 [1] Github (jthomasmock/espnscrapeR@084ce80)
 forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2   2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 slider      * 0.2.2   2021-07-01 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0   2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> meta reprex tidyverse https://themockup.blog/posts/2021-07-28-reminder-to-test-with-a-reprex/index.html Wed, 28 Jul 2021 05:00:00 GMT Three years of TidyTuesday Thomas Mock https://themockup.blog/posts/2021-04-01-three-years-of-tidytuesday/index.html The #TidyTuesday project has been active since April 1st of 2018, so today is the 3 year anniversary!

As this project was borne out of the R4DS Online Learning Community and the R for Data Science textbook, an emphasis was placed on understanding how to summarize and arrange data to make meaningful charts with ggplot2, tidyr, dplyr, and other tools in the tidyverse ecosystem. However, any code-based methodology is welcome - just please remember to share the code used to generate the results.

There was even a paper published on TidyTuesday!

Over the past 3 years, 1000s of people have contributed their submissions and “shown their work” with open source R code! Since the primary way people engage with TidyTuesday is via Twitter submissions, I have a weekly tweet collector that stores and uploads the Tweets to the TidyTuesday GitHub.

This allows us to do some basic counting of a few different parameters over time. However, before we get to the details I also want to get into a mistake we’ve made and have partially rectified. Thanks to efforts by Dr. Liz Hare and Dr. Silvia Canelon, I was made aware that less than 3% of submissions include alternative text (alt text) describing the graphic. This includes basically ALL of my own tweets.

I recommend listening to their talk at CSV conf 2021 on May 5th at 10:20am EST for the full details, and some advice on how to improve our accessibility.

If you’re not aware, alt text is the primary way that screen reader software used by low vision or blind users interact with many web pages or other software. Per the American Foundation for the Blind:

Screen readers are software programs that allow blind or visually impaired users to read the text that is displayed on the computer screen with a speech synthesizer or braille display.

Per the National Federation of the Blind, there were ~ 8 million US-based individuals with visual disability as of 2016. While this is less prevalent than color blindness, it doesn’t capture the whole story. Low vision, altered vision, or motor impairment as opposed to clinically-defined blindness is even more prevalent. I think that the thread by Frank Elavsky covers more details that are worth reading, and emphasizing that inclusivity doesn’t stop at color blind safe palettes.

Ultimately, there is a need to move beyond simply thinking about color-blindness, and making sure to include things like alt text, emphasizing contrast, and generally make our data visualization more engaging for all the potential consumers. I’ve not done a great job of this in the past, but am on a journey to “do better”.

Alt text for graphs

The Data Visualization Society has a great article by Amy Cesal on Writing Alt Text for Data Visualization.

You probably can’t write text that conveys the entire meaning of a chart. But, that doesn’t mean that you shouldn’t try.

Ultimately, this is a hard problem, but just as Amy says - that doesn’t mean we can’t or shouldn’t try to do our best to describe our graphs for folks who aren’t able to see all the details.

She recommends alt text that includes:

  • Chart type
  • The type of data
  • Reason for including the chart
  • Link to the data source

The goal here is to add a rich description of the PURPOSE of the graph, which is ultimately the goal of data visualization - telling a story with data.

I have a brief script using glue that allows you to write this style of alt text.

write_alt_text <- function(
  chart_type, 
  type_of_data, 
  reason, 
  source
  ){
  glue::glue(
    "{chart_type} of {type_of_data} where {reason}. \n\nData source from {source}"
    )
}
write_alt_text(
  "Bar Chart", 
  "tweets from the past week tagged with the TidyTuesday hashtag", 
  "Tuesday is the most popular day to post tweets, although about 20-30 tweets are posted every day", 
  "the {rtweet} package."
  )
Bar Chart of tweets from the past week tagged with the TidyTuesday hashtag where Tuesday is the most popular day to post tweets, although about 20-30 tweets are posted every day. 

Data source from the {rtweet} package.

This can be easily added to Twitter-based images via the various clients, and will also be able to be uploaded via rtweet in the future. Twitter has a full guide on how to add image alt text.

When you Tweet photos using the Twitter app for iOS or Android, or on twitter.com, you have the option to compose a description of the images so the content is accessible to more people, including those who are blind or low-vision.

Good image descriptions are concise and descriptive, helping people understand what’s happening in an image.

Without alt text, most images on Twitter will just default to reporting “Image” as the alt text for any images you display. You could imagine that while a picture is worth a 1000 words, that the word “image” is far from helpful in describing said image.

Furthermore, Penn State has a chart description guide that covers charts and accessibility.

Generally speaking an ALT tag cannot do justice to a complex chart. One way to describe a chart is to provide both a text summary and a properly coded data table near the chart.

This serves multiple audiences because a chart can show trends, but a table can provide exact data for those who are interested.

I love this idea of providing the raw data in a table or a source in addition to the image itself. However, I think that also making sure to write a good text description is better than just sharing the data or table alone.

Lastly, to help you remember to always include alt text for images and gifs on Twitter, you can add extensions like Chrome’s Twitter Required Alt Text. This actually prevents you from uploading images WITHOUT alt text.

Future effort

While I’ve made some changes to my personal workflow and including alt text in my “automated” tweets around #TidyTuesday, I hope that we as the R community and more specifically the #TidyTuesday community can make it a priority to add more alt text to our graphs and be more inclusive of the wider community.

While I am excited about the work we have done in the past, we obviously have a lot to do in the future to make this a reality. As part of this, I’m going to be walking through some of the past submission data and writing out example alt text, as well as including tables.

For RMarkdown docs/blogs, you can add alt text very easily!

First off, the basic syntax provides an area for alt text, detailed in the RMarkdown Cookbook.

![an informative text](path/to/image.png)

OR with knitr::include_graphics(), which is what I’ve done for the images below.

{r, fig.cap="alt text"}
knitr::include_graphics('figures/my_image.png')

#TidyTuesday data

With this in mind, we can walk through the past TidyTuesday posts, create some graphics that show the changes, write some alt text that describes said graphs, and include tables to further “tell our story”. All of the historical data/tweets are collected in the TidyTuesday repo.

library(tidyverse)
library(lubridate)

raw_url <- "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/tidytuesday_tweets/data.csv"

raw_df <- read_csv(raw_url)

There are MANY tweets!

raw_df %>% 
  distinct(status_id) %>% 
  count()
# A tibble: 1 × 1
      n
  <int>
1 17284

And there are still many tweets if we filter to only include Tweets with a few key words of interest to R/Data visualization.

raw_df %>% 
  filter(str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")) %>%
  distinct(status_id) %>% 
  count()
# A tibble: 1 × 1
      n
  <int>
1 13076

Lastly, there are thousands of unique contributors over the past 3 years.

raw_df %>%
  filter(str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")) %>%
  distinct(screen_name) %>%
  count()
# A tibble: 1 × 1
      n
  <int>
1  2667

Data visualizations

We can create some graphics based on this data. I’m going to create some summary datasets, and then get the top weeks for labeling.

sum_df <- raw_df %>%
  filter(str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")) %>%
  mutate(
    created_date = lubridate::as_date(created_at),
    year = year(created_date),
    week = week(created_date)
  ) %>%
  filter(year %in% 2018:2021) %>% 
  count(year, week) %>%
  group_by(year) %>%
  mutate(
    roll_n = cumsum(n),
    week = if_else(year > 2018, week - 1, week - 14),
    year = factor(year, levels = c(2021, 2020, 2019, 2018)),
    colour = case_when(
      year == 2021 ~ "#FF2B4F",
      year == 2020 ~ "#3686d3",
      year == 2019 ~ "#003399",
      year == 2018 ~ "#88398a",
      TRUE ~ "gray80"
    )
  ) %>%
  ungroup()

top_weeks <- sum_df %>%
  group_by(year) %>%
  arrange(desc(roll_n)) %>%
  mutate(mean = mean(n)) %>% 
  slice(1) %>% 
  ungroup()

Growth chart by year

The plotting code is below, and the included alt text:

A line chart of TidyTuesday-tagged tweets across the past 3 years, where there is large year over year growth. 2021 is on pace to exceed the total tweet counts from 2020.

tt_plot <- ggplot(
  sum_df,
  aes(
    x = week,
    y = roll_n,
    color = colour,
    group = year
  )
) +
  geom_step(size = 1) +
  geom_point(
    data = top_weeks,
    aes(col = colour),
    size = 2.5,
    stroke = 1
  ) +
  geom_text(
    data = top_weeks,
    aes(label = year),
    size = 8,
    hjust = c(1, 1, 1, 0),
    nudge_y = 50,
    vjust = 0
  ) +
  geom_hline(yintercept = 0, size = 1, color = "black") +
  scale_y_continuous(
    breaks = seq(0, 5500, by = 500),
    limits = c(0, 5500)
  ) +
  scale_x_continuous(
    breaks = c(seq(0, 50, 5), 52),
    limits = c(0, 53)
  ) +
  scale_color_identity(aesthetics = c("colour", "fill")) +
  labs(
    x = "\nWeek Number",
    y = "Cumulative Tweets\n",
    caption = "Data: rtweet | Plot: @thomas_mock",
    title = "Cumulative tweets for #TidyTuesday by year",
    subtitle = "Note that Week 1 of 2018 started in April & tweets must contain: 'rstats, code, plot, graph, viz, data or tidyverse'\n"
  ) +
  tomtom::theme_538() +
  theme(
    legend.position = c(0.1, 0.8),
    legend.background = element_blank(),
    legend.title = element_blank(),
    legend.text = element_text(size = 12),
    plot.background = element_blank(),
    plot.title = element_text(size = 24)
  )

ggsave(
  "tt_tweets.png",
  tt_plot,
  device = ragg::agg_png(
    width = 10,
    height = 10,
    units = "in",
    scaling = 0.8,
    res = 500
  )
)
Saving 12.5 x 12.5 in image
knitr::include_graphics("tt_tweets.png")

A line chart of TidyTuesday-tagged tweets across the past 3 years, where there is large year over year growth. 2021 is on pace to exceed the total tweet counts from 2020.

Data sourced from the TidyTuesday repo.

library(gt)

top_weeks %>% 
  select(year:roll_n, mean) %>% 
  gt() %>% 
  fmt_number(columns = vars(roll_n, mean), decimals = 0) %>% 
  cols_label(
    week = html("Week<br>Number"),
    n = html("Tweets in<br>last week"),
    roll_n = html("Rolling<br>Tweet Count"),
    ) %>% 
  tab_header(
    title = md("**Summary of TidyTuesday Tweets by year**"),
  ) %>% 
  espnscrapeR::gt_theme_538() %>% 
  tab_source_note(
    html("<strong>Data Source: </strong><a href='https://github.com/rfordatascience/tidytuesday/blob/master/tidytuesday_tweets/data.csv'>TidyTuesday Repo</a>")
  )
Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
Summary of TidyTuesday Tweets by year
year Week
Number		 Tweets in
last week		 Rolling
Tweet Count		 mean
2021 52 2 4,353 82
2020 52 19 4,694 89
2019 52 12 2,887 54
2018 39 7 1,059 26
Data Source: TidyTuesday Repo

Peak weeks by year

The next graphic is intended to show the peak number of tweets recorded for each week, separated out by year. The alt text is included below the graphc, but also described as so:

A bar chart of TidyTuesday-tagged tweets across the past 3 years, split into small multiples by year, where each year shows higher weekly peaks over the same week as last year. 2021 is on pace to have the highest number of tweets for most weeks.

col_label_yr <- tibble(
  week = 13,
  n = 110,
  text = "Average/Year",
  colour = "#FF2B4F",
  year = factor(2021)
)

tt_col <- sum_df %>%
  group_by(week) %>%
  mutate(max = max(n), year = factor(year)) %>%
  ungroup() %>%
  ggplot(
    aes(
      x = week,
      y = n,
      fill = colour,
      group = year
    ),
    color = "white",
  ) +
  geom_col(aes(x = week, y = max), fill = "lightgrey", color = "transparent", alpha = 0.7, width = 0.7) +
  geom_col() +
  geom_text(
    data = col_label_yr, hjust = 0, vjust = 0, size = 6, 
    fontface = "bold", family = "Chivo",
    aes(label = text, x = week, y = n, color = colour)
    ) +
  facet_wrap(~year, ncol = 1) +
  geom_hline(yintercept = 0, size = 1, color = "black") +
  geom_hline(
    data = group_by(sum_df, year) %>% summarise(mean = mean(n)),
    aes(yintercept = mean),
    color = c("#FF2B4F", "#3686d3", "#003399", "#88398a"),
    size = 1
  ) +
  scale_x_continuous(
    breaks = c(seq(0, 50, 5), 52),
    limits = c(-1, 53)
  ) +
  scale_color_identity(aesthetics = c("colour", "fill")) +
  tomtom::theme_538() +
  theme(
    legend.position = c(0.1, 0.8),
    legend.background = element_blank(),
    strip.background = element_rect(fill = "white", color = "white"),
    strip.text = element_text(color = "black", face = "bold", size = 16, hjust = 0),
    legend.title = element_blank(),
    legend.text = element_text(size = 12),
    plot.background = element_blank(),
    plot.title = element_text(size = 24)
  ) +
  labs(
    x = "\nWeek Number",
    y = "Weekly Tweets\n",
    caption = "Data: rtweet | Plot: @thomas_mock",
    title = "Weekly tweets for #TidyTuesday by year",
    subtitle = "Note that Week 1 of 2018 started in April & tweets must contain: 'rstats, code, plot, graph, viz, data or tidyverse'\n"
  )

ggsave(
  "tt_columns.png",
  plot = tt_col,
  device = ragg::agg_png(
    width = 10,
    height = 10,
    units = "in",
    scaling = 0.8,
    res = 500
  )
)
Saving 12.5 x 12.5 in image
knitr::include_graphics("tt_columns.png")

A bar chart of TidyTuesday-tagged tweets across the past 3 years, split into small multiples by year, where each year shows higher weekly peaks over the same week as last year. 2021 is on pace to have the highest number of tweets for most weeks.

Data sourced from the TidyTuesday repo.

Below is a corresponding table telling part of the same story, namely that 2021 has many of the highest weekly tweet counts seen over the past 3 years.

sum_df %>% 
  filter(week <= 12) %>% 
  group_by(week) %>% 
  filter(n == max(n)) %>% 
  ungroup() %>% 
  arrange(week) %>% 
  select(year:roll_n) %>% 
  gt() %>% 
  tab_style(
    style = cell_text(color = "#FF2B4F", weight = "bold"),
    locations = cells_body(vars(year), rows = year == 2021)
  ) %>% 
  tab_style(
    style = cell_text(color = "#3686d3", weight = "bold"),
    locations = cells_body(vars(year), rows = year == 2020)
  ) %>% 
  fmt_number(columns = vars(roll_n), decimals = 0) %>% 
  cols_label(
    week = html("Week<br>Number"),
    n = html("Weekly<br>Tweets"),
    roll_n = html("Rolling<br>Total Tweets"),
    ) %>% 
  tab_header(
    title = md("**Peak number of tweets by week**"),
    subtitle = "2021 has most of the top counts for each week"
  ) %>% 
  espnscrapeR::gt_theme_538() %>% 
  tab_source_note(
    html("<strong>Data Source: </strong><a href='https://github.com/rfordatascience/tidytuesday/blob/master/tidytuesday_tweets/data.csv'>TidyTuesday Repo</a>")
  )
Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
Peak number of tweets by week
2021 has most of the top counts for each week
year Week
Number		 Weekly
Tweets		 Rolling
Total Tweets
2021 0 79 79
2021 1 113 192
2021 2 150 342
2021 3 122 464
2021 4 85 549
2021 5 100 649
2021 6 132 781
2020 7 94 630
2020 8 100 730
2020 9 90 820
2021 10 92 1,116
2021 11 115 1,231
2021 12 108 1,339
Data Source: TidyTuesday Repo

Peak users

The last chart is the number of unique contributors by year, regardless of whether they contributed in previous years.

user_year_sum <- raw_df %>%
  filter(!screen_name %in% c("thomas_mock", "r4dscommunity")) %>%
  filter(str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")) %>%
  mutate(created_date = lubridate::as_date(created_at)) %>%
  mutate(
    year = year(created_date),
    week = week(created_date),
    week = if_else(year > 2018, week - 1, week - 14),
    year = factor(year, levels = c(2021, 2020, 2019, 2018))
  ) %>%
  filter(year %in% 2018:2021) %>% 
  count(screen_name, week, year) %>%
  mutate(n = 1) %>%
  arrange(year, week) %>%
  distinct(screen_name, year, .keep_all = TRUE) %>%
  group_by(year) %>%
  mutate(week_roll_n = cumsum(n)) %>%
  mutate(
    colour = case_when(
      year == 2021 ~ "#FF2B4F",
      year == 2020 ~ "#3686d3",
      year == 2019 ~ "#003399",
      year == 2018 ~ "#88398a",
      TRUE ~ "gray80"
    )
  ) %>%
  ungroup() %>%
  mutate(roll_n = cumsum(n))

top_user_sum <-  user_year_sum %>%
  group_by(year) %>%
  arrange(desc(week_roll_n)) %>%
  group_by(year, week) %>% 
  mutate(sum = sum(n)) %>% 
  group_by(year) %>% 
  mutate(mean = mean(sum)) %>% 
  slice(1) %>% 
  ungroup()

user_unique_plot <- user_year_sum %>% 
  ggplot(aes(x = week, y = week_roll_n, color = colour, group = year)) +
  geom_step(size = 1) + 
  geom_point(
    data = top_user_sum,
    aes(col = colour),
    size = 2.5,
    stroke = 1
  ) +
  geom_text(
    data = top_user_sum,
    aes(label = year),
    size = 8,
    hjust = c(1, 1, 1, 0),
    nudge_y = 50,
    vjust = 0
  ) +
  geom_hline(yintercept = 0, size = 1, color = "black") +
  scale_y_continuous(
    breaks = seq(0, 1250, by = 250),
    limits = c(0, 1300)
  ) +
  scale_x_continuous(
    breaks = c(seq(0, 50, 5), 52),
    limits = c(0, 53)
  ) +
  scale_color_identity(aesthetics = c("colour", "fill")) +
  labs(
    x = "\nWeek Number",
    y = "Unique Users\n",
    caption = "Data: rtweet | Plot: @thomas_mock",
    title = "Cumulative unique contributors for #TidyTuesday by year",
    subtitle = "Note that Week 1 of 2018 started in April & tweets must contain: 'rstats, code, plot, graph, viz, data or tidyverse'\n"
  ) +
  tomtom::theme_538() +
  theme(
    legend.position = c(0.1, 0.8),
    legend.background = element_blank(),
    legend.title = element_blank(),
    legend.text = element_text(size = 12),
    plot.background = element_blank(),
    plot.title = element_text(size = 24)
  )

ggsave(
  "tt_users.png",
  user_unique_plot,
  device = ragg::agg_png(
    width = 10,
    height = 10,
    units = "in",
    scaling = 0.8,
    res = 500
  )
)
Saving 12.5 x 12.5 in image
knitr::include_graphics("tt_users.png")

A line chart of unique contributors to TidyTuesday across the past 3 years, where there is large year over year growth. 2021 is on pace to exceed the total unique users from 2020.

Data sourced from the TidyTuesday repo.

Below is a corresponding table telling part of the same story, namely that 2021 has many of the highest weekly user counts recorded over the past 3 years.

top_user_sum %>% 
  select(year, week, mean, roll_n = week_roll_n) %>% 
  gt() %>% 
  fmt_number(columns = vars(roll_n, mean), decimals = 0) %>% 
  cols_label(
    week = html("Unique<br>Weeks"),
    mean = html("Average<br>Weekly Users"),
    roll_n = html("Rolling<br>User Count"),
    ) %>% 
  tab_header(
    title = md("**Summary of TidyTuesday Contributors by year**"),
    subtitle = "2021 has the highest unique user per week"
  ) %>% 
  espnscrapeR::gt_theme_538() %>% 
  tab_source_note(
    html("<strong>Data Source: </strong><a href='https://github.com/rfordatascience/tidytuesday/blob/master/tidytuesday_tweets/data.csv'>TidyTuesday Repo</a>")
  )
Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
Summary of TidyTuesday Contributors by year
2021 has the highest unique user per week
year Unique
Weeks		 Average
Weekly Users		 Rolling
User Count
2021 52 28 1,048
2020 52 26 1,178
2019 52 19 825
2018 39 11 284
Data Source: TidyTuesday Repo

Future

Again, I’m ecstatic about how many contributors and unique tweets there have been to TidyTuesday over the past 3 years, but I hope that we as a community can improve the user experience for potential low vision or blind contributors as well.

I will continue to try and make TidyTuesday as inclusive as possible, and greatly appreciate any ideas, contributions, or suggestions from the wider community.

─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 dplyr       * 1.0.8      2022-02-08 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1      2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5      2021-06-25 [1] CRAN (R 4.2.0)
 gt          * 0.5.0.9000 2022-04-27 [1] Github (rstudio/gt@0d4c83d)
 lubridate   * 1.8.0      2021-10-07 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4      2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2      2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0      2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6      2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0      2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1      2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
]]> meta data visualization TidyTuesday ggplot2 https://themockup.blog/posts/2021-04-01-three-years-of-tidytuesday/index.html Thu, 01 Apr 2021 05:00:00 GMT Including and meta tagging extra content in a distill blog Thomas Mock https://themockup.blog/posts/2021-03-21-meta-tagging-distill/index.html

Including “extra” content in your blog is very useful for collecting all of your content beyond just blogposts. For example, I have a Resources page that sublinks to other things I’ve created or wanted to share at a specific URL.

Header photo by jesse orrico on Unsplash

Image of themockup.blog/resources page

These extra pieces of content include xaringan slides, books, or one-off RMarkdown “sites” that don’t really fit into a blogpost.

My approach is to store these extra pages into a new folder called /static/ in my blog project directory. I do this to generally keep my top-level directory a bit cleaner, and to separate them out from the core blog. Note that lastly, you do not need to put everything in /static if you don’t want to, and you can keep everything at the top-level directory which would serve up content at site-name.com/content-name.html.

Including alternate content

As long as you are using distill v 1.2 or later and rmarkdown v 2.7 or later, you can include alternate RMarkdown-generated content within your distill blog!

Alternate format in this case really just means any other RMarkdown format besides distill.

Now while you can knit files locally and see the output, it will not be moved to your _site directory and served up on your website until you rebuild the site.

These alternate-format pages are rebuilt and included in the _site directory whenever you run rmarkdown::render_site() OR build one of the top-level site pages (ie index.Rmd, about.Rmd, etc).

So for my example, my static pages get written to:
_site/static/FILE-NAME.HTML

and will show up on my blog at:
themockup.blog/static/FILE-NAME.HTML

For example my gt cookbook is linked at:

https://themockup.blog/static/gt-cookbook.html

That’s easy enough, and now you can include basically any piece of arbitrary content you create via RMarkdown, all collected underneath the main URL of your blog/site!

Resources pane

Since I’m on distill, to provide links for everything I want to add another “tab” to my site that shows all the various extra content. I add the below code to my navbar in my _site.yaml file to add a new tab.

navbar:
  right:
    - text: "Home"
      href: index.html
    - text: "Resources"
      href: resources.html
    - text: "About"

The resources page itself can be super lightweight and just link out to the files, but I decided to use a reactable table that references all of the content so it is searchable and sortable. This page is generated by my resources.Rmd file.

Again, you could just provide the raw URL links as hyperlinks to the various pieces of content, it’s “just another page” so feel free to do whatever you want!

Tagging

Having various pieces of content sublinked on your blog generally makes them available to folks trying to access the content on the web. However, it’s also a good idea to add “tags” to them so that they are organically discoverable via search engines. The other benefit is that tags can make your links display summary cards or other rich content on social media sites.

Adding social cards/previews to one-off pieces of content and sub-pages of your blog can help a lot with engagement1. It also has the benefit of helping describe the linked content without having to embed ALL of the description into the body of the Tweet/LinkedIn post. Ultimately it’s also more rewarding as rather than a bare link or a preview card without an image, you can explicitly decide what you want the preview to show!

  • 1  In some cases, 2-3x more views/clicks per https://www.socialsongbird.com/2020/01/how-to-create-clickable-posts-on-social.html

    • Blogposts

    Now for most blogposts in distill you are able to get social preview cards “for free” in that they can just be added via some extra lines in the YAML header. The preview argument turns into the preview image on the index page of your blog and in the meta tags. The title and description also get written into meta tags to be reused by social.

    ---
title: "JavaScript & D3"
description: Enhance communication with interactive visualizations 
base_url: https://rstudio.github.io/distill
preview: images/javascript-d3-preview.png
twitter:
  site: "@rstudio"
  creator: "@fly_upside_down"
---

    {distill} home page

    However, notably the preview image option is missing from the MAIN page of your distill blog.

    You can use the strategies outlined below with metathis or <meta> tags to create a nice tag/meta details for your distill homepage as well.

    While I’ll be covering more details about metathis below, here is what my index.Rmd looks like that attaches <meta> tags via metathis

    ---
title: "Posts"
site: distill::distill_website
listing: posts
---

{r, include=FALSE, results='asis'}
library(metathis)

meta() %>%
  meta_social(
    title = "The MockUp Blog",
    description = "Tom's musings on all things R",
    url = "https://themockup.blog/",
    image = "https://raw.githubusercontent.com/jthomasmock/radix_themockup/master/static/logo-plot.png",
    image_alt = "Chaos into tidy code",
    og_type = "website",
    og_author = "Tom Mock",
    twitter_card_type = "summary",
    twitter_creator = "@thomas_mock"
  )

    Others have written about social card/meta tags for {blogdown}, with examples from Alison Hill, Xavier A, Sharleen W., and Len Kiefer.

    Extra content

    Those built-in options work great for blogposts, but again I also have quite a few extra pieces of content, like my {gt} cookbooks, {xaringan} slide decks, or example interactive tables.

    For these non-blog pages, they are essentially just bare RMarkdown sites. As such, often I need to manually add the <meta> tags that tell the various social pages “what to do” with the page as far as previews.

    <meta> Tags

    <meta> tags are useful for search engine optimization (aka discoverability) of your content, for sharing on social media like LinkedIn or Twitter, or even messaging platforms like Slack, and generally helpful for accessibility. Garrick Aden-Buie recommended the Guide to <meta> and <head> details from Josh Buchea. That sublinks to LOTS of great detail for specific social pages.

    Per w3chools.com:

    The <meta> tag defines metadata about an HTML document. Metadata is data (information) about data.

    Metadata is used by browsers (how to display content or reload page), search engines (keywords), and other web services.

    Furthermore, per the Mozilla blog:

    As you travel around the web, you’ll find other types of metadata, too. A lot of the features you’ll see on websites are proprietary creations, designed to provide certain sites (such as social networking sites) with specific pieces of information they can use.

    For example, Open Graph Data is a metadata protocol that Facebook invented to provide richer metadata for websites. Twitter also has its own similar proprietary metadata called Twitter Cards, which has a similar effect when the site’s URL is displayed on Twitter.com

    Writing <meta> tags

    You can always write <meta> tags by hand, and they aren’t overly complicated, as seen in the Twitter Documentation:

    <meta name="twitter:card" content="summary_large_image">
<meta name="twitter:site" content="@nytimes">
<meta name="twitter:creator" content="@SarahMaslinNir">
<meta name="twitter:title" content="Parade of Fans for Houston">
<meta name="twitter:description" content="NEWARK - The guest list and parade of limousines with celebrities emerging from them seemed more suited to a red carpet event in Hollywood or New York than than a gritty stretch of Sussex Avenue near the former site of the James M. Baxter Terrace public housing project here.">
<meta name="twitter:image" content="http://graphics8.nytimes.com/images/2012/02/19/us/19whitney-span/19whitney-span-articleLarge.jpg">

    However, thanks to Garrick Aden-Buie, you can save yourself a lot of effort and just use the {metathis} package, which provides R functions to generate <meta> tags.

    From the documentation, here’s an example of what a meta-tag generation looks like for the R4DS textbook.

    library(metathis)

meta() %>%
  meta_description(
    "This book will teach you how to do data science with R..."
  ) %>% 
  meta_name("github-repo" = "hadley/r4ds") %>% 
  meta_viewport() %>% 
  meta_social(
    title = "R for Data Science",
    url = "https://r4ds.had.co.nz",
    image = "https://r4ds.had.co.nz/cover.png",
    image_alt = "The cover of the R4DS book",
    og_type = "book",
    og_author = c("Garrett Grolemund", "Hadley Wickham"),
    twitter_card_type = "summary",
    twitter_creator = "@hadley"
  )

    And the HTML output

    #> <meta name="viewport" content="width=device-width, initial-scale=1, orientation=auto"/>
#> <meta name="description" content="This book will teach you how to do data science with R..."/>
#> <meta name="github-repo" content="hadley/r4ds"/>
#> <meta name="twitter:title" content="R for Data Science"/>
#> <meta name="twitter:description" content="This book will teach you how to do data science with R..."/>
#> <meta name="twitter:url" content="https://r4ds.had.co.nz"/>
#> <meta name="twitter:image:src" content="https://r4ds.had.co.nz/cover.png"/>
#> <meta name="twitter:image:alt" content="The cover of the R4DS book"/>
#> <meta name="twitter:card" content="summary"/>
#> <meta name="twitter:creator" content="@hadley"/>
#> <meta name="twitter:site" content="@hadley"/>
#> <meta property="og:title" content="R for Data Science"/>
#> <meta property="og:description" content="This book will teach you how to do data science with R..."/>
#> <meta property="og:url" content="https://r4ds.had.co.nz"/>
#> <meta property="og:image" content="https://r4ds.had.co.nz/cover.png"/>
#> <meta property="og:image:alt" content="The cover of the R4DS book"/>
#> <meta property="og:type" content="book"/>
#> <meta property="og:locale" content="en_US"/>
#> <meta property="article:author" content="Garrett Grolemund"/>
#> <meta property="article:author" content="Hadley Wickham"/>

    I prefer this to writing it all by hand, as it’s less error prone than me typing it out manually!

    {metathis} options

    An aside that tripped me up is that the preview image needs to be linked as a URL, so you won’t be able to just link to a local file, but rather the site or GitHub URL for that specific image.

    Generally you can just write a RMarkdown chunk with echo=FALSE as you’d expect and put the metathis code in it.

    meta() %>% 
  meta_description("My awesome presentation")

    However, for some pieces of content you in RMarkdown there are already <meta> tags that are generated, or they need to explicitly need to be added into the header of the HTML file.

    In that cases where the basic approach is not working, I recommend following Garrick’s {metathis} advice from the readme.

    Option 1:

    Using metathis::include_meta() to explicitly declare the <meta> tags as an HTML dependency

    Option 2 (if all else fails):

    In other packages or situations, you can use include_meta() to explicitly declare the meta tags as an html dependency or use write_meta() to save the <meta> tags to an .html file that can be included via includes: in_header in the YAML of the RMarkdown doc. (In blogdown, consult your blogdown/hugo theme for the correct inclusion method.)

    meta() %>% 
  meta_description("A fantastic blog post") %>% 
  write_meta("meta.html")

    That will generally solve most problems for including social tags in RMarkdown.

    Optimal image sizes

    Each of the social sites have “optimal” sizes/ratios of the images, and Hootsuite has a meta-guide of social media image sizing.

    The short summary is, keep your image file size relatively small, as it’ll cost less in bandwidth and is presented relatively small anyway on social. Twitter specifically will crop your images to a square for basic preview cards.

    Confirm tags

    You can “check” to make sure your tags worked by using tools like:

    Note that if your website is too large, you can’t always get the social “crawlers” to parse the page and return a preview. It’s a good idea to keep your image sizes relatively low, and generally not include TOO much content in a single page.

    Now rather than getting a blank preview card, you can get nice previews!

    Twitter Preview

    LinkedIn Preview

    So go on and create your content, share it widely, and enjoy better previews/urls!

    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     meta distill blog rmarkdown https://themockup.blog/posts/2021-03-21-meta-tagging-distill/index.html Sun, 21 Mar 2021 05:00:00 GMT     Creating a custom gt function for aligning first-row text and testing it with testthat Thomas Mock https://themockup.blog/posts/2021-03-07-custom-gt-functions-and-testing/index.html

    Creating and testing gt functions

    It’s no secret, but I love the gt package and tables in general. I’ve been on a big table kick for almost a year at this point!

    While I love all the amazing features built into gt, sometimes I also want to create my own functions to wrap or extend features.

    For example, I’ve done:

    • Custom gt-themes and functions Blogpost
    • Embedding custom HTML Blogpost
    • Created repeatable beautiful table reporting Gist and Gist
    • Using patchwork to combine ggplot2 + gt Gist

    This blogpost will cover how to solve a fairly common ask, how to add a symbol/character to the end of ONLY the first row of a column and maintain the alignment of the entire column. We’ll walk through how to accomplish this with gt only, creating our own function to do it more succinctly, and then how to further test our gt outputs with testthat!

    No repeats

    I’ve always been a fan of not having to repeat symbols/prefixes/suffixes inside tables. There’s some ongoing work here in gt to add this as a feature, but in the meantime I wanted to play around with a few ways to accomplish this with gt as it is, and/or a custom function as of today.

    You can imagine a situation like below, where we want to label cells within a column as a percent, and want to indicate that it’s a percent ONLY on the first row.

    head(gtcars) %>%
  mutate(hp_pct = (hp/max(hp) * 100)) %>% 
  dplyr::select(mfr, model, year, trim, hp, hp_pct) %>%
  gt() %>% 
  fmt_percent(columns = vars(hp_pct), rows = 1, scale_values = FALSE) %>% 
  fmt_number(columns = vars(hp_pct), rows = 2:6) %>% 
  tab_style(
    style = cell_text(color = "red"), 
    locations = cells_body(vars(hp_pct), rows = 1)
    )
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    mfr model year trim hp hp_pct
    Ford GT 2017 Base Coupe 647 97.88%
    Ferrari 458 Speciale 2015 Base Coupe 597 90.32
    Ferrari 458 Spider 2015 Base 562 85.02
    Ferrari 458 Italia 2014 Base Coupe 562 85.02
    Ferrari 488 GTB 2016 Base Coupe 661 100.00
    Ferrari California 2015 Base Convertible 553 83.66

    However, you can quickly see that this misaligned the first row from the remaining rows.

    No repeats in gt

    An alternative would be to convert those rows to text and apply specific changes.

    There’s quite a bit going on here:

    • Must use a mono space font for the column of interest
      • Must be mono-spaced so that everything aligns properly
    • Align the now text column to be right-aligned
      • Align to right, so again the decimal places align (text default aligns to left otherwise)
    • Use gt::text_transform() to add percent to the first row
      • use base::format() to round and “force” a specific number of decimal places
    • Use gt::text_transform() to add non-breaking space "&nbsp" to remaining rows
      • Must use "&nbsp", which is the HTML code for nonbreaking space, as a raw space (eg " ") will not work

    I want to pause here and say with the code below, we have officially accomplished our goal. However, this was fairly manual and can be repetitive for adding several of these transformations in a single table.

    head(gtcars) %>%
  mutate(hp_pct = (hp/max(hp) * 100)) %>% 
  dplyr::select(mfr, model, year, trim, hp, hp_pct) %>%
  gt() %>%
  # use a mono-spaced font
  tab_style(
    style = cell_text(font = google_font("Fira Mono")),
    locations = cells_body(columns = vars(hp_pct))
    ) %>% 
  # align the column of interst to right
  cols_align(align = "right", columns = vars(hp_pct)) %>% 
  # round and transform the first row to percent
  text_transform(
    locations = cells_body(vars(hp_pct), rows = 1),
    fn = function(x){ 
      fmt_val <- format(as.double(x), nsmall = 1, digits = 1)
      paste0(fmt_val, "%") %>% gt::html()}
  ) %>% 
  text_transform(
    locations = cells_body(vars(hp_pct), rows = 2:6),
    fn = function(x){ 
      # round remaining rows, add a non-breaking space
     fmt_val <- format(as.double(x), nsmall = 1, digits = 1)
     lapply(fmt_val, function(x) paste0(x, '&nbsp') %>% gt::html())
  })
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    mfr model year trim hp hp_pct
    Ford GT 2017 Base Coupe 647 97.9%
    Ferrari 458 Speciale 2015 Base Coupe 597 90.3&nbsp
    Ferrari 458 Spider 2015 Base 562 85.0&nbsp
    Ferrari 458 Italia 2014 Base Coupe 562 85.0&nbsp
    Ferrari 488 GTB 2016 Base Coupe 661 100.0&nbsp
    Ferrari California 2015 Base Convertible 553 83.7&nbsp

    Format symbol first Function

    We can try to wrap some of the gt code into a function and apply these transformations in bulk at the location of our choosing! This is especially important for making it generally apply to other types of inputs instead of JUST %. The function of interest is actually two custom functions, some gt functions, and a good chunk of logic.

    I’ve commented the individual sections as to their purpose, and included quite a bit of error-handling or protecting against various user inputs.

    fmt_symbol_first <- function(
  gt_data,
  column = NULL,        # column of interest to apply to
  symbol = NULL,        # symbol to add, optionally
  suffix = "",          # suffix to add, optionally
  decimals = NULL,      # number of decimal places to round to
  last_row_n,           # what's the last row in data?
  symbol_first = FALSE  # symbol before or after suffix?
) {
  
  # Test and error out if mandatory columns are missing
  stopifnot("`symbol_first` argument must be a logical" = is.logical(symbol_first))
  stopifnot("`last_row_n` argument must be specified and numeric" = is.numeric(last_row_n))
  stopifnot("Input must be a gt table" = class(gt_data)[[1]] == "gt_tbl")

  # needs to type convert to double to play nicely with decimals and rounding
  # as it's converted to character by gt::text_transform
  add_to_first <- function(x, suff = suffix, symb = symbol) {
    if (!is.null(decimals)) {
      x <- suppressWarnings(as.double(x))
      fmt_val <- format(x = x, nsmall = decimals, digits = decimals)
    } else {
      fmt_val <- x
    }

    # combine the value, passed suffix, symbol -> html
    if (isTRUE(symbol_first)) {
      paste0(fmt_val, symb, suff) %>% gt::html()
    } else {
      paste0(fmt_val, suff, symb) %>% gt::html()
    }
  }

  # repeat non-breaking space for combined length of suffix + symbol
  # logic is based on is a NULL passed or not
  if (!is.null(symbol) | !identical(as.character(symbol), character(0))) {
    suffix <- ifelse(identical(as.character(suffix), character(0)), "", suffix)
    length_nbsp <- c("&nbsp", rep("&nbsp", nchar(suffix))) %>%
      paste0(collapse = "")
  } else {
    suffix <- ifelse(identical(as.character(suffix), character(0)), "", suffix)
    length_nbsp <- rep("&nbsp", nchar(suffix)) %>%
      paste0(collapse = "")
  }

  # affect rows OTHER than the first row
  add_to_remainder <- function(x, length = length_nbsp) {
    if (!is.null(decimals)) {
      # if decimal not null, convert to double
      x <- suppressWarnings(as.double(x))
      # then round and format ALL to force specific decimals
      fmt_val <- format(x = x, nsmall = decimals, digits = decimals)
    } else {
      fmt_val <- x
    }
    paste0(fmt_val, length) %>% lapply(FUN = gt::html)
  }

  # pass gt object
  # align right to make sure the spacing is meaningful
  gt_data %>%
    cols_align(align = "right", columns = vars({{ column }})) %>%
    # convert to mono-font for column of interest
    tab_style(
      style = cell_text(font = google_font("Fira Mono")),
      locations = cells_body(columns = vars({{ column }}))
    ) %>%
    # transform first rows
    text_transform(
      locations = cells_body(vars({{ column }}), rows = 1),
      fn = add_to_first
    ) %>%
    # transform remaining rows
    text_transform(
      locations = cells_body(vars({{ column }}), rows = 2:last_row_n),
      fn = add_to_remainder
    )
}

    Use the function

    We can now use that fmt_symbol_first() function, note that I’m testing a few different combinations of suffix/symbols, decimals, etc that may be a bit nonsensical in the table itself but are interactively testing that the results are what I expect. Specifically, I’m making sure that symbols/suffixes are added, and that the spacing is correct. While this is useful for sanity checking quickly, we can also take another step to apply some proper unit-testing in the next section.

    gtcars %>% 
  head() %>% 
  dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>% 
  dplyr::mutate(mpg_h = rnorm(n = dplyr::n(), mean = 22, sd = 1)) %>% 
  gt() %>% 
  opt_table_lines() %>% 
  fmt_symbol_first(column = mfr, symbol = "&#x24;", suffix = " ", last_row_n = 6) %>%
  fmt_symbol_first(column = year, symbol = NULL, suffix = "%", last_row_n = 6) %>%
  fmt_symbol_first(column = mpg_h, symbol = "&#37;", suffix = NULL, last_row_n = 6, decimals = 1) %>% 
  fmt_symbol_first(column = hp, symbol = "&#176;", suffix = "F", last_row_n = 6, decimals = NULL, symbol_first = TRUE)
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    mfr year bdy_style mpg_h hp
    Ford $ 2017% coupe 23.4% 647°F
    Ferrari&nbsp&nbsp 2015&nbsp coupe 22.1&nbsp 597&nbsp&nbsp
    Ferrari&nbsp&nbsp 2015&nbsp convertible 21.4&nbsp 562&nbsp&nbsp
    Ferrari&nbsp&nbsp 2014&nbsp coupe 23.7&nbsp 562&nbsp&nbsp
    Ferrari&nbsp&nbsp 2016&nbsp coupe 23.1&nbsp 661&nbsp&nbsp
    Ferrari&nbsp&nbsp 2015&nbsp convertible 22.3&nbsp 553&nbsp&nbsp

    Unit testing

    At this point, we’ve created a custom gt wrapper function, added some relatively robust checks into the function, but are still manually checking the output confirms to our expectations. We can perform proper unit testing with the {testthat} package.

    Testing your code can be painful and tedious, but it greatly increases the quality of your code. testthat tries to make testing as fun as possible, so that you get a visceral satisfaction from writing tests.

    While an in-depth run through of testhat is beyond the scope of this post, I have included an expandable section with a minimal example below, expanded from the “R Packages” book chapter on testing:

    testthat Example 
    [1] 1
    str_length("ab")  # 2
    [1] 2
    str_length("abc") # 3
    [1] 3

    So str_length() counts the length of a string, fairly straightforward!

    We can convert this to a logical confirmation, which means that a computer can understand if the output was as expected, rather than just printing and reading which is mainly for our interactive use. I have included one FALSE output just as an example.

    str_length("a")   == 1 # 1 TRUE
    [1] TRUE
    str_length("ab")  == 2 # 2 TRUE
    [1] TRUE
    str_length("abc") == 3 # 3 TRUE
    [1] TRUE
    str_length("abc") == 1 # 3 FALSE
    [1] FALSE

    While this testing is useful, we can make it even easier with testhat, by using expect_equal(). Now, these functions will not return anything if they pass. If they fail, then they will print an error, and a helpful statement saying what the failure was.

    ### All TRUE
testthat::expect_equal(str_length("a"),   1) # TRUE
testthat::expect_equal(str_length("ab"),  2) # TRUE
testthat::expect_equal(str_length("abc"), 3) # TRUE

    Just to show you, here’s one where we get a FALSE, the match is off by 2.

    testthat::expect_equal(str_length("a"),  3) # FALSE
    Error: str_length("a") not equal to 3.
1/1 mismatches
[1] 1 - 3 == -2

    The last step, is wrapping our various tests into test_that structure. Here, while the individual tests return no visible output, we can get a friendly message saying they have all passed!

    test_that(
  desc = "str_length is number of characters",
  code = {
    expect_equal(str_length("a"), 1)
    expect_equal(str_length("ab"), 2)
    expect_equal(str_length("abc"), 3)
  }
)
    Test passed 🥳

    We can also see what happens if there is a failure (abcd is not 3 characters, but 4).

    test_that(
  desc = "str_length is number of characters",
  code = {
    expect_equal(str_length("a"), 1)
    expect_equal(str_length("ab"), 2)
    expect_equal(str_length("abc"), 3)
    expect_equal(str_length("abcd"), 3)
  }
)
    ── Failure (<text>:7:5): str_length is number of characters ────────────────────
str_length("abcd") not equal to 3.
1/1 mismatches
[1] 4 - 3 == 1
    Error:
! Test failed

    These tests can be used interactively, but ultimately are even more useful when rolled into an R package. For that next step, I recommend reading through the “R Packages” book, specifically the Packages Chapter.

    Testing gt

    Now you may say, well those minimal example tests were easy, it’s just counting?! How do I test gt? We can treat gt exactly like what it is, a HTML table. Quick example below using our custom function (fmt_symbol_first()).

    ex_gt <- gtcars %>% 
  head() %>% 
  dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>% 
  dplyr::mutate(mpg_h = c(20.2, 22.0, 20.8, 21.2, 22.8, 22.7)) %>% 
  gt() %>% 
  opt_table_font(font = google_font("Roboto Mono")) %>%
  opt_table_lines() %>% 
  fmt_symbol_first(column = mfr, symbol = "&#x24;", suffix = " ", last_row_n = 6) %>%
  fmt_symbol_first(column = year, symbol = NULL, suffix = "%", last_row_n = 6) %>%
  fmt_symbol_first(column = mpg_h, symbol = "&#37;", suffix = NULL, last_row_n = 6, decimals = 1) %>% 
  fmt_symbol_first(column = hp, symbol = "&#176;", suffix = "F", last_row_n = 6, decimals = NULL, symbol_first = TRUE)
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    # example table
ex_gt
    mfr year bdy_style mpg_h hp
    Ford $ 2017% coupe 20.2% 647°F
    Ferrari&nbsp&nbsp 2015&nbsp coupe 22.0&nbsp 597&nbsp&nbsp
    Ferrari&nbsp&nbsp 2015&nbsp convertible 20.8&nbsp 562&nbsp&nbsp
    Ferrari&nbsp&nbsp 2014&nbsp coupe 21.2&nbsp 562&nbsp&nbsp
    Ferrari&nbsp&nbsp 2016&nbsp coupe 22.8&nbsp 661&nbsp&nbsp
    Ferrari&nbsp&nbsp 2015&nbsp convertible 22.7&nbsp 553&nbsp&nbsp 
    # what is it?
ex_gt %>% 
  as_raw_html() %>%  
  str(max.level = 1)
     'html' chr "<table style=\"font-family: 'Roboto Mono', -apple-system, BlinkMacSystemFont, 'Segoe UI', Roboto, Oxygen, Ubunt"| __truncated__
 - attr(*, "html")= logi TRUE

    rvest

    That’s a relatively basic table, but if used interactively it will just print out the output. We can “capture” the raw HTML via gt::as_raw_html(), and then just treat it like another table to “webscrape” with rvest.

    
Attaching package: 'rvest'
    The following object is masked from 'package:readr':

    guess_encoding
    # create object as RAW html
ex_gt_raw <- ex_gt %>% 
  as_raw_html()

# read into rvest, and grab the table body
ex_html_tab <- read_html(ex_gt_raw) %>% 
  html_node("table > tbody") 

# 6 row table!
ex_html_tab
    {html_node}
<tbody style="border-top-style: solid; border-top-width: 2px; border-top-color: #D3D3D3; border-bottom-style: solid; border-bottom-width: 2px; border-bottom-color: #D3D3D3;">
[1] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...
[2] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...
[3] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...
[4] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...
[5] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...
[6] <tr>\n<td style="padding-top: 8px; padding-bottom: 8px; padding-left: 5px ...

    Test HTML

    Now that it’s saved as HTML, we can extract a column, and we’re back to raw strings!

    col1_extract <- ex_html_tab %>% 
    html_nodes(paste0("td:nth-child(",1 , ")")) %>% 
    html_text() 

col1_extract
    [1] "Ford $"            "Ferrari&nbsp&nbsp" "Ferrari&nbsp&nbsp"
[4] "Ferrari&nbsp&nbsp" "Ferrari&nbsp&nbsp" "Ferrari&nbsp&nbsp"

    Now, rather than using the whole string, I’m going to focus on testing the 1st row and then the remainder. Mainly because our function should do different things to the first row versus the remaining rows!

    col1_extract[1] 
    [1] "Ford $"

    So this should be relatively straightforward, we want to do an exact match expecting "Ford $".

    testthat::expect_match(col1_extract[1], "Ford $")
    Error: col1_extract\[1\] does not match "Ford $".
Actual value: "Ford \$"

    BUT oh no we get a failure??? This is because the $ is a special character in regex, so we need to “escape” it with \\. This tells regex to parse it as a literal “dollar sign”. After passing the escape, we now get a silent pass!

    testthat::expect_match(col1_extract[1], "Ford \\$")

    We can run it with test_that() as well, and since it passes we get our friendly little message!

    test_that(
  desc = "First word is Ford $",
  code = testthat::expect_match(col1_extract[1], "Ford \\$")
)
    Test passed 🥇

    Testing function

    Now, I want to test the individual columns for different things, so I’m going to write a test expectation function.

    I’m interested in:

    • The column number
    • The row number (ie first or remaining)
    • A specific expectation

    All using the same HTML input

    test_gt_by_col <- function(col_n, row_first = TRUE, expectation){
  
  # if row_first = TRUE, then just get the 1st row
  # otherwise select the remainder
  if(isTRUE(row_first)){
    row_sel <- 1
  } else {
    row_sel <- 2:6
  }
  
  # use our example html
  # grab the column by number
  # get the rows by selection
  # test the expectation
  ex_html_tab %>% 
    html_nodes(paste0("td:nth-child(",col_n , ")")) %>% 
    html_text() %>% 
    .[row_sel] %>% 
    testthat::expect_match(expectation)
}

    We can then use our function and avoid having to copy-paste much at all!

    test_that(
  desc = "First word is Ford $",
  code = test_gt_by_col(1, row_first = TRUE, expectation = "Ford \\$")
)
    Test passed 🎊

    Just a quick reminder, if it fails (I’m intentionally failing). We can see that the expectation doesn’t match the remainder.

    test_that(
  desc = "First word is Ford $",
  code = test_gt_by_col(1, row_first = FALSE, expectation = "Ford \\$")
)
    ── Failure (<text>:15:3): First word is Ford $ ─────────────────────────────────
`\.` does not match "Ford \\$".
Actual values:
* Ferrari&nbsp&nbsp
* Ferrari&nbsp&nbsp
* Ferrari&nbsp&nbsp
* Ferrari&nbsp&nbsp
* Ferrari&nbsp&nbsp
Backtrace:
 1. global test_gt_by_col(1, row_first = FALSE, expectation = "Ford \\$")
 3. testthat::expect_match(., expectation)
 4. testthat:::expect_match_(...)
    Error:
! Test failed

    Put it all together

    We can put it all together now, and test all of our columns of interest, with testthat using our custom testing function ON the output of the custom function we wrote earlier.

    Create HTML table, extract w/ rvest, define test function 
    ex_gt <- gtcars %>% 
  head() %>% 
  dplyr::select(mfr, year, bdy_style, mpg_h, hp) %>% 
  dplyr::mutate(mpg_h = c(20.2, 22.0, 20.8, 21.2, 22.8, 22.7)) %>% 
  gt() %>% 
  opt_table_font(font = google_font("Roboto Mono")) %>%
  opt_table_lines() %>% 
  fmt_symbol_first(column = mfr, symbol = "&#x24;", suffix = " ", last_row_n = 6) %>%
  fmt_symbol_first(column = year, symbol = NULL, suffix = "%", last_row_n = 6) %>%
  fmt_symbol_first(column = mpg_h, symbol = "&#37;", suffix = NULL, last_row_n = 6, decimals = 1) %>% 
  fmt_symbol_first(column = hp, symbol = "&#176;", suffix = "F", last_row_n = 6, decimals = NULL, symbol_first = TRUE)
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead

Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    ex_gt_raw <- ex_gt %>% 
  as_raw_html()

# read into rvest, and grab the table body
ex_html_tab <- read_html(ex_gt_raw) %>% 
  html_node("table > tbody") 

test_gt_by_col <- function(col_n, row_first = TRUE, expectation){
  
  # if row_first = TRUE, then just get the 1st row
  # otherwise select the remainder
  if(isTRUE(row_first)){
    row_sel <- 1
  } else {
    row_sel <- 2:6
  }
  
  # use our example html
  # grab the column by number
  # get the rows by selection
  # test the expectation
  ex_html_tab %>% 
    html_nodes(paste0("td:nth-child(",col_n , ")")) %>% 
    html_text() %>% 
    .[row_sel] %>% 
    testthat::expect_match(expectation)
}

    Now we can run our tests on the specific columns and get a lot of “praise”! That’s it for now, but maybe we’ll explore putting these tests into a package down the line.

    # Test for escaped characters ---------------------------------------------
# check that a suffix + symbol worked, and that escaped characters can be tested
testthat::test_that(
  "Escaped characters work",
  {
    test_gt_by_col(1, expectation = "Ford \\$")
    test_gt_by_col(1, row_first = FALSE, expectation = "Ferrari&nbsp&nbsp")
  }
  )
    Test passed 😀
    # Test for raw percent ----------------------------------------------------
# on this column we used the literal string of %
testthat::test_that(
  "Raw percent character works",
  {
    test_gt_by_col(2, expectation = "2017%")
    test_gt_by_col(2, row_first = FALSE, expectation = "201[4-7]&nbsp")
  }
  )
    Test passed 🎉
    # Test for symbolic percent -----------------------------------------------
# on this column we used the HTML code for percent
testthat::test_that(
  "HTML symbol for percent works",
  {
    test_gt_by_col(4, expectation = "20.2%")
    test_gt_by_col(4, row_first = FALSE, expectation = "[0-9]+&nbsp")
  }
  )
    Test passed 🥇
    # Test for suffix + symbol ------------------------------------------------
# test for case where the symbol is in front of suffix
testthat::test_that(
  "A combined suffix + symbol work",
  {
    test_gt_by_col(5, expectation = "647°F")
    test_gt_by_col(5, row_first = FALSE, expectation = "[0-9]+&nbsp&nbsp")
  }
  )
    Test passed 🎊
    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 dplyr       * 1.0.8      2022-02-08 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1      2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5      2021-06-25 [1] CRAN (R 4.2.0)
 gt          * 0.5.0.9000 2022-04-27 [1] Github (rstudio/gt@0d4c83d)
 purrr       * 0.3.4      2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2      2022-01-30 [1] CRAN (R 4.2.0)
 rvest       * 1.0.2      2021-10-16 [1] CRAN (R 4.2.0)
 scales      * 1.2.0      2022-04-13 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0      2019-02-10 [1] CRAN (R 4.2.0)
 testthat    * 3.1.4      2022-04-26 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6      2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0      2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1      2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     gt functions testing https://themockup.blog/posts/2021-03-07-custom-gt-functions-and-testing/index.html Sun, 07 Mar 2021 06:00:00 GMT     Joins vs case whens - speed and memory tradeoffs Thomas Mock https://themockup.blog/posts/2021-02-13-joins-vs-casewhen-speed-and-memory-tradeoffs/index.html

    Matching names

    There are many times where you may have a reference dataset that has some type of short-code, abbreviations, nicknames, or even misspellings. In this situation we want to create a new column or even overwrite the existing column with the correct spelling, the full name, etc.

    While there isn’t a wrong way to do this, I’ve made mistakes in the past of making things more complicated for myself during data cleaning/prep steps. Most importantly to me in my data cleaning steps are “speed of thought” - aka how long it takes me to type out or reason through, but there are also tradeoffs in memory usage and in execution speed.

    I’m going to step through some strategies, honed by years of TidyTuesday data cleaning and prep!

    In general I want to preface all these examples with the fact that this exercise is easily translatable to various join options. Joins are great, but there are situations where the logicals aren’t simple matches/index (like x == "val") but rather more complex queries (like x > 5 & var %in% c("val", "val2")), but I’m going to live within the constraints of my example use case. Also note that joins could join on more than one key or add as many variables as needed rather than just one, so there’s additional complexity possible here.

    To avoid burying the lede, joins are by far the fastest and most memory-efficient method if you can fit your problem to that solution, data.table::fcase() provides a easy to use and remarkably fast/memory-efficient intermediate method that works in base R, data.tables or dplyr, and dplyr::case_when() is the slowest/most-memory hungry for in-memory cases, BUT is probably fast enough for relatively small data (< 1,000,000 rows) and is the option that allows pushing compute into a remote backend via dbplyr/sparklyr.

    Example Data

    We’re going to simulate a dataset with NFL team abbreviations and a “stat” that is relatively in scope with something like EPA, but again this is all simulated data.

    library(tidyverse)

# relatively nice sized dataset (100,000 rows)
sample_size <- 100000

# Get example team names from espn
all_teams <- espnscrapeR::get_nfl_teams()
    Getting NFL teams!
    # set a reproducible seed (h/t to Anthony's wife's new $4 luggage...)
set.seed(829)

ex_df <- tibble(
  team = sample(all_teams$team_abb, size = sample_size, replace = TRUE),
  stat = rnorm(sample_size, mean = 0.1, sd = 0.1)
)

ex_df
    # A tibble: 100,000 × 2
   team     stat
   <chr>   <dbl>
 1 HOU    0.0593
 2 JAX   -0.0534
 3 DEN   -0.0488
 4 NO    -0.0527
 5 CAR    0.111 
 6 CHI    0.132 
 7 CAR    0.0481
 8 IND    0.412 
 9 HOU    0.0425
10 ARI    0.200 
# … with 99,990 more rows

    dplyr::case_when() solution

    There’s a fantastic function in the dplyr package called case_when().

    case_when:

    This function allows you to vectorise multiple if_else()

    In essence, this provides the ability to provide many logical statements to generate a specific outcome. You can read more about the syntax via: ?dplyr::case_when() in the R console or the docs. This functions works on vectors as well as in mutations inside data.frames/tibbles/data.tables. Lastly, it can also be translated into SQL automatically via dbplyr in situations where you don’t want to bring all the data into memory.

    case_when is very readable to me, and feels better than a whole bundle of nested ifelse/if_else statements.

    A quick reprex of case_when() usage.

    ex_car <- mpg %>% 
  select(model, cyl, cty, hwy) %>% 
  slice_sample(n = 100)

ex_car %>% 
  mutate(
    cyl_character = case_when(
      # if logical statement is TRUE then assign new value
      cyl == 4 ~ "Four",
      cyl == 6 ~ "Six",
      cyl == 8 ~ "Eight",
      # This last statement means, if none of the above conditions are met
      # then return a NA value, note that case_when is type-safe
      # so you'll want to use the various NA_??? for the type of output
      TRUE ~ NA_character_
    )
  )
    # A tibble: 100 × 5
   model                 cyl   cty   hwy cyl_character
   <chr>               <int> <int> <int> <chr>        
 1 a4                      4    20    31 Four         
 2 malibu                  4    22    30 Four         
 3 ram 1500 pickup 4wd     8     9    12 Eight        
 4 jetta                   5    21    29 <NA>         
 5 passat                  4    18    29 Four         
 6 camry solara            6    18    26 Six          
 7 f150 pickup 4wd         8    13    16 Eight        
 8 a4 quattro              6    17    25 Six          
 9 grand cherokee 4wd      8    14    19 Eight        
10 jetta                   4    22    29 Four         
# … with 90 more rows

    Now that we understand the syntax a bit better, let’s try it on our dataset of interest! Remember, we want to take our team abbreviations and add the team names into the dataset. So we’ll need to provide a logical match of each team to the correct abbreviation and output the corresponding full name.

    This works out very well and we got all the names in the right spot, and with the basic timing via tictoc we can see it was still fast. However, there’s a LOT of typing, and more importantly a lot of repetitive typing to get this done.

    library(tictoc)

tic()
ex_df %>% 
    mutate(
      team_name = case_when(
        team == "ARI" ~ "Cardinals",
        team == "ATL" ~ "Falcons",
        team == "BAL" ~ "Ravens",
        team == "BUF" ~ "Bills",
        team == "CAR" ~ "Panthers",
        team == "CHI" ~ "Bears",
        team == "CIN" ~ "Bengals",
        team == "CLE" ~ "Browns",
        team == "DAL" ~ "Cowboys",
        team == "DEN" ~ "Broncos",
        team == "DET" ~ "Lions",
        team == "GB" ~ "Packers",
        team == "HOU" ~ "Texans",
        team == "IND" ~ "Colts",
        team == "JAX" ~ "Jaguars",
        team == "KC" ~ "Chiefs",
        team == "LV" ~ "Raiders",
        team == "LAC" ~ "Chargers",
        team == "LAR" ~ "Rams",
        team == "MIA" ~ "Dolphins",
        team == "MIN" ~ "Vikings",
        team == "NE" ~ "Patriots",
        team == "NO" ~ "Saints",
        team == "NYG" ~ "Giants",
        team == "NYJ" ~ "Jets",
        team == "PHI" ~ "Eagles",
        team == "PIT" ~ "Steelers",
        team == "SF" ~ "49ers",
        team == "SEA" ~ "Seahawks",
        team == "TB" ~ "Buccaneers",
        team == "TEN" ~ "Titans",
        team == "WSH" ~ NA_character_,
        TRUE ~ NA_character_
      )
    )
    # A tibble: 100,000 × 3
   team     stat team_name
   <chr>   <dbl> <chr>    
 1 HOU    0.0593 Texans   
 2 JAX   -0.0534 Jaguars  
 3 DEN   -0.0488 Broncos  
 4 NO    -0.0527 Saints   
 5 CAR    0.111  Panthers 
 6 CHI    0.132  Bears    
 7 CAR    0.0481 Panthers 
 8 IND    0.412  Colts    
 9 HOU    0.0425 Texans   
10 ARI    0.200  Cardinals
# … with 99,990 more rows
    toc()
    0.082 sec elapsed

    We can use a few tricks in RStudio to make this easier!

    We’ll use “multiple cursors” in RStudio and combine that with the amazing {datapasta} package from Miles McBain.

    datapasta is about reducing resistance associated with copying and pasting data to and from R. It is a response to the realisation that I often found myself using intermediate programs like Sublime to munge text into suitable formats. Addins and functions in datapasta support a wide variety of input and output situations, so it (probably) “just works”. Hopefully tools in this package will remove such intermediate steps and associated frustrations from our data slinging workflows.

    datapasta is an absolute life saver for converting objects like vectors/dataframes/clipboard contents and turning them into editable formats in a script.

    Step 1: datapasta

    We’ll first create a character vector via datapasta, using the below code:

    ex_df %>% 
  distinct(team) %>% 
  arrange(team) %>% 
  pull() %>% 
  datapasta::vector_paste_vertical()

    I’ve shown a video of me stepping through this code since there are a lot of different options for datapasta and its outputs.

    This gives us a nice starting point of all the vector items and we are ready to work with them in our script.

    Step 2: Multiple line selection in RStudio

    I’ve done this as a video as it’s fairly complex to “write about”, but very easy to show! The video describes the process of enabling multiple selections in RStudio.

    Note that the enabling multi-line selection is done in RStudio via:

    • Opt key + Left Mouse Button drag on Mac
    • Alt key + Left Mouse Button drag on Windows

    Once we have this “skeleton” quickly created we can then add the individual “match outputs”, like “Cardinals” for “ARI”, “Falcons” for “ATL”, etc, but we’ve saved ourself the need to type out a lot of the repeated “skeleton” of the case_when().

    A join solution

    While the above method is pretty quick to create and understand, we still had to type quite a bit (which is decreased if you use multiple cursors), and in many situations a true join is more efficient in terms of typing, “speed of thought”, and execution time.

    team_join <- all_teams %>% 
  select(team_name, team = team_abb)

tic()
left_join(ex_df, team_join, by = "team")
    # A tibble: 100,000 × 3
   team     stat team_name
   <chr>   <dbl> <chr>    
 1 HOU    0.0593 Texans   
 2 JAX   -0.0534 Jaguars  
 3 DEN   -0.0488 Broncos  
 4 NO    -0.0527 Saints   
 5 CAR    0.111  Panthers 
 6 CHI    0.132  Bears    
 7 CAR    0.0481 Panthers 
 8 IND    0.412  Colts    
 9 HOU    0.0425 Texans   
10 ARI    0.200  Cardinals
# … with 99,990 more rows
    toc()
    0.012 sec elapsed

    Now you may say, well of course I could just use a join if I have a perfect dataset, what do I do with data cleaning?! I would say that a while ago this was a revelation as I typically only would move to key-value pairs + joins when it was obvious, and sometimes I’d end up using a case when solution when a join was easily possible.

    So, keep in mind that we can often “create” a joining dataset and use it pretty easily!

    tribble

    We can use tribble to use almost the exact same setup as the case_when(). We can even use the same multiple cursor workflow to take alter our existing case_when() code and turn it into the below tribble setup.

    tribble(
  ~team, ~team_name,
  "ARI", "Cardinals",
  "ATL", "Falcons",
  "BAL", "Ravens",
  "BUF", "Bills",
  "CAR", "Panthers",
  "CHI", "Bears",
  "CIN", "Bengals",
  "CLE", "Browns",
  "DAL", "Cowboys",
  "DEN", "Broncos",
  "DET", "Lions",
  "GB", "Packers",
  "HOU", "Texans",
  "IND", "Colts",
  "JAX", "Jaguars",
  "KC", "Chiefs",
  "LV", "Raiders",
  "LAC", "Chargers",
  "LAR", "Rams",
  "MIA", "Dolphins",
  "MIN", "Vikings",
  "NE", "Patriots",
  "NO", "Saints",
  "NYG", "Giants",
  "NYJ", "Jets",
  "PHI", "Eagles",
  "PIT", "Steelers",
  "SF", "49ers",
  "SEA", "Seahawks",
  "TB", "Buccaneers",
  "TEN", "Titans",
  "WSH", NA_character_
  )
    # A tibble: 32 × 2
   team  team_name
   <chr> <chr>    
 1 ARI   Cardinals
 2 ATL   Falcons  
 3 BAL   Ravens   
 4 BUF   Bills    
 5 CAR   Panthers 
 6 CHI   Bears    
 7 CIN   Bengals  
 8 CLE   Browns   
 9 DAL   Cowboys  
10 DEN   Broncos  
# … with 22 more rows

    You could also just create a more traditional data.frame/tibble, and do the same thing without having to “align” all the rows visually. I do find it a bit easier to look at it row-by-row in the tribble so that I can sanity check myself as I go, but up to the reader to decide!

    ex_df %>% 
  distinct(team) %>% 
  arrange(team) %>% 
  mutate(
    team_name = 
      c(
        "Cardinals", "Falcons", "Ravens", "Bills", "Panthers", "Bears", 
        "Bengals", "Browns", "Cowboys", "Broncos", "Lions", "Packers", "Texans", 
        "Colts", "Jaguars", "Chiefs", "Raiders", "Chargers", "Rams", "Dolphins", 
        "Vikings", "Patriots", "Saints", "Giants", "Jets", "Eagles", "Steelers", 
        "49ers", "Seahawks", "Buccaneers", "Titans", NA_character_
    )
  )
    # A tibble: 32 × 2
   team  team_name
   <chr> <chr>    
 1 ARI   Cardinals
 2 ATL   Falcons  
 3 BAL   Ravens   
 4 BUF   Bills    
 5 CAR   Panthers 
 6 CHI   Bears    
 7 CIN   Bengals  
 8 CLE   Browns   
 9 DAL   Cowboys  
10 DEN   Broncos  
# … with 22 more rows

    data.table::fcase

    Now there is also an equivalent function to case_when() in data.table called fcase (short for fast case when) as of late 2019. Since it operates on any vector, you can use it as a drop in replacement for most in-memory cases of case_when() in dplyr, or use it in native data.table objects. The expectation is that it will operate similarly in output but be more efficient with regards to memory/time.

    data.table actually provides all sorts of cool optimized functions like this that work anywhere, and you can generally assume a “f” in front of an existing base R function name for the “faster” version of it. See fifelse, rleid, fsetdiff for example.

    Note, you do not have the ability to push the translation of fcase() into SQL though, as dbplyr only has SQL-translation for case_when().

    The syntax of fcase() and case_when() are essentially the same, but rather than a formula-syntax for assignment via ~, it relies on another comma to assign by position.

    Compare the syntax below:

    library(data.table)

mtcars %>% 
  tibble() %>%
  select(mpg, cyl) %>% 
  mutate(
    cyl_case_when = case_when(
      # relies on `~` to indicate assign
      # read as if cyl is equal to 4 assign "Four"
      cyl == 4 ~ "Four",
      cyl == 6 ~ "Six",
      cyl == 8 ~ "Eight",
      TRUE ~ NA_character_
    ),
    cyl_fcase = fcase(
      # relies on another `,` to assign by position
      # reas as if cyl is equal to 4, "Four"
      cyl == 4, "Four",
      cyl == 6, "Six",
      cyl == 8, "Eight",
      TRUE, NA_character_
    ),
    cyl_match = cyl_case_when == cyl_fcase
  )
    # A tibble: 32 × 5
     mpg   cyl cyl_case_when cyl_fcase cyl_match
   <dbl> <dbl> <chr>         <chr>     <lgl>    
 1  21       6 Six           Six       TRUE     
 2  21       6 Six           Six       TRUE     
 3  22.8     4 Four          Four      TRUE     
 4  21.4     6 Six           Six       TRUE     
 5  18.7     8 Eight         Eight     TRUE     
 6  18.1     6 Six           Six       TRUE     
 7  14.3     8 Eight         Eight     TRUE     
 8  24.4     4 Four          Four      TRUE     
 9  22.8     4 Four          Four      TRUE     
10  19.2     6 Six           Six       TRUE     
# … with 22 more rows

    Now, I have converted our example with the case_when() statement into fcase() for both dplyr and data.table, but have hidden the code in the detail box below since it’s almost identical and would be quite repetitive. I have printed a test to see if the outcomes are equivalent though between native data.table and dplyr, and they are! 🥳

    Really happy to have the option of using some various methods in-memory via fcase() and/or case_when() and optionally if working with REALLY large data push some of that compute into the database via dbplyr + case_when().

    tic()
dplyr_fcase <- ex_df %>% 
    mutate(
      team_name = fcase(
        team == "ARI", "Cardinals",
        team == "ATL", "Falcons",
        team == "BAL", "Ravens",
        team == "BUF", "Bills",
        team == "CAR", "Panthers",
        team == "CHI", "Bears",
        team == "CIN", "Bengals",
        team == "CLE", "Browns",
        team == "DAL", "Cowboys",
        team == "DEN", "Broncos",
        team == "DET", "Lions",
        team == "GB" ,"Packers",
        team == "HOU", "Texans",
        team == "IND", "Colts",
        team == "JAX", "Jaguars",
        team == "KC" ,"Chiefs",
        team == "LV" ,"Raiders",
        team == "LAC", "Chargers",
        team == "LAR", "Rams",
        team == "MIA", "Dolphins",
        team == "MIN", "Vikings",
        team == "NE" ,"Patriots",
        team == "NO" ,"Saints",
        team == "NYG", "Giants",
        team == "NYJ", "Jets",
        team == "PHI", "Eagles",
        team == "PIT", "Steelers",
        team == "SF" ,"49ers",
        team == "SEA", "Seahawks",
        team == "TB" ,"Buccaneers",
        team == "TEN", "Titans",
        team == "WSH", NA_character_,
        TRUE, NA_character_
      )
    )
toc()
    0.017 sec elapsed
    # data.table native
dt_fcase <- data.table(ex_df)[, team_name := fcase(
    team == "ARI", "Cardinals",
    team == "ATL", "Falcons",
    team == "BAL", "Ravens",
    team == "BUF", "Bills",
    team == "CAR", "Panthers",
    team == "CHI", "Bears",
    team == "CIN", "Bengals",
    team == "CLE", "Browns",
    team == "DAL", "Cowboys",
    team == "DEN", "Broncos",
    team == "DET", "Lions",
    team == "GB" ,"Packers",
    team == "HOU", "Texans",
    team == "IND", "Colts",
    team == "JAX", "Jaguars",
    team == "KC" ,"Chiefs",
    team == "LV" ,"Raiders",
    team == "LAC", "Chargers",
    team == "LAR", "Rams",
    team == "MIA", "Dolphins",
    team == "MIN", "Vikings",
    team == "NE" ,"Patriots",
    team == "NO" ,"Saints",
    team == "NYG", "Giants",
    team == "NYJ", "Jets",
    team == "PHI", "Eagles",
    team == "PIT", "Steelers",
    team == "SF" ,"49ers",
    team == "SEA", "Seahawks",
    team == "TB" ,"Buccaneers",
    team == "TEN", "Titans",
    team == "WSH", NA_character_,
    TRUE, NA_character_
  )] %>% 
    as_tibble()
    all_equal(dplyr_fcase, dt_fcase)
    [1] TRUE

    Speed and Memory

    I’m going to preface this by also saying that this is a particular straight forward problem to translate into a join, and it has 32 total comparisons. Most uses of case_when() or fcase() will be more traditional and/or complex logic problems and be much fewer than 30!!!

    Now with that being said, you may still say, well I’m not convinced that join() method is any easier or faster to code out for humans, and we’re all free to make our own decisions! I do want to note that case_when() gets memory-inefficient much faster than ???_join().

    We can really highlight the differences in the execution time and the memory allocated via the bench package. I’m using bench to execute the two different methods 3x time, compare the timing and the memory used, along with some other stats.

    In the expandable section below we have a repeat of our above left_join() and case_when() calls.

    join_expr <- function(){
  left_join(ex_df, team_join, by = "team") %>% 
    slice(1)
}

case_when_expr <- function(){
  ex_df %>% 
    mutate(
      team_name = case_when(
        team == "ARI" ~ "Cardinals",
        team == "ATL" ~ "Falcons",
        team == "BAL" ~ "Ravens",
        team == "BUF" ~ "Bills",
        team == "CAR" ~ "Panthers",
        team == "CHI" ~ "Bears",
        team == "CIN" ~ "Bengals",
        team == "CLE" ~ "Browns",
        team == "DAL" ~ "Cowboys",
        team == "DEN" ~ "Broncos",
        team == "DET" ~ "Lions",
        team == "GB" ~ "Packers",
        team == "HOU" ~ "Texans",
        team == "IND" ~ "Colts",
        team == "JAX" ~ "Jaguars",
        team == "KC" ~ "Chiefs",
        team == "LV" ~ "Raiders",
        team == "LAC" ~ "Chargers",
        team == "LAR" ~ "Rams",
        team == "MIA" ~ "Dolphins",
        team == "MIN" ~ "Vikings",
        team == "NE" ~ "Patriots",
        team == "NO" ~ "Saints",
        team == "NYG" ~ "Giants",
        team == "NYJ" ~ "Jets",
        team == "PHI" ~ "Eagles",
        team == "PIT" ~ "Steelers",
        team == "SF" ~ "49ers",
        team == "SEA" ~ "Seahawks",
        team == "TB" ~ "Buccaneers",
        team == "TEN" ~ "Titans",
        team == "WSH" ~ NA_character_,
        TRUE ~ NA_character_
      )
    ) %>% slice(1)
}

    We can then compare their execution multiple times with the bench package. This will vary by the execution, but with 3 iterations and 100,000 rows, I have seen about a 10x speed improvement in left_join vs case_when. Note that in most cases this is still pretty much instantaneous in “human time”.

    Visual reaction time in young adults is in the range of about 250 ms per Jain et al.

    However, do note that we use about 28-30 times more memory for the case_when() statement.

    bench::mark(
  min_time = 0.1,
  max_iterations = 3,
  min_iterations = 3,
  case_when_expr(),
  join_expr()
) %>% 
  select(expression, min, median, mem_alloc, n_itr)
    # A tibble: 2 × 4
  expression            min   median mem_alloc
  <bch:expr>       <bch:tm> <bch:tm> <bch:byt>
1 case_when_expr()  66.02ms  99.43ms  150.82MB
2 join_expr()        5.07ms   5.15ms    5.37MB

    The 150 Mb of memory used, may not seem like a lot with smaller datasets (100,000), but if we were to bump this up to 1,000,000 rows we see a similar 10x increase of memory. Specifically we are now up to ~1.5 Gb of memory used for case_when(). So if you’re going beyond the millions or 10s of millions of rows AND are trying to do a LOT of comparisons, probably a good idea to start refactoring into a join if possible!

    # 1,000,000 rows as 1e6
sample_size <- 1e6

set.seed(829)

ex_df <- tibble(
  team = sample(all_teams$team_abb, size = sample_size, replace = TRUE),
  stat = rnorm(sample_size, mean = 0.1, sd = 0.1)
)

bench::mark(
  min_time = 0.1,
  max_iterations = 3,
  min_iterations = 3,
  case_when_expr(),
  join_expr()
) %>% 
  select(expression, min, median, mem_alloc, n_itr)
    # A tibble: 2 × 4
  expression            min   median mem_alloc
  <bch:expr>       <bch:tm> <bch:tm> <bch:byt>
1 case_when_expr()  595.8ms  636.3ms    1.47GB
2 join_expr()        42.7ms   45.9ms   53.43MB

    There are situations where a join doesn’t solve the problem, so we can go one step further and add in our data.table::fcase() or dtplyr-translation of dplyr into data.table. All the example reprex code is in an expandable chunk below.

    library(dtplyr)

case_when_dplyr <- function(){
  ex_df %>% 
    mutate(
      team_name = case_when(
        team == "ARI" ~ "Cardinals",
        team == "ATL" ~ "Falcons",
        team == "BAL" ~ "Ravens",
        team == "BUF" ~ "Bills",
        team == "CAR" ~ "Panthers",
        team == "CHI" ~ "Bears",
        team == "CIN" ~ "Bengals",
        team == "CLE" ~ "Browns",
        team == "DAL" ~ "Cowboys",
        team == "DEN" ~ "Broncos",
        team == "DET" ~ "Lions",
        team == "GB" ~ "Packers",
        team == "HOU" ~ "Texans",
        team == "IND" ~ "Colts",
        team == "JAX" ~ "Jaguars",
        team == "KC" ~ "Chiefs",
        team == "LV" ~ "Raiders",
        team == "LAC" ~ "Chargers",
        team == "LAR" ~ "Rams",
        team == "MIA" ~ "Dolphins",
        team == "MIN" ~ "Vikings",
        team == "NE" ~ "Patriots",
        team == "NO" ~ "Saints",
        team == "NYG" ~ "Giants",
        team == "NYJ" ~ "Jets",
        team == "PHI" ~ "Eagles",
        team == "PIT" ~ "Steelers",
        team == "SF" ~ "49ers",
        team == "SEA" ~ "Seahawks",
        team == "TB" ~ "Buccaneers",
        team == "TEN" ~ "Titans",
        team == "WSH" ~ NA_character_,
        TRUE ~ NA_character_
      )
    )
} 


join_dplyr <- function(){
  left_join(ex_df, team_join, by = "team")
}

join_dtplyr <- function(){
  dt_ex_df <- lazy_dt(ex_df)
  team_join <- lazy_dt(team_join)
    
  dt_ex_df %>% 
    left_join(team_join, by = "team") %>% 
    select(team, stat, team_name) %>% 
    as_tibble() 
}

case_when_dtplyr <- function(){
  lazy_dt(ex_df) %>% 
    mutate(
      team_name = case_when(
        team == "ARI" ~ "Cardinals",
        team == "ATL" ~ "Falcons",
        team == "BAL" ~ "Ravens",
        team == "BUF" ~ "Bills",
        team == "CAR" ~ "Panthers",
        team == "CHI" ~ "Bears",
        team == "CIN" ~ "Bengals",
        team == "CLE" ~ "Browns",
        team == "DAL" ~ "Cowboys",
        team == "DEN" ~ "Broncos",
        team == "DET" ~ "Lions",
        team == "GB" ~ "Packers",
        team == "HOU" ~ "Texans",
        team == "IND" ~ "Colts",
        team == "JAX" ~ "Jaguars",
        team == "KC" ~ "Chiefs",
        team == "LV" ~ "Raiders",
        team == "LAC" ~ "Chargers",
        team == "LAR" ~ "Rams",
        team == "MIA" ~ "Dolphins",
        team == "MIN" ~ "Vikings",
        team == "NE" ~ "Patriots",
        team == "NO" ~ "Saints",
        team == "NYG" ~ "Giants",
        team == "NYJ" ~ "Jets",
        team == "PHI" ~ "Eagles",
        team == "PIT" ~ "Steelers",
        team == "SF" ~ "49ers",
        team == "SEA" ~ "Seahawks",
        team == "TB" ~ "Buccaneers",
        team == "TEN" ~ "Titans",
        team == "WSH" ~ NA_character_,
        TRUE ~ NA_character_
      )
    ) %>% 
    as_tibble()
  
}

fcase_dplyr <- function(){
  ex_df %>% 
    mutate(
      team_name = fcase(
        team == "ARI", "Cardinals",
        team == "ATL", "Falcons",
        team == "BAL", "Ravens",
        team == "BUF", "Bills",
        team == "CAR", "Panthers",
        team == "CHI", "Bears",
        team == "CIN", "Bengals",
        team == "CLE", "Browns",
        team == "DAL", "Cowboys",
        team == "DEN", "Broncos",
        team == "DET", "Lions",
        team == "GB" ,"Packers",
        team == "HOU", "Texans",
        team == "IND", "Colts",
        team == "JAX", "Jaguars",
        team == "KC" ,"Chiefs",
        team == "LV" ,"Raiders",
        team == "LAC", "Chargers",
        team == "LAR", "Rams",
        team == "MIA", "Dolphins",
        team == "MIN", "Vikings",
        team == "NE" ,"Patriots",
        team == "NO" ,"Saints",
        team == "NYG", "Giants",
        team == "NYJ", "Jets",
        team == "PHI", "Eagles",
        team == "PIT", "Steelers",
        team == "SF" ,"49ers",
        team == "SEA", "Seahawks",
        team == "TB" ,"Buccaneers",
        team == "TEN", "Titans",
        team == "WSH", NA_character_
      )
    )
}
  

fcase_dt_native <- function(){
  data.table(ex_df)[, team_name := fcase(
    team == "ARI", "Cardinals",
    team == "ATL", "Falcons",
    team == "BAL", "Ravens",
    team == "BUF", "Bills",
    team == "CAR", "Panthers",
    team == "CHI", "Bears",
    team == "CIN", "Bengals",
    team == "CLE", "Browns",
    team == "DAL", "Cowboys",
    team == "DEN", "Broncos",
    team == "DET", "Lions",
    team == "GB" ,"Packers",
    team == "HOU", "Texans",
    team == "IND", "Colts",
    team == "JAX", "Jaguars",
    team == "KC" ,"Chiefs",
    team == "LV" ,"Raiders",
    team == "LAC", "Chargers",
    team == "LAR", "Rams",
    team == "MIA", "Dolphins",
    team == "MIN", "Vikings",
    team == "NE" ,"Patriots",
    team == "NO" ,"Saints",
    team == "NYG", "Giants",
    team == "NYJ", "Jets",
    team == "PHI", "Eagles",
    team == "PIT", "Steelers",
    team == "SF" ,"49ers",
    team == "SEA", "Seahawks",
    team == "TB" ,"Buccaneers",
    team == "TEN", "Titans",
    team == "WSH", NA_character_
  )] %>% 
    as_tibble()
}

join_dt_native <- function(){
  data.table(ex_df)[data.table(team_join), on = .(team), team_name := team_name] %>% 
    as_tibble()
}

    Finally we can check the timing/memory usage for all of the combos. In short, join()-methods are fastest and use the least memory, fcase() whether in native data.table or dplyr is a bit slower/more memory than join but still ~5x faster/more memory efficient than case_when(), and case_when() is the slowest/most memory hungry (but translates into SQL if needed).

    Overall, I’m really happy that we have the ability to mix and match functions from various awesome packages depending on the problems we’re trying to solve!

    bench::mark(
  min_time = 0.1,
  max_iterations = 3,
  min_iterations = 3,
  case_when_dplyr(),
  case_when_dtplyr(),
  fcase_dplyr(),
  fcase_dt_native(),
  join_dplyr(),
  join_dt_native(),
  check = FALSE
) %>% 
  select(expression, min, median, mem_alloc, n_itr)
    # A tibble: 6 × 4
  expression              min   median mem_alloc
  <bch:expr>         <bch:tm> <bch:tm> <bch:byt>
1 case_when_dplyr()   583.4ms  624.6ms    1.47GB
2 case_when_dtplyr()  121.9ms  127.7ms  165.18MB
3 fcase_dplyr()       120.3ms  120.5ms  133.72MB
4 fcase_dt_native()   121.9ms  129.1ms  164.39MB
5 join_dplyr()         41.1ms   42.7ms   53.43MB
6 join_dt_native()     31.9ms   35.6ms   61.63MB
    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 bench       * 1.1.2   2021-11-30 [1] CRAN (R 4.2.0)
 data.table  * 1.14.2  2021-09-27 [1] CRAN (R 4.2.0)
 datapasta   * 3.1.1   2022-04-26 [1] Github (MilesMcBain/datapasta@69d2a69)
 dplyr       * 1.0.8   2022-02-08 [1] CRAN (R 4.2.0)
 dtplyr      * 1.2.1   2022-01-19 [1] CRAN (R 4.2.0)
 espnscrapeR * 0.6.5   2022-04-26 [1] Github (jthomasmock/espnscrapeR@084ce80)
 forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2   2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.2.0)
 tictoc      * 1.0.1   2021-04-19 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0   2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     tidyverse data cleaning joins https://themockup.blog/posts/2021-02-13-joins-vs-casewhen-speed-and-memory-tradeoffs/index.html Sat, 13 Feb 2021 06:00:00 GMT     Removing image backgrounds with magick Thomas Mock https://themockup.blog/posts/2021-01-28-removing-image-backgrounds-with-magick/index.html

    The Problem

    Colin Welsh reached out on Twitter asking about removing the background from player headshots for use in dark-themed table. He had a bunch of player headshots for the NHL, but they had a white background which he wanted to remove and then embed the headshots in gt.

    He thought that magick could be used to remove the background, and let’s see what we can do!

    If you missed my last blogpost, it has some more details on the {magick} package. In short, magick is an R wrapper around the ImageMagick library that is used for image processing.

    For another fantastic longer form blogpost, make sure to check out Deemah’s blogpost on Miracles with magick! I adapted some of his examples for the logos at the end. He pointed out rightfully so, that simply replacing ALL white with transparent can have some negative effects (this REALLy is a problem with logos). I’ve gone ahead and rebuilt the examples with that in mind.

    Load the Data

    We’ll load our libraries and pull in the data of interest, there are a lot of columns but I’ll limit it to a subset later on.

    library(tidyverse)
library(gt)
library(magick)

skater_game_score <- read_csv("hockey_data.csv")
    Rows: 50 Columns: 26
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (15): player, team.x, num_last_first, player_team_num, position, positio...
dbl (11): games, g, a1, a2, pts, gs_tot, gs_avg, season, jersey_number, year...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
    glimpse(skater_game_score)
    Rows: 50
Columns: 26
$ player          <chr> "CONNOR.MCDAVID", "NATHAN.MACKINNON", "MIKKO.RANTANEN"…
$ games           <dbl> 7, 6, 6, 6, 6, 7, 6, 6, 7, 7, 6, 6, 6, 6, 6, 5, 7, 5, …
$ g               <dbl> 4, 2, 5, 1, 5, 4, 3, 3, 4, 3, 0, 1, 3, 2, 4, 3, 2, 3, …
$ a1              <dbl> 4, 5, 1, 6, 1, 6, 1, 1, 2, 4, 2, 4, 2, 4, 1, 2, 3, 3, …
$ a2              <dbl> 2, 1, 1, 3, 2, 0, 2, 3, 1, 2, 5, 1, 4, 2, 2, 1, 2, 1, …
$ pts             <dbl> 10, 8, 7, 10, 8, 10, 6, 7, 7, 9, 7, 6, 9, 8, 7, 6, 7, …
$ gs_tot          <dbl> 11.855, 10.630, 10.020, 9.785, 9.690, 9.135, 8.785, 8.…
$ team.x          <chr> "EDM", "COL", "COL", "L.A", "MTL", "TOR", "TOR", "PIT"…
$ gs_avg          <dbl> 1.5067857, 1.7733333, 1.8225000, 1.7329167, 1.3850000,…
$ num_last_first  <chr> "97 MCDAVID, CONNOR", "29 MACKINNON, NATHAN", "96 RANT…
$ player_team_num <chr> "EDM97", "COL29", "COL96", "L.A11", "MTL73", "TOR16", …
$ position        <chr> "C", "C", "R", "C", "C", "C", "C", "C", "C", "C", "C",…
$ position_type   <chr> "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F",…
$ season          <dbl> 20202021, 20202021, 20202021, 20202021, 20202021, 2020…
$ session         <chr> "R", "R", "R", "R", "R", "R", "R", "R", "R", "R", "R",…
$ team.y          <chr> "EDM", "COL", "COL", "L.A", "MTL", "TOR", "TOR", "PIT"…
$ jersey_number   <dbl> 97, 29, 96, 11, 73, 16, 34, 87, 91, 29, 9, 4, 55, 61, …
$ first_name      <chr> "CONNOR", "NATHAN", "MIKKO", "ANZE", "TYLER", "MITCHEL…
$ last_name       <chr> "MCDAVID", "MACKINNON", "RANTANEN", "KOPITAR", "TOFFOL…
$ year            <dbl> 20202021, 20202021, 20202021, 20202021, 20202021, 2020…
$ full_name       <chr> "CONNOR MCDAVID", "NATHAN MACKINNON", "MIKKO RANTANEN"…
$ team_name       <chr> "Oilers", "Avalanche", "Avalanche", "Kings", "Canadien…
$ player_id       <dbl> 8478402, 8477492, 8478420, 8471685, 8475726, 8478483, …
$ logo            <chr> "http://content.sportslogos.net/logos/1/12/thumbs/1227…
$ headshot_url    <chr> "https://cms.nhl.bamgrid.com/images/headshots/current/…
$ action_shot_url <chr> "https://cms.nhl.bamgrid.com/images/actionshots/847840…

    Initial Table

    We can quickly convert this into gt table like so. Look pretty good, and the player headshots look fine as well.

    skater_game_score %>% 
  slice(1:10) %>%
  select(player, headshot_url, games:pts)%>% 
  gt() %>% 
  text_transform(
    locations = cells_body(vars(headshot_url)),
    fn = function(x){
      web_image(url = x)
    }
  )
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    player headshot_url games g a1 a2 pts
    CONNOR.MCDAVID 7 4 4 2 10
    NATHAN.MACKINNON 6 2 5 1 8
    MIKKO.RANTANEN 6 5 1 1 7
    ANZE.KOPITAR 6 1 6 3 10
    TYLER.TOFFOLI 6 5 1 2 8
    MITCH.MARNER 7 4 6 0 10
    AUSTON.MATTHEWS 6 3 1 2 6
    SIDNEY.CROSBY 6 3 1 3 7
    JOHN.TAVARES 7 4 2 1 7
    LEON.DRAISAITL 7 3 4 2 9

    The real problem here is that Colin was interested in using a black background for his table. Let’s see what that looks like. Here we can see that the player background adds a lot of unnecessary white to our otherwise nice looking black table.

    skater_game_score %>% 
  slice(1:10) %>%
  select(player, headshot_url, games:pts)%>% 
  gt() %>% 
  text_transform(
    locations = cells_body(vars(headshot_url)),
    fn = function(x){
      web_image(url = x)
    }
  ) %>% 
  tab_options(
    table.background.color = "black"
  )
    Warning: `columns = vars(...)` has been deprecated in gt 0.3.0:
* please use `columns = c(...)` instead
    player headshot_url games g a1 a2 pts
    CONNOR.MCDAVID 7 4 4 2 10
    NATHAN.MACKINNON 6 2 5 1 8
    MIKKO.RANTANEN 6 5 1 1 7
    ANZE.KOPITAR 6 1 6 3 10
    TYLER.TOFFOLI 6 5 1 2 8
    MITCH.MARNER 7 4 6 0 10
    AUSTON.MATTHEWS 6 3 1 2 6
    SIDNEY.CROSBY 6 3 1 3 7
    JOHN.TAVARES 7 4 2 1 7
    LEON.DRAISAITL 7 3 4 2 9

    Clean the images

    So our goal is to remove the white background and turn it transparent. There are 3 steps here:

    • Extract the image name
    • Optionally trim extra whitespace from the images
    • Turn the background white into transparent and save to disk

    Extract the image name

    We have a url that points at a player headshot. An example is:

    https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478402.jpg

    Which returns:

    Now, we only need the image name, not the URL. We can remove the extra “fluff” around the image name with regex + stringr::str_replace() or base::gsub().

    Now… if you’re anything like me, the below regex kind of looks like gibberish.

    ex_url <- "https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478402.jpg"

str_replace(ex_url, ".*[/]([^.]+)[.].*", "\\1")
    [1] "8478402"

    If you want to see some explanations for the regex, see the details tag below.

    Fun aside on regex

    This regex code: .*[/]([^.]+)[.].* gives us the following explanation at regex101.com

    • .* matches any character (except for line terminators)
      • * Quantifier — Matches between zero and unlimited times, as many times as possible, giving back as needed (greedy)
      • This basically finds everything up to the next portion
    • Match a single character present in the list below [/]
      • / matches the character / literally (case sensitive)
      • This finds a literal / and with the previous code (.*) all the stuff before it
    • 1st Capturing Group ([^.]+)
      • Match a single character not present in the list below [^.]+
        • + Quantifier — Matches between one and unlimited times, as many times as possible, giving back as needed (greedy)
        • . matches the character . literally (case sensitive)
      • A capture group allows us to reference this portion later (with \\1)
    • Match a single character present in the list below [.]
      • . matches the character . literally (case sensitive)
      • Find the . and then anything after the .
    • .* matches any character (except for line terminators)
      • * Quantifier — Matches between zero and unlimited times, as many times as possible, giving back as needed (greedy)

    We can see the capture group via str_match(), this will separate out the full match from the capture group.

    str_match(ex_url, ".*[/]([^.]+)[.].*")
         [,1]                                                                      
[1,] "https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478402.jpg"
     [,2]     
[1,] "8478402"

    Note that this could actually be much simpler to fix…just remove the static portions!

    ex_url %>% 
  str_remove("https://cms.nhl.bamgrid.com/images/headshots/current/168x168/") %>% 
  str_remove(".jpg")
    [1] "8478402"

    Trim the image and remove background

    We can now trim the image if necessary and turn the background “white” into transparent. Note we’re using image_fill() here instead of simply image_background() which would replace ALL the white in the image with transparency.

    • fuzz: relative color distance (value between 0 and 100) to be considered similar in the filling algorithm
    • refcolor = "white": the reference color that we’re replacing
    • color = "transparent": the replacement of white with transparent
    • point = "+1+1": The location where we start “filling” or flooding the image with replacement, where '1+1' indicates 1 pixel in from the top left
    # clean image and write to disk
clean_img_transparent <- function(img_url, trim = FALSE){
  
  # find the name of the img and extract it
  img_name <- str_replace(img_url, ".*[/]([^.]+)[.].*", "\\1")
  
  # some images need to be trimmed
  trim_area <- if(isTRUE(trim)){
    geometry_area(0, 0, 0, 10)
  } else {
    geometry_area(0, 0, 0, 0)
  }
  
  img_url %>% 
    image_read() %>% 
    image_crop(geometry = trim_area) %>% 
    image_fill(
      color = "transparent", 
      refcolor = "white", 
      fuzz = 4,
      point = "+1+1" # start at top left 1 pixel in
      ) 
}

    We can test the function with and without trimming, then stack them next to each other. I will use image_ggplot() to “show” the image in this RMarkdown blog, but interactively you could remove that as it prints to the R Console.

    img_ex <- clean_img_transparent(ex_url)
img_ex_trim <- clean_img_transparent(ex_url, trim = TRUE) 

c(img_ex, img_ex_trim) %>% 
  image_append() %>% 
  image_ggplot()

    This looks great, but the for the last portion we’ll need to write to disk. It doesn’t really “look” any different, but the whitepspace around the player image is now “transparent”.

    We could see this more clearly by replacing with a different color. Note that again if you just used image_transparent() as I did in a previous version of this post you’d “lose” some white details in the player’s jersey/sweater.

    ex_url %>% 
    image_read() %>% 
    image_crop(geometry = geometry_area(0, 0, 0, 10)) %>% 
    image_fill(
      color = "green", 
      refcolor = "white", 
      fuzz = 4,
      point = "+1+1" # start at top left 1 pixel in
      ) %>% 
  image_ggplot()

    Write to disk

    We can now use image_write() to write the image to disk so it can be used with gt::local_image(). We’ll add that to our function.

    # clean image and write to disk
clean_img_transparent <- function(img_url, trim = FALSE){
  
  # find the name of the img and extract it
  img_name <- str_replace(img_url, ".*[/]([^.]+)[.].*", "\\1")
  
  # some images need to be trimmed
  trim_area <- if(isTRUE(trim)){
    geometry_area(0, 0, 0, 10)
  } else {
    geometry_area(0, 0, 0, 0)
  }
  
  img_url %>% 
    image_read() %>% 
    image_crop(geometry = trim_area) %>% 
    image_fill(
      color = "transparent", 
      refcolor = "white", 
      fuzz = 4,
      point = "+1+1"
      ) %>% 
    image_write(path = paste0(img_name, ".png"), format = "png")
}

    All together now

    Now we need to get the top 10 players, grab the headshot_url column, and then remove any missing images (na.jpg), trim the first image, and then write out to disk.

    skater_game_score <- read_csv("hockey_data.csv")
    Rows: 50 Columns: 26
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (15): player, team.x, num_last_first, player_team_num, position, positio...
dbl (11): games, g, a1, a2, pts, gs_tot, gs_avg, season, jersey_number, year...

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
    skater_include <- skater_game_score %>% 
  slice(1:10) %>%
  select(img_url = headshot_url) %>% 
  filter(str_detect(img_url, pattern = "NA.jpg", negate = TRUE)) %>% 
  mutate(trim = c(TRUE, rep(FALSE, 9)))

skater_include
    # A tibble: 10 × 2
   img_url                                                                 trim 
   <chr>                                                                   <lgl>
 1 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478402.j… TRUE 
 2 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8477492.j… FALSE
 3 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478420.j… FALSE
 4 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471685.j… FALSE
 5 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8475726.j… FALSE
 6 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8478483.j… FALSE
 7 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8479318.j… FALSE
 8 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8471675.j… FALSE
 9 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8475166.j… FALSE
10 https://cms.nhl.bamgrid.com/images/headshots/current/168x168/8477934.j… FALSE

    I’ll use pwalk() to pass the urls + trim argument to clean_img_transparent() for each of the combos.

    skater_include%>% 
  pwalk(clean_img_transparent)

    We can then read them back in and apply to a gt table, and boom we’re done!

    skater_game_score %>% 
  slice(1:10) %>%
  mutate(
    img_name = str_replace(headshot_url, ".*[/]([^.]+)[.].*", "\\1"),
    img_name = paste0(img_name, ".png"),
    img_name = map(img_name, local_image),
    img_name = map(img_name, ~html(as.character(.x)))
    ) %>% 
  select(player, img_name, games:pts) %>% 
  gt() %>% 
  tab_options(
    table.background.color = "black"
  )
    player img_name games g a1 a2 pts
    CONNOR.MCDAVID 7 4 4 2 10
    NATHAN.MACKINNON 6 2 5 1 8
    MIKKO.RANTANEN 6 5 1 1 7
    ANZE.KOPITAR 6 1 6 3 10
    TYLER.TOFFOLI 6 5 1 2 8
    MITCH.MARNER 7 4 6 0 10
    AUSTON.MATTHEWS 6 3 1 2 6
    SIDNEY.CROSBY 6 3 1 3 7
    JOHN.TAVARES 7 4 2 1 7
    LEON.DRAISAITL 7 3 4 2 9

    What about the logos?

    Now, the logos present another problem, they have large whitespace areas INSIDE the logos themselves… so if you were to apply a global transparency they would end up transparent INSIDE the logos where they should be white.

    Again, for another fantastic longer form blogpost, make sure to check out Deemah’s blogpost on Miracles with magick! I looked through some of his examples, although I used a slightly different workflow here for the logos. Another ImageMagick proper blogpost from Nate Murray was also very useful.

    So here, we’ll need to convert some of our code, but it will still turn out pretty good! Again please note, that I’m using image_ggplot() just to show it in the blogpost, and interactively you can just return the output to the RStudio viewer.

    Logo Fill

    We can use a logo with a lot of whitespace, to play around with.

    logo_url  <- "http://content.sportslogos.net/logos/1/16/thumbs/124.gif"                     

raw_logo <- logo_url %>%
  image_read() 

raw_logo %>%
  image_ggplot()

    For our steps we’re going to fill (basically flood) in the white space around the logo with green. Now because some logos (like the Avalanche) have areas that can’t get flooded with color in one path, I’m going to flood at each corner (top left, top right, bottom left, bottom right). For our real usage, we’re going to convert this “green” space to transparent instead.

    img_filled <- raw_logo %>% 
    image_fill("green", "+1+1", fuzz = 50, refcolor = "white") %>% 
    image_fill("green", "+140+1", fuzz = 50, refcolor = "white") %>% 
    image_fill("green", "+1+99", fuzz = 50, refcolor = "white") %>% 
    image_fill("green", "+140+99", fuzz = 50, refcolor = "white")

img_filled %>% 
  image_ggplot()

    img_filled <- raw_logo %>% 
    image_fill("transparent", "+1+1", fuzz = 50, refcolor = "white") %>% 
    image_fill("transparent", "+140+1", fuzz = 50, refcolor = "white") %>% 
    image_fill("transparent", "+1+99", fuzz = 50, refcolor = "white") %>% 
    image_fill("transparent", "+140+99", fuzz = 50, refcolor = "white")

    Logo edges and mask

    Now that we have a transparency around the logo, we can take that ‘opacity’ channel and extract everything but that.

    img_filled %>% 
    image_channel("Opacity") %>% 
    image_convert(matte=FALSE) %>% 
  image_ggplot()

    Now to create a proper “mask” that we can apply to the image, we can negate this and apply a gentle blur to make the edges not as “sharp” against the background.

    logo_mask <- img_filled %>% 
    image_channel("Opacity") %>% 
    image_convert(matte=FALSE) %>% 
    image_negate() %>% 
    image_blur()

logo_mask %>% 
  image_ggplot()

    This looks great as a mask! Note, that you can’t really “see” the mask here since it’s really just affecting the whitespace around the logo.

    image_composite(raw_logo, logo_mask, operator = "CopyOpacity") %>% 
  image_ggplot()

    Function applied

    We can convert this to a function just like we did above. We’re getting the name, then reading in the image from a url, applying our fills, converting to transparent, flipping the image as a mask, and then applying our blur. Once we apply the mask we’ll write it back to disk.

    clean_logo_transparent <- function(img_url) {
  
  # find the name of the img and extract it
  img_name <- str_replace(img_url, ".*[/]([^.]+)[.].*", "\\1")

  raw_img <- img_url %>%
    image_read() %>% 
    image_convert("PNG")
  
  img_mask <- raw_img  %>% 
    image_fill("transparent", "+1+1", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+1+99", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+140+1", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+140+99", fuzz = 2, refcolor = "white") %>% 
    image_channel("Opacity") %>%
    image_convert(matte=FALSE) %>%
    image_negate() %>%
    image_blur()
  
  
  image_composite(raw_img, img_mask, operator = "CopyOpacity") %>%
    image_write(paste0(img_name, ".png"))
}

    Once again, we can use purrr::pwalk() to write out the images to disk in bulk.

    skater_game_score %>% 
  slice(1:10) %>%
  select(img_url = logo) %>% 
  filter(str_detect(img_url, pattern = "NA.jpg", negate = TRUE)) %>% 
  pwalk(clean_logo_transparent)

    Put in a table

    Our code here is again just a repeat of what we did above. This turns out remarkably nice!

    skater_game_score %>% 
  slice(1:10) %>%
  mutate(
    img_name = str_replace(logo, ".*[/]([^.]+)[.].*", "\\1"),
    img_name = paste0(img_name, ".png"),
    img_name = map(img_name, local_image),
    img_name = map(img_name, ~html(as.character(.x)))
  ) %>% 
  select(player, img_name, games:pts) %>% 
  gt() %>% 
  tab_options(
    table.background.color = "black"
  )
    player img_name games g a1 a2 pts
    CONNOR.MCDAVID 7 4 4 2 10
    NATHAN.MACKINNON 6 2 5 1 8
    MIKKO.RANTANEN 6 5 1 1 7
    ANZE.KOPITAR 6 1 6 3 10
    TYLER.TOFFOLI 6 5 1 2 8
    MITCH.MARNER 7 4 6 0 10
    AUSTON.MATTHEWS 6 3 1 2 6
    SIDNEY.CROSBY 6 3 1 3 7
    JOHN.TAVARES 7 4 2 1 7
    LEON.DRAISAITL 7 3 4 2 9

    Logos without Mask

    OK so one more spoiler, we don’t HAVE to create a mask, but it could be useful in the future! We can just flood the area with transparency and write it out.

    Still fun to play around with various techniques!

    clean_logo_transparent <- function(img_url) {
  
  # find the name of the img and extract it
  img_name <- str_replace(img_url, ".*[/]([^.]+)[.].*", "\\1")

  raw_img <- img_url %>%
    image_read() %>% 
    image_convert("PNG")
  
  img_out <- raw_img  %>% 
    image_fill("transparent", "+1+1", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+1+99", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+140+1", fuzz = 2, refcolor = "white") %>% 
    image_fill("transparent", "+140+99", fuzz = 2, refcolor = "white")
  
  
  img_out %>% 
    image_write(paste0(img_name, ".png"))
}

    Once again, we can use purrr::pwalk() to write out the images to disk in bulk.

    skater_game_score %>% 
  slice(1:10) %>%
  select(img_url = logo) %>% 
  filter(str_detect(img_url, pattern = "NA.jpg", negate = TRUE)) %>% 
  pwalk(clean_logo_transparent)

    Put in a table

    Our code here is again just a repeat of what we did above. This turns out remarkably nice!

    skater_game_score %>% 
  slice(1:10) %>%
  mutate(
    img_name = str_replace(logo, ".*[/]([^.]+)[.].*", "\\1"),
    img_name = paste0(img_name, ".png"),
    img_name = map(img_name, local_image),
    img_name = map(img_name, ~html(as.character(.x)))
  ) %>% 
  select(player, img_name, games:pts) %>% 
  gt() %>% 
  tab_options(
    table.background.color = "black"
  )
    player img_name games g a1 a2 pts
    CONNOR.MCDAVID 7 4 4 2 10
    NATHAN.MACKINNON 6 2 5 1 8
    MIKKO.RANTANEN 6 5 1 1 7
    ANZE.KOPITAR 6 1 6 3 10
    TYLER.TOFFOLI 6 5 1 2 8
    MITCH.MARNER 7 4 6 0 10
    AUSTON.MATTHEWS 6 3 1 2 6
    SIDNEY.CROSBY 6 3 1 3 7
    JOHN.TAVARES 7 4 2 1 7
    LEON.DRAISAITL 7 3 4 2 9

    Thanks to Colin for sharing this problem, and for Deemah pointing me to his blogpost!

    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version    date (UTC) lib source
 dplyr       * 1.0.8      2022-02-08 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1      2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5      2021-06-25 [1] CRAN (R 4.2.0)
 gt          * 0.5.0.9000 2022-04-27 [1] Github (rstudio/gt@0d4c83d)
 magick      * 2.7.3      2021-08-18 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4      2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2      2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2      2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0      2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6      2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0      2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1      2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     magick tables https://themockup.blog/posts/2021-01-28-removing-image-backgrounds-with-magick/index.html Thu, 28 Jan 2021 06:00:00 GMT     Reading tables from images with magick Thomas Mock https://themockup.blog/posts/2021-01-18-reading-tables-from-images-with-magick/index.html

    ImageMagick

    ImageMagick is a robust and comprehensive open-source image processing library, and per the official docs:

    Use ImageMagick® to create, edit, compose, or convert bitmap images. It can read and write images in a variety of formats (over 200) including PNG, JPEG, GIF, HEIC, TIFF, DPX, EXR, WebP, Postscript, PDF, and SVG. ImageMagick can resize, flip, mirror, rotate, distort, shear and transform images, adjust image colors, apply various special effects, or draw text, lines, polygons, ellipses and Bézier curves.

    While you can use it from various APIs, tools or CLIs, one of the easiest ways for R users to get started is with the R wrapper by ROpenSci’s Jeroen Ooms called magick. This package provides a large set of pipe-friendly functions allowing for interactive editing and testing.

    I’ve written briefly about magick before, specifically in using it to add logos to final ggplot2 images, but today will be a different use-case, namely using magick to read data embedded in images.

    Another note is that while the docs for ImageMagick proper and the magick R wrapper are very good, ImageMagick is an entire piece of software. This means that there is an amazing breadth of applications, knowledge, and tricks to apply. I think of it a lot like regex, where it’s very useful but for many applications we only scratch the surface. For a nice “cookbook” for using ImageMagick, check out this resource. It’s a “legacy” guide, but many of the examples can be converted to magick in R or from the CLI itself.

    The problem

    There are many times where someone shares data as an image, whether intentionally due to software constraints (ie Twitter) or as a result of not understanding the implications (image inside a PDF or in a Word Doc). xkcd.com jokingly refers to this as .norm or as the Normal File Format. While it’s far from ideal or a real file format, it’s all too common to see data as images in the “wild”. I’ll be using some examples from Twitter images and extracting the raw data from these. There are multiple levels of difficulty, namely that screenshots on Twitter are not uniform, often of relatively low quality (ie DPI), and contain additional “decoration” like colors or grid-lines. We’ll do our best to make it work!

    https://xkcd.com/2116/

    Example one is from Seth Walder, who was kind enough to share the raw data for ESPN’s “Sacks created” stat. Given that it was a quality image, and there were 3 of them, I wanted to try OCR (optical character recognition)!

    Excel Screenshot

    So let’s get after it! We’ll need two packages, but I’ll also load tidyverse for the eventual analysis/plotting as well. Also, note that I adapted some of this from a StackOverflow post talking about extracting tables from images.

    library(tidyverse)
library(magick)
library(tesseract)

sack_url <- "https://pbs.twimg.com/media/ErtmQ1PXYAEUQoY?format=jpg&name=900x900"
raw_img <- image_read(sack_url)

    Now, while interactively you can just “print” the magick object and it will show up in the viewer pane, for this blog-post I’ll need to explicitly “show” it. I’ll call magick::image_ggplot(<img object>) to print it throughout the post.

    image_ggplot(raw_img)

    This looks like a relatively clean image, the only major problems being that it’s relatively low-DPI, it has some symbols (team logos), and it has alternating colors along with gridlines (which can mess with the OCR). We can try a “naive” OCR as seen below.

    raw_img %>% 
  image_crop(geometry_area(0, 0, 110, 45)) %>% 
  ocr()
    [1] "Aaron Donald (DE - LA) 19.0,\nMyles Garrett (DE - CLE) 16.5\nTJ. Watt (OLB - PIT) 14.5\nKhalil Mack (OLB - CHI) 13.0\nJustin Houston (DE - IND) 12.0\nEmmanuel Ogbah (DE - MIA) 11.0\nCarl Lawson (DE - CIN) 10.5\nBrandon Graham (DE - PHI) 10.0\nDeMarcus Lawrence (DE - DAL) 10.0\nYannick Ngakoue (DE - BAL) 10.0,\nMontez Sweat (DE - WAS) 10.0\nCarlos’ Dunlap (DE - SEA) 9.0\nCameron Jordan (DE - NO) 9.0\nKerry Hyder (DE - SF) 9.0\nSermierce (OLB -TB) 9.0\nStephon Tuitt (DE - PIT) 9.0\n"

    Ultimately, it does pretty well! But you can see that there are some “misses” if we look closely. Let’s make it easier on the OCR engine by cleaning up the image for higher contrast.

    Remove the background and grid

    We’ll first start by converting the color image to greyscale via image_quantize().

    raw_img %>% 
  image_quantize(colorspace = "gray") %>% 
  image_ggplot()

    We can remove the grid by converting “white” colors to transparent, and allowing for some “fuzzy” approximation of colors that are close to white or “touching”. There’s a lot more to fuzz in that it’s the “relative color distance (value between 0 and 100) to be considered similar in the filling algorithm”, but I’m not a color space expert by any means.

    Below we have an example of fuzz = 0, fuzz = 20, fuzz = 40, fuzz = 60. Each increase does remove a bit of “noise”, but is also reducing the quality of the “signal”.

    Code for Combo 
    fuzz_fun <- function(fuzz){
  raw_img %>% 
    image_quantize(colorspace = "gray") %>% 
    image_transparent(color = "white", fuzz=fuzz) %>% 
    image_background("white") %>% 
    image_crop(geometry_area(0, 150,110, 45))
}

fuzz_fun(20)

    combo_fuzz <- c(
  fuzz_fun(0),
  fuzz_fun(20),
  fuzz_fun(40),
  fuzz_fun(60)
) %>% 
  image_append(stack = TRUE) 
    image_ggplot(combo_fuzz)

    In practical terms, we are balancing increase fuzz to remove unnecessary components (eg grid lines) while leaving the actual characters there. Increasing fuzz will remove more “noise” but will eventually start to eat away at the actual “signal” as well.

    no_grid <- raw_img %>% 
  image_quantize(colorspace = "gray") %>% 
   image_transparent(color = "white", fuzz=20) %>% 
   image_background("white") 

image_ggplot(no_grid)

    So we’ve taken white and converted it to transparent, and then set the image background back to “white”.

    You can also remove continuous lines with a “thinning” method. We can use image_morphology() coupled with a rectangular kernel to remove straight horizontal lines for the most part. You can read Rectangle:20x1 as finding rectangles about 20 pixels wide x 1 pixel high. We couple this with image_negate() as otherwise it will focus on the characters.

    So we’ll negate > thin > negate to get back to our white background sans grid-lines. While this works pretty well, it’s not always necessary for the OCR. I did want to show it as it can be helpful in some situations.

    no_grid %>%
  image_negate() %>% # negate
  image_morphology(method = "Thinning", kernel = "Rectangle:20x1") %>%
  image_negate() %>% # back to white
  image_ggplot()

    This worked pretty well! However, remember that we don’t always have to do this. We’ll also still need to crop the image to remove the team logos as they can’t be parsed as text.

    Crop the image

    geometry_area() is used in various functions to indicate the starting width/heights and then the offset, all in pixels.

    geometry_area(width = NULL, height = NULL, x_off = 0, y_off = 0)

    Note that you’re always “starting” from the top and left sides, and we’re passing the geometry_area() to image_crop to crop the image itself.

    # remove the top 20 pixels
no_grid %>% 
  image_crop(geometry_area(0, 0,110, 45)) %>% 
  image_ggplot()

    So this techniques can be used to cut out specific portions of an image, which is another useful technique for tricky columns. For now, let’s hope we can use ALL the data together.

    no_grid_crop <- no_grid %>% 
  image_crop(geometry_area(0, 0,110, 45))

no_grid_crop %>% 
  image_ggplot()

    Try OCR

    We can try our first OCR now! Note that image_ocr() is just calling tesseract behind the scenes.

    no_grid_crop %>% 
  image_ocr()
    [1] "Aaron Donald (DE - LA) 19.0\nMyles Garrett (DE - CLE) 16.5\nT.J. Watt (OLB - PIT) 14.5\nKhalil Mack (OLB - CHI) 13.0\nJustin Houston (DE - IND) 12.0\nEmmanuel Ogbah (DE - MIA) 11.0\nCarl Lawson (DE - CIN) 10.5\nBrandon Graham (DE - PHI) 10.0\nDeMarcus Lawrence (DE - DAL) 10.0\nYannick Ngakoue (DE - BAL) 10.0\nMontez Sweat (DE - WAS) 10.0\nCarlos Dunlap (DE - SEA) 9.0\nCameron Jordan (DE - NO) 9.0\nKerry Hyder (DE - SF) 9.0\nShaquil Barrett (OLB - TB) 9.0\nStephon Tuitt (DE - PIT) 9.0\nRomeo Okwara (DE - DET) 9.0\n"

    This did a great job, but what about this raw text string we ended up with? Also note that image_ocr() is just a wrapper around tesseract::ocr().

    Let’s go into tesseract proper to try some robust things out!

    I’m going to focus on one numeric “column” first to keep things relatively simpler. We’ll use image_crop to grab the column of interest, then we’ll call tesseract::ocr() on it. We can provide some options to the engine, namely that we’re expecting only spaces, numbers, or a decimal. This will explicitly prevent 5 being converted to S for example. It does really well here!

    num_only <- tesseract::tesseract(
  options = list(tessedit_char_whitelist = c(".0123456789 "))
  )

no_grid %>% 
  image_quantize(colorspace = 'gray') %>% 
  image_threshold() %>% 
  image_crop(geometry_area(100, 0, 600, 40)) %>% 
  ocr(engine = num_only) 
    [1] "19.0\n16.5\n14.5\n13.0\n12.0\n11.0\n10.5\n10.0\n10.0\n10.0\n10.0\n9.0\n9.0\n9.0\n9.0\n9.0\n9.0\n"

    But we have text, numbers, and some symbols like (.

    So let’s pass those as limitations to the engine, and then we can take the raw text and turn it into a dataframe/tibble.

    combo <- tesseract::tesseract(
    options = list(
      tessedit_char_whitelist = paste0(
        c(letters, LETTERS, " ", ".0123456789 (-)"), collapse = "")
      )
  )

raw_text <- no_grid %>%
  image_quantize(colorspace = "gray") %>%
  image_transparent("white", fuzz = 22) %>%
  image_background("white") %>%
  image_threshold() %>%
  image_crop(geometry_area(0, 0, 110, 45)) %>%  
  ocr(engine = combo)

    Make a Tibble

    raw_text
    [1] "Aaron Donald (DE - LA) 19.0\nMyles Garrett (DE - CLE) 16.5\nT.J. Watt (OLB - PIT) 14.5\nKhalil Mack (OLB - CHI) 13.0\nJustin Houston (DE - IND) 12.0\nEmmanuel Ogbah (DE - MIA) 11.0\nCarl Lawson (DE - CIN) 10.5\nBrandon Graham (DE - PHI) 10.0\nDeMarcus Lawrence (DE - DAL) 10.0\nYannick Ngakoue (DE - BAL) 10.0\nMontez Sweat (DE - WAS) 10.0\nCarlos Dunlap (DE - SEA) 9.0\nCameron Jordan (DE - NO) 9.0\nKerry Hyder (DE - SF) 9.0\nShaquil Barrett (OLB - TB) 9.0\nStephon Tuitt (DE - PIT) 9.0\nRomeo Okwara (DE - DET) 9.0\n"

    This looks pretty much perfect! We just now need to get it into a dataframe. We can accomplish this by splitting on each new row (\n) and then adding that as a column in a tibble.

    raw_tibble <- raw_text %>% 
  str_split(pattern = "\n") %>% 
  unlist() %>%
  tibble(data = .) 

raw_tibble
    # A tibble: 18 × 1
   data                               
   <chr>                              
 1 "Aaron Donald (DE - LA) 19.0"      
 2 "Myles Garrett (DE - CLE) 16.5"    
 3 "T.J. Watt (OLB - PIT) 14.5"       
 4 "Khalil Mack (OLB - CHI) 13.0"     
 5 "Justin Houston (DE - IND) 12.0"   
 6 "Emmanuel Ogbah (DE - MIA) 11.0"   
 7 "Carl Lawson (DE - CIN) 10.5"      
 8 "Brandon Graham (DE - PHI) 10.0"   
 9 "DeMarcus Lawrence (DE - DAL) 10.0"
10 "Yannick Ngakoue (DE - BAL) 10.0"  
11 "Montez Sweat (DE - WAS) 10.0"     
12 "Carlos Dunlap (DE - SEA) 9.0"     
13 "Cameron Jordan (DE - NO) 9.0"     
14 "Kerry Hyder (DE - SF) 9.0"        
15 "Shaquil Barrett (OLB - TB) 9.0"   
16 "Stephon Tuitt (DE - PIT) 9.0"     
17 "Romeo Okwara (DE - DET) 9.0"      
18 ""

    Now we have essentially perfect data at this point, we just need to separate out our columns and drop the row without any data.

    Tidy the Tibble

    We’ll first drop any rows where the character string is < 2. We can then use tidyr::separate() to separate one column into 4 new columns as player, position, team, and sacks. There are multiple separators, which for the example seen T.J. Watt (OLB - PIT) 14.5 are:

    • T.J.Watt then ( represented as “\\(”
    • OLB then - represented as “-”
    • PIT then ) represented as “\\)”
    • which leaves us with 14.5 at the end

    We have to “escape” the parentheses with \\ so that regex can understand them. The | inside the sep arguments tell the regex to separate at a match of a white-space + parentheses OR white-space + dash OR parentheses + white-space.

    As our last step, we’ll convert sacks to a double column, and then BOOM!

    raw_tibble %>% 
  filter(str_length(data) >= 2)  %>%
  separate(
    data, 
    into = c("player", "position", "team", "sacks"), 
    sep = c(" \\(| - |\\) ")
    ) %>% 
  mutate(sacks = as.double(sacks))
    # A tibble: 17 × 4
   player            position team  sacks
   <chr>             <chr>    <chr> <dbl>
 1 Aaron Donald      DE       LA     19  
 2 Myles Garrett     DE       CLE    16.5
 3 T.J. Watt         OLB      PIT    14.5
 4 Khalil Mack       OLB      CHI    13  
 5 Justin Houston    DE       IND    12  
 6 Emmanuel Ogbah    DE       MIA    11  
 7 Carl Lawson       DE       CIN    10.5
 8 Brandon Graham    DE       PHI    10  
 9 DeMarcus Lawrence DE       DAL    10  
10 Yannick Ngakoue   DE       BAL    10  
11 Montez Sweat      DE       WAS    10  
12 Carlos Dunlap     DE       SEA     9  
13 Cameron Jordan    DE       NO      9  
14 Kerry Hyder       DE       SF      9  
15 Shaquil Barrett   OLB      TB      9  
16 Stephon Tuitt     DE       PIT     9  
17 Romeo Okwara      DE       DET     9

    Write it as a Function

    We can wrap this process into a reusable function, and then call it on our 3 images of interest!

    scrape_fun <- function(url_in, crop_left, crop_top){
  raw_img <- image_read(url_in) %>% 
    image_quantize(colorspace = 'gray') %>%
    image_transparent("white", fuzz=22) %>% 
    image_background("white") %>%
    image_threshold() %>% 
    image_crop(geometry_area(0, 0, crop_left, crop_top)) 
  
  image_ocr(raw_img) %>% 
    str_c() %>% 
    str_split(pattern = "\n") %>% 
    unlist() %>%
    tibble(data = .) %>% 
    filter(str_length(data) >= 2) %>% 
    separate(
      data, 
      into = c("player", "position", "team", "sacks"), 
      sep = c(" \\(| - |\\) ")
      ) %>% 
    mutate(sacks = as.double(sacks)) %>% 
    mutate(sacks = if_else(sacks >= 20, sacks/10, sacks))
}

    We can then call our new function! You may notice that I added a mutate above which protects against missing decimal places. Trey Hendrickson’s decimal place is apparently hard for the parser to “capture”.

    # output to tibble
cr_sacks <- tibble(
  url_in = c(
    "https://pbs.twimg.com/media/ErtmQ1PXYAEUQoY?format=jpg&name=900x900",
    "https://pbs.twimg.com/media/ErtmSLlXMAAvylA?format=jpg&name=900x900",
    "https://pbs.twimg.com/media/ErtmTUGW8AEZ6Cy?format=jpg&name=900x900"
    ),
  crop_left = c(110, 95, 95),
  crop_top = c(45, 5, 5)
) %>% 
  pmap_df(scrape_fun)

cr_sacks
    # A tibble: 46 × 4
   player            position team  sacks
   <chr>             <chr>    <chr> <dbl>
 1 Aaron Donald      DE       LA     19  
 2 Myles Garrett     DE       CLE    16.5
 3 T.J. Watt         OLB      PIT    14.5
 4 Khalil Mack       OLB      CHI    13  
 5 Justin Houston    DE       IND    12  
 6 Emmanuel Ogbah    DE       MIA    11  
 7 Carl Lawson       DE       CIN    10.5
 8 Brandon Graham    DE       PHI    10  
 9 DeMarcus Lawrence DE       DAL    10  
10 Yannick Ngakoue   DE       BAL    10  
# … with 36 more rows

    We can plot it just to be safe, and to see if everything “checks out”! We get a range we expected, and see that T.J. Watt and Aaron Donald create many more of their own sacks relative to their positions.

    cr_sacks %>% 
  mutate(position = if_else(position == "LB", "OLB", position)) %>% 
  ggplot(aes(x = sacks, y = position)) +
  ggridges::geom_density_ridges(quantile_lines = TRUE, quantiles = 2) +
  geom_point(
    data = filter(cr_sacks, player %in% c("Aaron Donald", "T.J. Watt")),
    size = 3
    ) +
  ggridges::theme_ridges() +
  theme(
    axis.text = element_text(size = 10),
    axis.title = element_text(size = 14),
    plot.title = element_text(size = 16),
    plot.caption = element_text(size = 10),
    panel.grid.minor = element_blank(),
    axis.title.x = element_text(hjust = 0)
    ) +
  labs(
    x = "\nCreated Sacks", y = "",
    title = "T.J. Watt and A. Donald are both outliers amongst their positions",
    subtitle = "Created Sacks by position",
    caption = "Data: ESPN | Plot: @thomas_mock"
    )
    Picking joint bandwidth of 1.05

    Example 2

    Example two is from Brian Burke, who was kind enough to share the raw data for NFL playoff leverage for week 17 as a screenshot. At the time, I manually copied these over to a dataframe, but Ben Baldwin asked if there was a “better” way. Image OCR (optical character recognition) is a potentially more reproducible way!

    Note that our process is almost identical to the previous example, but there are some considerations as the image is a bit more difficult to work with.

    Now, this image is more problematic for two main reasons.

    1. The image itself is much smaller, specifically about 60% smaller than our previous example and of low quality
    2. The fonts in use are worse (not monospaced and have serifs), and not bold

    This is going to be harder than before.

    Get the raw img

    burke <- "https://pbs.twimg.com/media/EpdF4fzW4AEeOvF?format=png&name=small"
raw_img <- image_read(burke)

    Now, again while interactively you can just “print” the magick object and it will show up in the RStudio viewer pane, for this blog-post I’ll need to explicitly “show” it. I’ll call magick::image_ggplot(<img object>) to print it throughout the post.

    image_ggplot(raw_img)

    This looks like a relatively clean image, the only major problems as mentioned above are that it’s very low-quality along with not ideal fonts, and it cuts off some of the data for team.

    Clean it up

    We can remove the grid by converting “white” colors to transparent, and allowing for some “fuzzy” approximation of colors that are close to white or “touching”. There’s a lot more to fuzz in that it’s the “relative color distance (value between 0 and 100) to be considered similar in the filling algorithm”, but I’m not a color space expert by any means.

    In practical terms, we are balancing increase fuzz to remove unnecessary components (eg grid lines) while leaving the actual characters there. Increasing fuzz will remove more “noise” but will eventually start to eat away at the actual “signal” as well.

    Below we have an example of fuzz = 0, fuzz = 20, fuzz = 50, fuzz = 70.

    So we’ve taken white and converted it to transparent, and then set the image background back to “white”.

    no_grid <- raw_img %>% 
   image_transparent(color = "white", fuzz=20) %>% 
   image_background("white") 

image_ggplot(no_grid)

    You can also remove continuous lines with a “thinning” method. We can use image_morphology() coupled with a rectangular kernel to remove straight horizontal lines for the most part. You can read Rectangle:20x1 as finding rectangles about 20 pixels wide x 1 pixel high. We couple this with image_negate() as otherwise it will focus on the characters.

    So we’ll negate > thin > negate to get back to our white background sans grid-lines.

    We can apply the thinning morph as seen below, flipping back and forth with image_negate().

    no_grid %>% 
  image_negate() %>%
  image_morphology(method = "Thinning", kernel = "Rectangle:20x1") %>% 
  image_negate() %>% 
  image_ggplot()

    This worked pretty well! However, because of the mis-alignment of the column labels and the columns themselves, I’m just going to trim the top off.

    Crop the image

    geometry_area() is used in various functions to indicate the starting width/heights and then the offset, all in pixels.

    geometry_area(width = NULL, height = NULL, x_off = 0, y_off = 0)

    Note that you’re always “starting” from the top and left sides, and we’re passing the geometry_area() to image_crop to crop the image itself.

    # remove the top 20 pixels
no_grid %>% 
  image_crop(geometry_area(0, 0, 0, 20)) %>% 
  image_ggplot()

    So this techniques can be used to cut out specific portions of an image, which is another useful technique for tricky columns. For now, let’s hope we can use ALL the data together.

    no_grid_crop <- no_grid %>% 
  image_crop(geometry_area(0, 0, 0, 20))

no_grid_crop %>% 
  image_ggplot()

    Try OCR

    We can try our first OCR now! Note that image_ocr() is just calling tesseract behind the scenes.

    no_grid_crop %>% 
  image_ocr()
    [1] "Bills 100 99.3 07\nPackers 100 100 0\nRams 100989 11\nChiefs 100 100 0\nSaints 100 100 0\nSeahawks 100 (97.7 23\nSteelers 100 100 0\nBuccaneer 99.5 92.6 69\nTitans 97.6 787 18.9\nColts 949 664 028.5,\nBrowns 946 0 «675 TA\nRavens 90.1 S18 38.3\nFootballT 88.6 583 303\nCardinals 65.7 (25.7 40\nDolphins 43.7 24 353\nGiants 413 100313\nBears 35.3 18 335\nVikings. 317 430 278\nRaiders 29.1 45 246\nEagles 18.3 340-149\n49ers 145 os 14\nPatriots 58 0 58\nCowboys 23 0 23\nLions 19 0 19\nPanthers oO. oO O41\n"

    This did a decent job, but I can already see some “problems”.

    The Rams row is “squished” together, the Browns have some letters instead of numbers, and the Ravens have a “S” instead of a 5.

    Let’s go into tesseract proper to try some robust things out!

    I’m going to focus on one “column” first to keep things relatively simpler. We’ll use image_crop to grab the column of interest, then we’ll call tesseract::ocr() on it. We can provide some options to the engine, namely that we’re expecting only spaces, numbers, or a decimal. This will explicitly prevent 5 being converted to S for example.

    num_only <- tesseract::tesseract(
  options = list(tessedit_char_whitelist = c(".0123456789 "))
  )
no_grid %>% 
  image_quantize(colorspace = 'gray') %>% 
  image_threshold() %>% 
  image_crop(geometry_area(80, 0, 80, 20)) %>% 
  ocr(engine = num_only) 
    [1] "100\n100\n100\n100\n100\n100\n100\n99.5\n97.6\n4.9\n94.6\n90.1\n88.6\n657\n48.7\n41.3\n35.3\n317\n29.1\n18.3\n14.5\n5.8\n2.3\n1.9\n01\n"

    I’m going to “plot” the data to show some areas where mistakes were still made. We know that 100 is the max, and that the values are ranked, and thus should be always decreasing. We have at least 5 examples where the data is missing a period which causes it to be scaled improperly (10x larger than reality).

    ocr_col1 <- no_grid %>%
  image_crop(geometry_area(80, 0, 80, 20)) %>%
  ocr(engine = num_only) %>%
  str_split(pattern = "\n") %>%
  unlist() %>%
  enframe() %>%
  mutate(value = as.double(value)) %>%
  filter(!is.na(value))

ocr_col1 %>%
  mutate(color = case_when(
    value > 100 ~ "red",
    value > lag(value) ~ "red",
    value > lag(value, n = 3) ~ "red",
    TRUE ~ "black"
  )) %>%
  ggplot(aes(x = name, y = value, color = color)) +
  geom_point(size = 3) +
  scale_color_identity()

    Again, due to the VERY low image quality (the original image is 72 DPI and only ~500 pixels high) we’re basically stuck with some of these manual steps. Regardless, we’ve got “better” data now that we’ve added our conversion logic. Those same 5 points now fall “accurately” into the appropriate range.

    ocr_col1 %>% 
  mutate(color = case_when(
    value > 100 ~ "red",
    value > lag(value) ~ "red",
    value > lag(value, n = 3) ~ "red",
    TRUE ~ "black"
  )) %>% 
  mutate(
    value = if_else(value > 100, value/10, value),
    value = if_else(name >= 22, value/10, value)
    ) %>% 
  ggplot(aes(x = name, y = value, color = color)) +
  geom_point(size = 3) +
  scale_color_identity()

    So we’ve apparently “fixed” this column!

    Create a function

    We’ll create a function so that we can split out each column, apply optimal characters or numeric to each and then recombine.

    img_ocr_fun <- function(trim_width, trim_start, char_num = TRUE) {
  
  num_only <- tesseract::tesseract(
    options = list(tessedit_char_whitelist = c(".0123456789 "))
  )

  combo <- tesseract::tesseract(
    options = list(
      tessedit_char_whitelist = paste0(
        c(letters, LETTERS, " ", ".0123456789 "), collapse = "")
      )
  )


  input_char <- if (isTRUE(char_num)) {
    num_only
  } else {
    combo
  }

  no_grid %>%
    image_crop(geometry_area(trim_width, 0, trim_start, 20)) %>%
    ocr(engine = input_char) %>%
    str_split(pattern = "\n") %>%
    unlist() %>%
    enframe() %>%
    select(-name) %>%
    filter(!is.na(value), str_length(value) > 0)
}

    We can “find” the columns by cropping specific areas. Note that I’ve “recombined” all of them with image_append() so that you can see that each section together completes the table.

    c(
  no_grid %>%
    image_crop(geometry_area(80, 0, 0, 20)),
  no_grid %>%
    image_crop(geometry_area(50, 0, 80, 20)),
  no_grid %>%
    image_crop(geometry_area(50, 0, 140, 20)),
  no_grid %>%
    image_crop(geometry_area(50, 0, 210, 20))
) %>%
  image_append() %>%
  image_ggplot()

    Apply the function

    We can use purrr::pmap() to apply the functions with each of our parameters, and then use bind_cols to create our actual dataset.

    all_ocr <- list(trim_width = c(80, 50, 50, 50),
     trim_start = c(0, 80, 140, 210),
     char_num = c(FALSE, TRUE, FALSE, TRUE)) %>% 
  pmap(img_ocr_fun)

# it fails on one row
all_ocr[[4]] <- append(all_ocr[[4]]$value, 271, after = 10)

data_df <- all_ocr %>% 
  bind_cols() %>% 
  set_names(nm = "team", "win", "lose", "leverage") 
    New names:
• `value` -> `value...1`
• `value` -> `value...2`
• `value` -> `value...3`
• `` -> `...4`
    data_df
    # A tibble: 25 × 4
   team      win   lose  leverage
   <chr>     <chr> <chr> <chr>   
 1 Bills     100   99.3  07      
 2 Packers   100   100   0       
 3 Rams      100   98.9  11      
 4 Chiefs    100   100   0       
 5 Saints    100   100   0       
 6 Seahawks  100   977   23      
 7 Steelers  100   100   0       
 8 Buccaneer 99.5  92.6  69      
 9 Titans    97.6  78.7  18.9    
10 Colts     94.9  66.4  285     
# … with 15 more rows

    Clean it up

    We can convert some of the letters to their proper numeric. I intentionally used characters vs numeric on some columns as it “guesses” better in our really low quality image. I then add some logic to convert our numbers if decimal places are missing, and it gets VERY close, but is not perfect.

    data_df %>% 
  mutate(across(win:leverage, ~str_replace(tolower(.x), "s", "5"))) %>% 
  mutate(across(win:leverage, ~str_replace(tolower(.x), "o|a", "0"))) %>% 
  mutate(across(win:leverage, as.double)) %>% 
  mutate(across(win:leverage, ~if_else(.x > 100, .x/10, .x))) %>% 
  mutate(lose = if_else(lose > win, lose/10, lose)) %>% 
  mutate(leverage = win - lose) %>% 
  print(n = 25)
    # A tibble: 25 × 4
   team         win  lose leverage
   <chr>      <dbl> <dbl>    <dbl>
 1 Bills      100    99.3    0.700
 2 Packers    100   100      0    
 3 Rams       100    98.9    1.10 
 4 Chiefs     100   100      0    
 5 Saints     100   100      0    
 6 Seahawks   100    97.7    2.30 
 7 Steelers   100   100      0    
 8 Buccaneer   99.5  92.6    6.90 
 9 Titans      97.6  78.7   18.9  
10 Colts       94.9  66.4   28.5  
11 Browns      94.6  67.5   27.1  
12 Ravens      90.1  51.8   38.3  
13 Football T  88.6  38.3   50.3  
14 Cardinals   65.7  28.7   37    
15 Dolphins    48.7  13.4   35.3  
16 Giants      41.3  10     31.3  
17 Bears       35.3  18     17.3  
18 Vikings     31.7   4.3   27.4  
19 Raiders     29.1   4.5   24.6  
20 Eagles      18.3   3.4   14.9  
21 49ers       14.5   5      9.5  
22 Patriots    58     0     58    
23 Cowboys     23     0     23    
24 Lions       19     0     19    
25 Panthers     1     0      1

    It looks really good, and it really only messed up a few rows, which we could fix manually, but you can see that while these techniques are robust you are still at the mercy of image quality!

    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 dplyr       * 1.0.8   2022-02-08 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.2.0)
 magick      * 2.7.3   2021-08-18 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2   2022-01-30 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.2.0)
 tesseract   * 5.0.0   2022-01-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0   2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     magick web scraping https://themockup.blog/posts/2021-01-18-reading-tables-from-images-with-magick/index.html Mon, 18 Jan 2021 06:00:00 GMT     2020 in Review Thomas Mock https://themockup.blog/posts/2020-12-31-2020-in-review/index.html

    My 2020

    2020 was absolutely difficult in a lot of ways, both for the world and for me personally. Rather than focusing on some of the difficulties, I’d rather focus on some of the successes for 2020.

    I feel very blessed that my family has stayed happy and healthy, that I have the change to continue being able to grow into expanded roles at RStudio, that I have had a lot of time with my wife Maria and our dog Howard, and that 2020 is now over. Here’s to hopefully efficient vaccine delivery in 2021, and a safer new year to all!

    Growth of #TidyTuesday

    TidyTuesday has always been a labor of love for me, and the past 3 years have provided me with such a cool view of the R community, and I believe have helped thousands of learners across the world engage with the R community.

    If we’re using the raw Tweet data, it looks like 8,601 unique tweets that reference #TidyTuesday along with some key plotting related words.

    Code to reproduce 
    library(tidyverse)
library(lubridate)
raw_url <- "https://github.com/rfordatascience/tidytuesday/blob/master/tidytuesday_tweets/data.csv?raw=true"

raw_df <- read_csv(raw_url)

raw_df %>% 
  filter(
    str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")
  ) %>% 
  count()

raw_df %>% 
  filter(
    str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")
  ) %>% 
  distinct(screen_name) %>% nrow()

sum_df <- raw_df %>% 
  filter(str_detect(tolower(text), "rstats|code|plot|graph|viz|data|tidyverse")) %>% 
  mutate(created_date = lubridate::as_date(created_at),
         year = year(created_date),
         week = week(created_date),
  ) %>% 
  count(year, week) %>% 
  group_by(year) %>% 
  mutate(roll_n = cumsum(n),
         week = if_else(year > 2018, week - 1, week - 14),
         year = factor(year, levels = c(2020, 2019, 2018)),
         colour = case_when(
           year == 2020 ~ "#003399",
           year == 2019 ~ "#FF2B4F",
           year == 2018 ~ "#fcab27",
           TRUE ~ "gray80"
         )
  ) %>% 
  ungroup()

top_weeks <- sum_df %>% 
  group_by(year) %>% 
  arrange(desc(roll_n)) %>% 
  slice(1)

tt_plot <-  ggplot(
  sum_df, 
  aes(x = week, y = roll_n, 
      color = colour, group = year)
) +
  geom_step(size = 1) +
  geom_point(data = top_weeks,
             aes(col = colour), 
             size = 2.5, stroke = 1) +
  geom_text(data = top_weeks,
            aes(label = year),
            size = 8, hjust = c(1, 1, 0), nudge_y = 50,
            vjust = 0) +
  geom_hline(yintercept = 0, size = 1, color = "black") +
  scale_y_continuous(breaks = seq(0, 5000, by = 500),
                     limits = c(0, 5000)) +
  scale_x_continuous(breaks = c(seq(0, 50, 5), 52),
                     limits = c(0, 53)) +
  scale_color_identity(aesthetics = c("colour", "fill")) +
  labs(x = "\nWeek Number", y = "Cumulative Tweets\n",
       caption = "Data: rtweet | Plot: @thomas_mock",
       title = "Cumulative tweets for #TidyTuesday by year",
       subtitle = "Note that Week 1 of 2018 started in April\nTweets must contain: 'rstats, code, plot, graph, viz, data or tidyverse'\n")  +
  tomtom::theme_538() +
  theme(legend.position = c(0.1, 0.8),
        legend.background = element_blank(),
        legend.title = element_blank(),
        legend.text = element_text(size = 12),
        plot.background = element_blank(),
        plot.title = element_text(size = 24))

tt_plot

ggsave("tt-plot.png", tt_plot, dpi = "retina")

    Re-emphasis on blogging

    I had neglected my blog since Jan 2019, but kicked off with a new blog post about simulating optimal strategy for my favorite dice game “10,000”, after seeing some Dave Robinson simulations examples. I have a strong desire to create tutorials/guides so that I can remember things for the future and to help provide some scaffolding for others to learn from as they progress through their data science learning journey.

    This really took off in March/April when Texas was heavily in lockdown and I could no longer go out to restaurants or see family. I ended up with a lot of exploration of topics, mostly for the TidyTuesday and the NFL sports analytics communities.

    • Beer and PDF tools - a vignette: this one covered extracting tables from many PDFs at once, which we used for a TidyTuesday dataset
    • Bigger, nflfastR and dbplyr: with the launch of nflfastR for large NFL play-by-play, I put together an example of creating local SQLite databases and querying them via dplyr
    • Flipping tibbles for many models: in a previous life, I used broom to tidy up my stats, and in this post I covered how to run any number of models at one time by nesting dataframes and tidying them up with broom

    In May, I started a “How to make tables with R” series, mostly focused on gt and reactable.

    I also started providing some more general resources on how to use the new tidyr functions to clean up deeply nested JSON, how to use RMarkdown, and some other guides.

    By August, I was still stuck inside, so I put together a resource on how to start your OWN blog with distill, and some other guides. Eventually, distill got a HUGE update which I provided some ideas to, although all of the real work was done by Alison Hill and the RMarkdown team.

    • Build a blog with distill: End-to-end how to guide for building and deploying a blog to netlify for free.
    • Heatmaps in ggplot2: Created examples of how to create various heatmaps and some info on when to choose a specific version to avoid overplotting

    September kicked off a deeper focus on gt specifically.

    In October and November, I spent more time on plotting.

    In December, I revisited JSON data and more plotting.

    For 2021, I’ll be continuing to blog and create technical guides - tweet at me if there’s something you want to see! @thomas_mock .

    Conferences and Presentations

    I gave some conference talks, mostly invited which I can attribute to being engaged with the community and technical blogging.

    useR 2020

    I was lucky enough to both attend (virtually) and present at my first ever useR! I focused on the #TidyTuesday project, what it’s all about, and how the community has built around it.

    NYC R

    Got to attend and present at my first NYC R conference, focused on doing more with RMarkdown!

    Hockey Analytics Night in Canada: NFL Edition

    I was honored to be invited to and present at HANICx NFL, and after running a poll decided to present on the most requested topic: tidymodels!

    • Slides: A short intro presentation on using tidymodels to predict whether the opposing team will run or pass
    • Recording

    NHS R Conference

    Gave an adapted version of my RMarkdown presentation for the NHS R community, enjoyed the chatter in the live groups there!

    Carnegie Mellon Sports Analytics Conference

    Gave my first public workshop for the CMSAC team, big thanks to Ron Yorko for the invite! I’ve always wanted to attend this conference and was deeply honored to join as a workshop presenter.

    Tables Presentation

    Gave a 60 min presentation on “Beautiful Tables in R”

    Personal

    I survived, along with my very patient wife Maria, and our dog Howard!

    • We played a lot of Mario Kart on our Switch 🎮
    • I beat Zelda: Breath of the Wild (but am nowhere near all the Korok seeds) 🏆
    • I cut my own hair 7 times so far this year 💇‍♂️
    • We spent a lot of time indoors or in the outdoors but isolated 🌲
    • We ate a lot of takeout at home 🥘
    • We voted 🇺🇸
    • We wore a LOT of masks 😷

    I’m looking forward to some rest, and then a refresh for 2021!

    Blessings to you and yours, and happy New Year!

    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     meta https://themockup.blog/posts/2020-12-31-2020-in-review/index.html Thu, 31 Dec 2020 06:00:00 GMT     Creating and using custom ggplot2 themes Thomas Mock https://themockup.blog/posts/2020-12-26-creating-and-using-custom-ggplot2-themes/index.html

    Graphs for Communication

    ggplot2 is an R package for producing statistical graphics, and is an implementation of the “Grammar of Graphics” by Leland Wilkinson. As such the primary way that folks use ggplot2 initially is for robust, fast, and easy exploratory data analysis or the creation of scientific/statistical plots while analyzing data. Here the primary use-case is for the data scientist themself, and the quick iteration of graphs. Relatively little time is spent on adjusting the theme or on making the graph “beautiful” as it may be ephemeral, or simply a visual check of the underlying relationships.

    The next stage in many analyses is creating a graphic primarily intended for others to consume. At this point, the graphic needs to be more engaging, and often needs to be more focused on telling a “story” or reinforcing some point that you are trying to present from the underlying data.

    In this blogpost, I’ll be covering some example themes, how to create and apply a theme, and then walk through some real life applications. I’ll leave larger color theory, and creating your own ggplot2 color scales for a future blogpost.

    Themes

    ggplot2 is remarkably extensible and customizable both through specific graphical components (geom_, scale_, aes, etc) or by theme components (grid lines, background colors, fonts, etc). There is also the concept of fully established themes which change many theme components at once.

    First, we’ll get some data and load our libraries of interest.

    We’re returning some data on NFL win rates, playoff seeding, and point differentials (ie difference between points given up and points scored).

    nfl_stand <- 2014:2020 %>% 
  map_dfr(get_nfl_standings)
    Returning 2014
    Returning 2015
    Returning 2016
    Returning 2017
    Returning 2018
    Returning 2019
    Returning 2020
    diff_df <- nfl_stand %>% 
  select(season = season, conf, team_name, team_abb = team_abb, team_logo, win_pct, pts_diff) %>% 
  arrange(season, conf, desc(win_pct))

diff_df
    # A tibble: 224 × 7
   season conf  team_name team_abb team_logo                    win_pct pts_diff
    <int> <chr> <chr>     <chr>    <chr>                          <dbl>    <dbl>
 1   2014 AFC   Patriots  NE       https://a.espncdn.com/i/tea…   0.75       155
 2   2014 AFC   Broncos   DEN      https://a.espncdn.com/i/tea…   0.75       128
 3   2014 AFC   Steelers  PIT      https://a.espncdn.com/i/tea…   0.688       68
 4   2014 AFC   Colts     IND      https://a.espncdn.com/i/tea…   0.688       89
 5   2014 AFC   Bengals   CIN      https://a.espncdn.com/i/tea…   0.656       21
 6   2014 AFC   Ravens    BAL      https://a.espncdn.com/i/tea…   0.625      107
 7   2014 AFC   Chiefs    KC       https://a.espncdn.com/i/tea…   0.562       72
 8   2014 AFC   Texans    HOU      https://a.espncdn.com/i/tea…   0.562       65
 9   2014 AFC   Chargers  SD       https://a.espncdn.com/i/tea…   0.562        0
10   2014 AFC   Bills     BUF      https://a.espncdn.com/i/tea…   0.562       54
# … with 214 more rows

    theme_grey()

    The default ggplot2 theme is theme_grey(), it’s major components are a grey panel.background, white panel.grid lines, coupled with a white plot.background, black text and a default black color for geom_ components.

    The signature ggplot2 theme with a grey background and white gridlines, designed to put the data forward yet make comparisons easy.

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point()

    theme_minimal()

    This theme drops the panel.background and no longer has the visual separation between the panel vs plot areas.

    A minimalistic theme with no background annotations.

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  theme_minimal()

    theme_bw()

    It’s major components are a white panel.background, grey panel.grid lines, coupled with a white plot.background, black text and a default black color for geom_ components.

    The classic dark-on-light ggplot2 theme. May work better for presentations displayed with a projector.

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  theme_bw()

    Other themes

    There are several other themes built into ggplot2, and other packages that provide new themes. The most well-known external theme package is ggthemes, which provides a number of Data Journalism themes such as theme_few(), theme_fivethirtyeight(), theme_economist() and others.

    These are implementations of very opinionated frameworks, and highlight the extensibility of the ggplot2 theme components.

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  ggthemes::theme_fivethirtyeight()

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  ggthemes::theme_economist()

    ggplot2 theme components

    You can always change specific theme components one at a time or in conjunction with a proper theme_. For example, we can apply the theme_fivethirtyeight() theme and then change one of the theme components individually.

    ggplot(diff_df, aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  ggthemes::theme_fivethirtyeight() +
  theme(
    panel.grid.major = element_line(color = "red")
  )

    There are dozens of customizable theme components. They are outlined in the ggplot2 documentation. A deep walkthrough of a lot of ggplot2 customizations can be found on Cedric Scherer’s blog. Kieran Healy’s Data Visualization: A practical introduction covers additional considerations for refining and customizing plots and why certain decisions are good.

    ggplot2 theme elements

    For each of the theme components there are one of a few theme elements. For example, to change the axis grid line color, you’ll use element_line() as in the following pseudocode:

    plot_object +
  theme(panel.grid.major = element_line(color = "red"))

    For the theme elements, there are:

    • element_line() - change line element components, takes arguments like color, size, linetype (dotted, dashed, solid, etc)

    • element_rect() - change rectangular components like plot backgrounds, legend backgrounds, etc, takes arguments like fill, color, size

    • element_text() - change text components like axis labels, titles, and takes arguments like family (font family), face (bold, italics, etc), hjust/vjust (horizontal or vertical alignment), color, etc

    • element_blank() - completely remove an element by name

    • margin() - adjust margins of an element, can be used within some other theme componenets, and takes arguments of t (top), r (right), b (bottom), l (left), and unit (unit such as points, in, cm, etc)

    • rel() - relative sizing of elements, useful for text especially, ie choosing a base font size and scaling the titles vs body fonts relative to each other

    You can always refer to the ggplot2 documentation for which theme element to use, but you can also typically “guess” which is the right one to use by referring to the output type (ie text uses element_text(), lines use element_line(), etc).

    Inspiration

    For inspiration, I often find that “Stealing like an artist” is my favorite approach.

    Your job is to collect good ideas. The more good ideas you collect, the more you can choose from to be influenced by.

    Plagiarism is trying to pass someone else’s work off as your own. Copying is about reverse-engineering.

    With this approach, you are allowing yourself to be influenced by “good” work, and learning how to implement the approaches of experts while making it your own. I find that FiveThirtyEight as an organization produces great graphics and tables, and thus I take a lot of influence from their approaches with my own novel data. It helps that they do produce some of their graphics in ggplot2!

    That being said, projects like #TidyTuesday or #StorytellingWithData can also give you a much more focused batch of concepts to borrow from as the focus is on applying concepts as a community with either a similar output or similar starting data.

    A DataViz Journey

    Let’s begin our journey by telling two stories, and working through the refinement of plots to help tell your story.

    Story one is a continuation of our data above. We’re exploring the relationship between scoring points (offense), preventing the opposing team from scoring points (defense), and how this relates to wins. This is a relatively obvious story, but has some neat “sub” stories we can look into.

    The second story will be about a specific team (the Indianapolis Colts), and how their approach to defense is effective while being very different than other teams.

    Note that since this is using live data feeds, to recreate the plots exactly as they are you’d need to read in the data I used below.

    diff_df <- readr::read_csv("https://raw.githubusercontent.com/jthomasmock/radix_themockup/master/static/diff_df.csv")
combo_pass <- readr::read_csv("https://raw.githubusercontent.com/jthomasmock/radix_themockup/master/static/combo_pass.csv")

    Point pts_diff

    Point differential is a simple metric (points scored - points against) that is pretty predictive of overall win rate and making the playoffs. Teams that score more points than the other team typically win more games, which is fairly obvious!

    However simply returning the plot below may not be as engaging to a lay audience or tell some of the nuance of what happens in individual seasons.

    Data Collection and Plot 
    nfl_stand <- 2014:2020 %>% 
  map_dfr(get_nfl_standings)
    Returning 2014
    Returning 2015
    Returning 2016
    Returning 2017
    Returning 2018
    Returning 2019
    Returning 2020
    nfl_stand_plot <- nfl_stand %>% 
  ggplot(aes(x = pts_diff, y = win_pct)) +
  geom_point() +
  geom_smooth(method = "lm")
    nfl_stand_plot
    `geom_smooth()` using formula 'y ~ x'

    That plot told us there is a fairly linear response between having a larger point differential and having a better win rate, but does winning games and scoring more points always guarantee a playoff spot or even possibly missing the playoffs?

    Playoff Teams

    Let’s add a color that shows where playoff teams fit into the big picture. Note that in 2020 teams with a ranking of 7th or better make the playoffs vs previously only the top 6 teams made it.

    Add Color 
    nfl_stand %>% 
  mutate(
    color = case_when(
      season < 2020 & seed <= 6 ~ "blue",
      season == 2020 & seed <= 7 ~ "blue",
      TRUE ~  "red"
    )
  ) %>% 
  ggplot(aes(x = pts_diff, y = win_pct)) +
  geom_vline(xintercept = 0, size = 0.75, color = "#737373") +
  geom_point(aes(color = color))

    Add some color

    Uh-oh… what happened with the colors??? We told it to be blue and red but it reversed the colors!

    We needed a scale_color_identity() call. While we’re adding color, let’s also add some “color commentary” of the axes, a title, and a source caption. There we go! Now we can show that: “Playoff teams typically have a positive point differential”. I’ll also bump up the size of the points to bump up the “ink to white” ratio and some transparency (alpha) so that overlapping points are clear.

    Lastly, I’ve added a vertical line at the 0 mark to clearly indicate the transition from negative to positive point differential.

    Proper Colors and Text 
    nfl_stand %>% 
  mutate(
    color = case_when(
      season < 2020 & seed <= 6 ~ "blue",
      season == 2020 & seed <= 7 ~ "blue",
      TRUE ~  "red"
    )
  ) %>% 
  ggplot(aes(x = pts_diff, y = win_pct)) +
  geom_vline(xintercept = 0, size = 0.75, color = "#737373") +
  geom_point(
    aes(color = color),
    size = 3, alpha = 0.8
    ) +
  scale_color_identity() +
  labs(x = "Points Differential", y = "Win Percent",
       title = "Playoff teams typically have a positive point differential",
       subtitle = "Data through week 15 of the 2020 NFL Season",
       caption = "Plot: @thomas_mock | Data: ESPN")

    Refine labels

    Now, because we don’t have a legend for the colors, let’s add some direct labels to indicate what’s going on. I’ll use ggtext to add nicely formatted color text. Note that I’ve also borrowed the NFL shield’s blue and red hex color code to add a bit more engaging color for both the labels and points. Lastly, I’ve also converted the y-axis from decimals to proper percent labels via scales::percent_format() and some better breakpoints.

    This is starting to look a lot better, but I’m not a huge fan of the base theme.

    Refine Labels 
    library(ggtext)

playoff_label_scatter <- tibble(
  pts_diff = c(25,-125), y = c(0.3, 0.8), 
  label = c("Missed<br>Playoffs", "Made<br>Playoffs"),
  color = c("#D50A0A", "#013369")
)


playoff_diff_plot <- nfl_stand %>% 
  mutate(
    color = case_when(
      season < 2020 & seed <= 6 ~ "#013369",
      season == 2020 & seed <= 7 ~ "#013369",
      TRUE ~  "#D50A0A"
    )
  ) %>% 
  ggplot(aes(x = pts_diff, y = win_pct)) +
  geom_vline(xintercept = 0, size = 0.75, color = "#737373") +
  geom_hline(yintercept = 0, size = 0.75, color = "#737373") +
  geom_point(
    aes(color = color),
    size = 3, alpha = 0.8
    ) +
  ggtext::geom_richtext(
    data = playoff_label_scatter,
    aes(x = pts_diff, y = y, label = label, color = color),
    fill = "#f0f0f0", label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"), # remove padding
    family = "Chivo", hjust = 0.1, fontface = "bold",
    size = 8
  ) +
  scale_color_identity() +
  labs(x = "Points Differential", y = "Win Percent",
       title = "Playoff teams typically have a positive point differential",
       subtitle = "Data through week 15 of the 2020 NFL Season",
       caption = str_to_upper("Plot: @thomas_mock | Data: ESPN")) +
  scale_y_continuous(
    labels = scales::percent_format(accuracy = 1),
    breaks = seq(.0, 1, by = .10)
    ) +
  scale_x_continuous(
    breaks = seq(-200, 250, by = 50)
  )
    playoff_diff_plot

    Premade themes

    Now, as mentioned earlier we can use themes to change theme components in bulk. Since we’re interested in some FiveThirtyEight style plots, let’s try the theme_fivethirtyeight() from ggthemes.

    This looks relatively close to the right overall style, but we lost axis labels, and the fonts are still a bit basic. Let’s try and build our own!

    playoff_diff_plot +
  ggthemes::theme_fivethirtyeight()

    Custom Themes

    There are two ways of building your own themes:

    • theme() - Add theme components individually
    • theme_?? %+replace% - Apply an existing theme and overwriting components of it

    theme()

    Let’s first just build up the theme components, we’ll be attempting to recreate the FiveThirtyEight theme from scratch. I’m focusing on the minimal changes necessary to recreate the plotting style. We need a lightgrey background, grey gridlines, larger text with a specific font. Note that I’m using systemfonts to load all my system font libraries into R.

    A quick example of a FiveThirtyEight style plot:

    In short, a few concepts that make up the FiveThirtyEight “style guide”:

    • Focus on Web, ie relatively small graphics
    • Light smoke-grey background with grey gridlines
    • Black Plot Titles/Subtitles and Axis Labels
    • Grey axis text (ie numbers on axis)
    • LARGE plot titles and axis labels, with medium subtitles and axis text
    • Always add a source
    • Bright colors for plots

    There’s a bit more fine details to what makes their plots so good but that covers the big parts we’ll try to capture in our theme. Some of the nuance is up to the individual to enact (ie choosing fonts, specific colors, just how big to make the fonts/points/etc).

    The first pass at a theme that we’ve created to match that style. I’ve added comments as to what different theme elements change.

    Custom Theme Code 
    theme_538 <- function(..., base_size = 12) {
  
    theme(
      # plotting components
      
      ## drop minor gridlines
      panel.grid.minor = element_blank(),
      # change grid lines to gray
      panel.grid.major =  element_line(color = "#d0d0d0"),
      # fill the plot and panel spaces with grey and remove border
      panel.background = element_rect(fill = "#f0f0f0", color = NA),
      plot.background = element_rect(fill = "#f0f0f0", color = NA),
      panel.border = element_blank(),
      # remove strip background
      strip.background = element_blank(),
      # adjust the margins of plots and remove axis ticks
      plot.margin = margin(0.5, 1, 0.5, 1, unit = "cm"),
      axis.ticks = element_blank(),
      # change text family, size, and adjust position of titles
      text = element_text(family = "Chivo", size = base_size),
      axis.text = element_text(face = "bold", color = "grey", size = base_size),
      axis.title = element_text(face = "bold", size = rel(1.33)),
      axis.title.x = element_text(margin = margin(0.5, 0, 0, 0, unit = "cm")),
      axis.title.y = element_text(margin = margin(0, 0.5, 0, 0, unit = "cm"), angle =90),
      plot.title = element_text(face = "bold", size = rel(1.67), hjust = 0),
      plot.title.position = "plot",
      plot.subtitle = element_text(size = 16, margin = margin(0.2, 0, 1, 0, unit = "cm"), hjust = 0),
      plot.caption = element_text(size = 10, margin = margin(1, 0, 0, 0, unit = "cm"), hjust = 1),
      strip.text = element_text(size = rel(1.33), face = "bold"),
      ...
    )
}

    Now let’s apply the theme to our plot.

    playoff_diff_plot +
  theme_538()

    I think we’ve created a nice representation of the FiveThirtyEight style!

    theme_?? %+replace%

    The %+replace% version instead applies a theme and then completely replaces those components rather than adding to them. This is typically more robust, but requires you to specific more arguments as they’re removed otherwise. For our purposes the code inside theme() is identical but there are situations where building up by theme() alone requires less initial work but is less robust to “real life” edge cases.

    %+replace% theme 
    theme_539 <- function(base_size = 12, base_family = "Chivo") {
  
  theme_grey(base_size = base_size, base_family = base_family) %+replace%
    theme(
      panel.grid.minor = element_blank(),
      axis.ticks = element_blank(),
      text = element_text(family = "Chivo", size = base_size),
      axis.text = element_text(face = "bold", color = "grey", size = base_size),
      axis.title = element_text(face = "bold", size = rel(1.33)),
      axis.title.x = element_text(margin = margin(0.5, 0, 0, 0, unit = "cm")),
      axis.title.y = element_text(margin = margin(0, 0.5, 0, 0, unit = "cm"), angle =90),
      plot.title = element_text(face = "bold", size = rel(1.67), hjust = 0),
      plot.title.position = "plot",
      plot.subtitle = element_text(size = 16, margin = margin(0.2, 0, 1, 0, unit = "cm"), hjust = 0),
      plot.caption = element_text(size = 10, margin = margin(1, 0, 0, 0, unit = "cm"), hjust = 1),
      plot.background = element_rect(fill = "#f0f0f0", color = NA),
      panel.background = element_rect(fill = "#f0f0f0", color = NA),
      panel.grid.major =  element_line(color = "#d0d0d0"),
      panel.border = element_blank(),
      plot.margin = margin(0.5, 1, 0.5, 1, unit = "cm"),
      strip.background = element_blank(),
      strip.text = element_text(size = rel(1.33), face = "bold")
    )
}
    playoff_diff_plot +
  theme_539()

    Same Data, Different Story

    The Same Data, Different Story (SDDS) means we can use the same data in a different plot to tell a slightly different story. We can now represent theNow we’re going to use our theme and the same data, but represent the data a bit differently. We’ll load the ggridges package to let us plot many distributions at once. Again we’re adjusting the colors, plotting the data, and adding our theme. Overall this looks pretty excellent out of the gate! This is why themes + custom colors are so useful as you can get 80% of the way there with just those two changes.

    We can see that for most years playoff teams are more frequently with positive point differentials and non-playoff teams have negative differentials, but there are clear cases (2014, 2016) where the story is not as clean!

    library(ggridges)

stand_density <- nfl_stand %>% 
  mutate(
    color = case_when(
      season < 2020 & seed <= 6 ~ "#013369",
      season == 2020 & seed <= 7 ~ "#013369",
      TRUE ~  "#D50A0A"
    )
  ) %>% 
  ggplot(aes(x = pts_diff, y = factor(season), color = color, fill = color)) +
  geom_vline(xintercept = 0.5, size = 0.75, color = "#737373") +
  geom_density_ridges(alpha = 0.8, scale = 1.1) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  theme_538()

stand_density
    Picking joint bandwidth of 30.5

    Add context

    We can add a bit more context with custom embedded labels, a title, subtitle, etc and by adjusting some of the x/y breaks. I’m going to completely drop the y-gridlines since they’re not needed. Note that for the custom annotations that factors are represented essentially as discrete ordered integers, so for the 7 years we have plotted we can put a label just above the last year by plotting at 7.5 (just above the 7th year/2020).

    Add Context 
    # create a small dataset for the custom annotations
playoff_label_ridge <- tibble(
  y = c(7.75, 7.75), pts_diff = c(-250,150),
  label = c("Missed<br>Playoffs", "Made<br>Playoffs"),
  color = c("#D50A0A", "#013369")
)

stand_density +
  scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
  coord_cartesian(xlim = c(-250, 250)) +
  ggtext::geom_richtext(
    data = playoff_label_ridge,
    aes(x = pts_diff, y = y, label = label, color = color),
    fill = "#f0f0f0", label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"), # remove padding
    family = "Chivo", hjust = 0 , fontface = "bold",
    size = 6
  ) +
  theme_538() + 
  theme(panel.grid.major.y = element_blank()) +
  labs(
    x = "Point Differential", y = "",
    title = "Playoff teams typically have a positive point differential",
    subtitle = "Data through week 15 of the 2020 NFL Season",
    caption = "Plot: @thomas_mock | Data: ESPN"
    )
    Picking joint bandwidth of 30.5

    Picking joint bandwidth of 30.5

    And if you want to look at the full code to create this all at once, see the expandable tag below.

    Full code 
    library(ggridges)

playoff_label_ridge <- tibble(
  y = c(7.5, 7.5), pts_diff = c(-225,150),
  label = c("Missed<br>Playoffs", "Made<br>Playoffs"),
  color = c("#D50A0A", "#013369")
)


nfl_stand %>% 
  mutate(
    color = case_when(
      season < 2020 & seed <= 6 ~ "#013369",
      season == 2020 & seed <= 7 ~ "#013369",
      TRUE ~  "#D50A0A"
    )
  ) %>% 
  ggplot(aes(x = pts_diff, y = factor(season), color = color, fill = color)) +
  geom_vline(xintercept = 0.5, size = 0.75, color = "#737373") +
  geom_density_ridges(alpha = 0.8, scale = 1.1) +
  ggtext::geom_richtext(
    data = playoff_label_ridge,
    aes(x = pts_diff, y = y, label = label, color = color),
    fill = "#f0f0f0", label.color = NA, # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"), # remove padding
    family = "Chivo", hjust = 0 , fontface = "bold",
    size = 6
  ) +
  scale_x_continuous(breaks = scales::pretty_breaks(n = 10)) +
  coord_cartesian(xlim = c(-250, 250)) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  theme_538() +
  theme(panel.grid.major.y = element_blank()) +
  labs(
    x = "Point Differential", y = "",
    title = "Playoff teams typically have a positive point differential",
    subtitle = "Data through Week 15 of the 2020 NFL Season",
    caption = "Plot: @thomas_mock | Data: ESPN"
    )
    Picking joint bandwidth of 30.5

    SDDS 2: Rise of 2020

    We can go one step deeper on the Same Data, Different Story principle and plot the data just a bit differently. Let’s plot the playoff teams for 2020 (top 7), and the top two “on-the-bubble” teams. I’ve added the theme_538(), and a horizontal line at the 0 mark again. Note that I’m using tidytext::reorder_within() to reorder the teams by their playoff seed within a conference. reorder() would work here as well, so tidytext::reorder_within() isn’t truly necessary, but can be very useful when re-ordering columns across facets.

    stand_df <- nfl_stand %>% 
  filter(season == 2020)

stand_df %>% 
  filter(seed <= 12) %>% 
  ggplot(aes(x = tidytext::reorder_within(team_abb, seed, conf), y = pts_diff)) +
  geom_col() + 
  tidytext::scale_x_reordered() +
  facet_grid(~conf, scales = "free_x") +
  geom_hline(yintercept = 0, size = 0.75, color = "#737373") +
  theme_538()

    Add Context

    Rather than labeling the x-axis with team, we could supply playoff seed. We’ll add our titles, captions, etc along with a vertical line for separation of the playoff vs non-playoff teams, and a vertical line to separate the Y-axis from the X-axis baseline. We’ve also expanded the break points on the y-axis and dropped the x-axis gridlines.

    Add Context 
    # Small label dataset
playoff_label <- tibble(
  seed = c(9, 4),
  pts_diff = c(30, 100),
  conf = c("AFC", "AFC"),
  label = c("Outside<br>looking in", "Playoff<br>teams"),
  color = c("#D50A0A", "#013369")
)

stand_df %>%
  filter(seed <= 12) %>%
  ggplot(aes(x = as.factor(seed), y = pts_diff)) +
  geom_col(
    aes(fill = if_else(seed <= 7, "#013369", "#D50A0A")),
    width = 0.8
  ) +
  ggtext::geom_richtext(
    data = playoff_label,
    aes(label = label, color = color),
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"),
    # remove padding
    family = "Chivo",
    hjust = 0.1,
    fontface = "bold",
    size = 6
  ) +
  geom_hline(yintercept = 0, size = 0.75, color = "#737373") +
  geom_vline(xintercept = 7.5, size = 1, color = "grey") +
  geom_vline(xintercept = 0.5, size = 0.75, color = "#737373") +
  facet_grid(~conf, scales = "free_x") +
  scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
  scale_fill_identity(aesthetics = c("fill", "color")) +
  theme_538() +
  theme(panel.grid.major.x = element_blank()) +
  labs(
    x = "Playoff Seed",
    y = "Points Differential",
    title = "Playoff teams typically have a positive point differential",
    subtitle = "Data through week 15 of the 2020 NFL Season",
    caption = "Plot: @thomas_mock | Data: ESPN"
  )

    Team vs Seed

    By converting the x-axis to playoff seed instead of team, we’ve lost some data here, specifically which teams are which. We could add these back with by adding in an image at the end of each “bar”.

    Add images 
    link_to_img <- function(x, width = 25) {
  glue::glue("<img src='{x}' width='{width}'/>")
}

playoff_label <- tibble(
  seed = c(9, 4),
  pts_diff = c(90, 110),
  conf = c("AFC", "AFC"),
  label = c("Outside<br>looking in", "Playoff<br>teams"),
  color = c("#D50A0A", "#013369")
)

stand_plot_logo <- stand_df %>%
  filter(seed <= 12) %>%
  mutate(label = link_to_img(team_logo, width = 25)) %>%
  ggplot(aes(x = as.factor(seed), y = pts_diff)) +
  geom_col(
    aes(fill = if_else(seed <= 7, "#013369", "#D50A0A")),
    width = 0.8
  ) +
  ggtext::geom_richtext(
    data = playoff_label,
    aes(label = label, color = color),
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"),
    # remove padding
    family = "Chivo",
    hjust = 0.1,
    fontface = "bold",
    size = 5
  ) +
  geom_richtext(
    aes(
      x = seed,
      y = pts_diff,
      label = label,
      vjust = if_else(pts_diff <= 1, 1.1, -0.1)
    ),
    size = 1,
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt") # remove padding
  ) +
  geom_hline(yintercept = 0, size = 0.75, color = "#737373") +
  geom_vline(xintercept = 7.5, size = 1, color = "grey") +
  geom_vline(xintercept = 0.5, size = 0.75, color = "#737373") +
  facet_grid(~conf, scales = "free_x") +
  scale_y_continuous(
    breaks = seq(-125, 125, by = 25),
    limits = c(-130, 130)
  ) +
  scale_fill_identity(aesthetics = c("fill", "color")) +
  theme_538() +
  theme(
    panel.grid.major.x = element_blank()
  ) +
  labs(
    x = "Playoff Seed",
    y = "Points Differential",
    title = "Playoff teams typically have a positive point differential",
    subtitle = "Amongst the bubble teams, Baltimore appears to be the most 'deservering' of a playoff spot",
    caption = "Plot: @thomas_mock | Data: ESPN"
  )

ggsave("stand_plot_logo.png", stand_plot_logo, height = 8, width = 10, dpi = 300)
    Warning: Removed 4 rows containing missing values (position_stack).
    Warning: Removed 4 rows containing missing values (geom_rich_text).

    Alternatively, we could convert the X-axis back to team, and then add playoff seed numbers back to each of the bars. This is getting a bit busier, but I think it’s useful to show the if_else() workflow for plotting a “label” at a specific point based on a criterion. That can be very helpful in plotting where you can’t control the “direction” of a bar just like we see here.

    Direct Labels 
    stand_df %>%
  filter(seed <= 12) %>%
  ggplot(aes(x = tidytext::reorder_within(team_abb, seed, conf), y = pts_diff)) +
  geom_col(
    aes(fill = if_else(seed <= 7, "#013369", "#D50A0A")),
    width = 0.8
  ) +
  ggtext::geom_richtext(
    data = playoff_label,
    aes(x = seed, label = label, color = color),
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"),
    # remove padding
    family = "Chivo",
    hjust = 0.1,
    fontface = "bold",
    size = 6
  ) +
  ggtext::geom_richtext(
    aes(label = seed, y = if_else(pts_diff <= 0, 10, -10)),
    color = "black",
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"),
    # remove padding
    family = "Chivo",
    hjust = 0.5,
    fontface = "bold",
    size = 4
  ) +
  geom_hline(yintercept = 0, size = 0.75, color = "#737373") +
  geom_vline(xintercept = 7.5, size = 1, color = "grey") +
  geom_vline(xintercept = 0.5, size = 0.75, color = "#737373") +
  facet_grid(~conf, scales = "free_x") +
  tidytext::scale_x_reordered() +
  scale_y_continuous(breaks = scales::pretty_breaks(n = 10)) +
  scale_fill_identity(aesthetics = c("fill", "color")) +
  theme_538() +
  theme(
    panel.grid.major.x = element_blank()
  ) +
  labs(
    x = "Playoff Seed",
    y = "Points Differential",
    title = "Playoff teams typically have a positive point differential",
    subtitle = "Amongst the bubble teams, Baltimore appears to be the most 'deservering' of a playoff spot",
    caption = "Plot: @thomas_mock | Data: ESPN"
  )

    Blitzing

    Now for the next example of a story with various components, we can look at blitz rate vs pressure rate, or blitz rate vs pass affected rate (sacks + ints + passes defended)/pass att. This is building off an article from FiveThirtyEight highlighting the Colts defense about a month ago.

    The data they used is available at Pro-Football-Reference under a few defensive categories.

    Get the data

    First we have to download the data from PFR. There are two defensive datasets we’ll need, the Advanced Stats for pressure/blitz rates and the general Passing Stats for passes defended + intercetions.

    We’ll get them via the script below, and then combine by team.

    Data Collection 
    raw_url <- "https://www.pro-football-reference.com/years/2020/opp.htm"

raw_html <- read_html(raw_url)

raw_table <- raw_html %>% 
  html_table(fill = TRUE) %>% 
  .[[2]] %>% 
  janitor::clean_names() %>% 
  tibble()

pressure_df <- raw_table %>% 
  select(tm, blitz_pct = bltz_percent, press_pct = prss_percent) %>% 
  mutate(across(c(blitz_pct, press_pct), parse_number))

pass_def_raw <- raw_html %>% 
  html_node("#all_passing") %>% 
  html_nodes(xpath = "comment()") %>% 
  html_text() %>% 
  read_html() %>% 
  html_node("table") %>% 
  html_table() %>% 
  janitor::clean_names() %>% 
  tibble()

pass_def_df <- pass_def_raw %>% 
  select(tm, pass_att = att, int, pass_def = pd, sack = sk, ypa = y_a, anypa = any_a)

    We can then do our left-join by tm to get our working dataset for this example.

    combo_pass <- left_join(
  pressure_df, pass_def_df,
  by = "tm"
)

combo_pass
    # A tibble: 32 × 9
   tm              blitz_pct press_pct pass_att   int pass_def  sack   ypa anypa
   <chr>               <dbl>     <dbl>    <dbl> <dbl>    <dbl> <dbl> <dbl> <dbl>
 1 Atlanta Falcons      32.9      23.6      625    12       51    29   7.9   7.4
 2 Buffalo Bills        35.8      22.2      573    15       76    38   6.9   5.7
 3 Carolina Panth…      24        22.4      585     7       58    29   6.9   6.6
 4 Chicago Bears        21.4      22.4      547    10       71    35   7.2   6.6
 5 Cincinnati Ben…      31.1      19        541    11       80    17   7.3   7.2
 6 Cleveland Brow…      21.3      21.9      585    11       74    38   7.2   6.6
 7 Indianapolis C…      17.1      23.3      562    15       78    40   7.3   6.1
 8 Arizona Cardin…      39.4      25.9      570    11       57    48   6.9   5.9
 9 Dallas Cowboys       22.8      22.8      513    10       46    31   7.4   7.1
10 Denver Broncos       27.9      26.2      567    10       64    42   7.2   6.2
# … with 22 more rows

    Initial Plot

    We’ll first plot the data and try out our theme. I want to add the colors of the specific article we’re recreating.

    combo_pass %>% 
  ggplot(aes(x = blitz_pct, y = press_pct)) +
  geom_point() +
  labs(
    x = "Blitz Rate", y = "Pressure Rate",
    title = "The Colts are pressuring QBs without much of a blitz",
    subtitle = "Blitz rate vs. pressure rate for each NFL defense, through Week 15 of the 2020 season"
  ) + 
  theme_538()

    Add color

    If we add color specifically for the Colts, and then also expand the axis range to match the article, we get the following plot. I’ll save the mutate calls into a new dataframe, and then plot it.

    Add Color and Text 
    colt_df <- combo_pass %>% 
  mutate(
    color = if_else(tm == "Indianapolis Colts", "#359fda", "#91c390"),
    fill = colorspace::lighten(color, amount = 0.3)
    ) %>% 
  rowwise() %>% 
  mutate(
    att_def = sum(int, pass_def, sack),
    cov_rate = att_def/pass_att*100
    ) %>% 
  ungroup() %>% 
  arrange(desc(cov_rate))

colt_df %>% 
  ggplot(aes(x = blitz_pct, y = press_pct, fill = fill, color = color)) +
  geom_point(size = 5, pch = 21, alpha = 0.8) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  labs(
    x = "Blitz Rate", y = "Pressure Rate",
    title = "The Colts are pressuring QBs without much of a blitz",
    subtitle = "Blitz rate vs. pressure rate for each NFL defense,\nthrough Week 15 of the 2020 season",
    caption = toupper("Plot: @thomas_mock | Data: PFR | Inspiration: FiveThirtyEight")
  ) +
  scale_x_continuous(limits = c(10, 45), breaks = seq(10, 45, by = 5)) +
  scale_y_continuous(limits = c(10, 35), breaks = seq(10, 35, by = 5)) +
  theme_538()
    Warning: Removed 1 rows containing missing values (geom_point).

    Warning: Removed 1 rows containing missing values (geom_point).

    Add labels

    We can create a small “helper” dataset to plot the labels, and we’ve basically re-created the original plot!

    Add Labels 
    label_df_press <- tibble(
  label = c("Colts", "Everyone else"),
  color = c("#359fda", "#91c390"),
  fill = colorspace::lighten(color, amount = 0.3),
  x = c(16, 30),
  y = c(25, 29)
)

colt_df %>% 
  ggplot(aes(x = blitz_pct, y = press_pct, fill = fill, color = color)) +
  geom_point(size = 5, pch = 21, alpha = 0.8) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  labs(
    x = "Blitz Rate", y = "Pressure Rate",
    title = "The Colts are pressuring QBs without much of a blitz",
    subtitle = "Blitz rate vs. pressure rate for each NFL defense,\nthrough Week 15 of the 2020 season",
    caption = "Source: Pro-Football-Reference.com"
  ) +
  scale_x_continuous(limits = c(10, 45), breaks = seq(10, 45, by = 5)) +
  scale_y_continuous(limits = c(10, 35), breaks = seq(10, 35, by = 5)) +
  geom_label(
    data = label_df_press,
    aes(x = x, y = y, color = color, label = label),
    fill = "#f0f0f0",
    size = 6,
    fontface = "bold",
    hjust = 0.8,
    label.size = NA # remove the border
  ) +
  theme_538()
    Warning: Removed 1 rows containing missing values (geom_point).

    Warning: Removed 1 rows containing missing values (geom_point).

    Pass Affected Rate

    The Colts are also getting good pass affected rate, which I’ve extended to be (interceptions + sacks + passes defended)/pass att. This is a proxy for the number of plays where the defense either stops the pass or is directly defending the reception.

    label_df_cov <- tibble(
  label = c("Colts", "Everyone else"),
  color = c("#359fda", "#91c390"),
  fill = colorspace::lighten(color, amount = 0.3),
  x = c(16, 33),
  y = c(25, 28)
)

    We can then use that to create a very similar plot as what we saw before. Note I’m adding an annotation outside the plot area by turning clip = 'off' in coord_cartesian(). Otherwise this plot is very close code-wise to the previous one.

    Add Annotations 
    colt_df %>%
  ggplot(aes(x = blitz_pct, y = cov_rate, color = color, fill = fill)) +
  geom_point(size = 5, pch = 21) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  labs(
    x = "Blitz Rate",
    y = "Pass Affected Rate",
    title = "The Colts affect passes at an elite rate while blitzing the least",
    subtitle = "Blitz rate vs. Pass affected rate for each NFL defense,\nthrough Week 15 of the 2020 season",
    caption = "Plot: @thomas_mock | Source: PFR"
  ) +
  scale_x_continuous(limits = c(10, 45), breaks = seq(10, 45, by = 5)) +
  scale_y_continuous(limits = c(10, 35), breaks = seq(10, 35, by = 5)) +
  coord_cartesian(clip = "off") +
  annotate("text", x = 10, y = 10, label = "Pass affected rate = (ints + sacks + passes defended)/pass attempts", vjust = 10, hjust = 0.2, color = "darkgrey") +
  theme_538() +
  geom_label(
    data = label_df_cov,
    aes(x = x, y = y, color = color, label = label),
    fill = "#f0f0f0",
    size = 6,
    fontface = "bold",
    hjust = 0.8,
    label.size = NA
  )

    Slope Chart

    By pivoting the data longer, and converting the blitz/pass affected rate columns into a combined column we can pretty quickly get a decent slope-chat put together. In short, we are creating a new metric and corresponding value column out of the blitz/pass affected rates.

    This can then be plotted where the metric name is on the x-axis and the metric value is the y-axis. Because both metrics are percentages they’re in the same plotting range.

    long_colts <- colt_df %>%
  mutate(
    color = if_else(color == "#91c390", "grey", "#359fda"),
    fill = color
  ) %>%
  rename(pass_affected_rate = cov_rate) %>%
  pivot_longer(
    cols = c(blitz_pct, pass_affected_rate), 
    names_to = "metric", values_to = "value"
    ) %>%
  mutate(
    metric = if_else(
      metric == "blitz_pct", 
      "Blitz Rate", 
      "Pass Affected Rate"
      )
  )

long_colts
    # A tibble: 64 × 13
   tm    press_pct pass_att   int pass_def  sack   ypa anypa color fill  att_def
   <chr>     <dbl>    <dbl> <dbl>    <dbl> <dbl> <dbl> <dbl> <chr> <chr>   <dbl>
 1 Pitt…      35.1      526    18       84    56   6.6   4.7 grey  grey      158
 2 Pitt…      35.1      526    18       84    56   6.6   4.7 grey  grey      158
 3 New …      26.3      557    18       84    45   6.7   5.4 grey  grey      147
 4 New …      26.3      557    18       84    45   6.7   5.4 grey  grey      147
 5 Miam…      24.8      545    18       76    41   8     6.2 grey  grey      135
 6 Miam…      24.8      545    18       76    41   8     6.2 grey  grey      135
 7 Los …      23.4      548    14       68    53   6.2   4.6 grey  grey      135
 8 Los …      23.4      548    14       68    53   6.2   4.6 grey  grey      135
 9 Wash…      25.9      529    16       66    47   6.4   4.8 grey  grey      129
10 Wash…      25.9      529    16       66    47   6.4   4.8 grey  grey      129
# … with 54 more rows, and 2 more variables: metric <chr>, value <dbl>

    Initial Slope Chart

    The initial slope chart is only a few lines of code. We’ll plot metric names on the x-axis, metric values on the y-axis, add lines by team between the compared measures, and then layer points on top of it all.

    long_colts %>%
  ggplot(aes(x = metric, y = value, group = tm, color = color, fill = fill)) +
  geom_line(aes(size = if_else(tm == "Indianapolis Colts", 2, 0.5))) +
  geom_point(size = 5, pch = 21, color = "#f0f0f0", stroke = 1) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  scale_size_identity()

    Add theme and context

    We can further enhance the plot with the title/source data. I’ve also shared a little “hack” that allows you to plot outside of the plot area. By setting clip = 'off' in coord_cartestian(), we can add an annotation that falls “outside” of the plot area. This lets us add a description note similar to what FiveThirtyEight does with some of their plots.

    Add Theme and Context 
    colt_slope <- long_colts %>%
  ggplot(aes(x = metric, y = value, group = tm, color = color, fill = fill)) +
  geom_line(aes(size = if_else(tm == "Indianapolis Colts", 2, 0.5))) +
  geom_point(size = 5, pch = 21, color = "#f0f0f0", stroke = 1) +
  geom_label(
    data = filter(long_colts, tm == "Indianapolis Colts"),
    aes(label = paste0(round(value, 0), "%")),
    fill = NA,
    hjust = c(1, 0),
    nudge_x = c(-0.02, 0.02),
    label.size = NA,
    family = "Chivo",
    fontface = "bold",
    size = 6
  ) +
  annotate(
    "text", x = 1, y = 12, vjust = 11, hjust = 0.4, color = "darkgrey",
    family = "Chivo",
    label = "Pass affected rate = (sacks + ints + passes defended)/pass att"
    ) +
  coord_cartesian(clip = "off") +
  scale_y_continuous(limits = c(12, 43), breaks = scales::pretty_breaks(n = 7)) +
  scale_x_discrete(expand = c(0.2, 0.2)) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  scale_size_identity() +
  theme_538() +
  theme(
    panel.grid.major.y = element_blank(),
    axis.text.y = element_blank(),
    plot.margin = margin(0.5, 0.5, 0.1, 0.5, unit = "cm"),
    axis.text.x = element_text(color = "black", size = 20),
    plot.caption = element_markdown(size = 14)
  ) +
  labs(
    x = "",
    y = "",
    title = "The Colts affect more passes with fewer rushers",
    subtitle = "Data since through Week 15 of the 2020 NFL season",
    caption = "**Plot**: @thomas_mock | **Data**: PFR"
  )

ggsave("colt_slope.png", colt_slope, height = 5, width = 4, dpi = 500, scale = 1.75)
    Warning: Removed 1 row(s) containing missing values (geom_path).
    Warning: Removed 1 rows containing missing values (geom_point).

    Barbell

    For our last example with this data, we’re going to really highlight the Colt’s passing defense effectiveness without a blitz. A barbell plot is another combo of lines + points, where the line is a segment between the two measures of interest.

    Our first attempt is pretty straightforward, we’ll plot the segment between the points, then layer two geom_points(), one for each measure.

    Initial Barbell 
    barbell_first <- colt_df %>% 
  rename(pass_affected_rate = cov_rate) %>% 
  mutate(
    color = str_replace(color, "#91c390", "grey"),
    fill = str_replace(fill, "#91c390", "grey"),
    tm = word(tm, -1)
    ) %>% 
  ggplot(aes(x = blitz_pct, y = fct_reorder(tm, pass_affected_rate), 
             group = tm, color = color)) +
  geom_segment(aes(xend = pass_affected_rate, yend = tm), size = 2) +
  geom_point(size = 5, color = "grey") +
  geom_point(aes(x = pass_affected_rate, y = tm), size = 5, color = "black") +
  scale_color_identity()

ggsave("barbell_first.png", barbell_first, height = 12, width = 8, units = "in", dpi = 300)

    Theme and context

    We can add some more labels and context, along with our theme and a custom color placement to indicate the Colts as the outlier of interest.

    Barbell Theme 
    colt_colors <- colt_df %>% 
  arrange(cov_rate) %>% 
  mutate(color = str_replace(color, "#91c390", "black")) %>% 
  pull(color)

pass_label_df <- tibble(
  x = c(20, 19.5),
  tm = c(30, 25),
  label = c("Blitz Rate", "Pass Affected<br>Rate"),
  color = c("grey", "black")
)

ex_barbell <- colt_df %>%
  rename(pass_affected_rate = cov_rate) %>%
  mutate(
    color = str_replace(color, "#91c390", "grey"),
    fill = str_replace(fill, "#91c390", "grey"),
    tm = word(tm, -1)
  ) %>%
  ggplot(aes(x = blitz_pct, y = fct_reorder(tm, pass_affected_rate), 
             group = tm, color = color, fill = fill)) +
  geom_segment(aes(xend = pass_affected_rate, yend = tm), size = 2) +
  geom_point(size = 5, color = "grey") +
  geom_point(aes(x = pass_affected_rate, y = tm), size = 5, color = "black") +
  ggtext::geom_richtext(
    data = pass_label_df,
    aes(x = x, y = tm, label = label, color = color),
    fill = "#f0f0f0",
    label.color = NA,
    # remove background and outline
    label.padding = grid::unit(rep(0, 4), "pt"),
    # remove padding
    family = "Chivo",
    hjust = 1,
    fontface = "bold",
    size = 5
  ) +
  annotate(
    "text",
    x = 10,
    y = 1,
    vjust = 10,
    hjust = 0.4,
    color = "darkgrey",
    family = "Chivo",
    label = "Pass affected rate = (sacks + ints + passes defended)/pass att"
  ) +
  scale_x_continuous(limits = c(10, 45), breaks = scales::pretty_breaks(n = 7)) +
  scale_color_identity(aesthetics = c("fill", "color")) +
  coord_cartesian(clip = "off") +
  labs(
    x = "<span style = 'color:grey;'>Blitz rate</span> vs Pass affected rate",
    y = "",
    title = "The Colts affect more passes with fewer rushers",
    subtitle = "Data through Week 15 of the 2020 NFL season",
    caption = "**Plot**: @thomas_mock | **Data**: PFR"
  ) +
  theme_538() +
  theme(
    panel.grid.major.y = element_blank(),
    axis.text.y = element_text(color = colt_colors, size = 18),
    axis.title.x = element_markdown(),
    plot.caption = element_markdown()
  )
    Warning: Vectorized input to `element_text()` is not officially supported.
Results may be unexpected or may change in future versions of ggplot2.
    ggsave("barbell.png", ex_barbell, height = 12, width = 8, units = "in", dpi = 300)

    The end

    We’ve now covered quite a bit about themes and customization of ggplot2 beyond the basics! You can dive back into other themes from ggthemes to recreate them/build off of them or develop your own novel theme to use.

    If my blog has helped you, you can buy me a coffee!

    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 colorspace  * 2.0-3   2022-02-21 [1] CRAN (R 4.2.0)
 dplyr       * 1.0.8   2022-02-08 [1] CRAN (R 4.2.0)
 espnscrapeR * 0.6.5   2022-04-26 [1] Github (jthomasmock/espnscrapeR@084ce80)
 forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.2.0)
 ggridges    * 0.5.3   2021-01-08 [1] CRAN (R 4.2.0)
 ggtext      * 0.1.1   2020-12-17 [1] CRAN (R 4.2.0)
 ggthemes    * 4.2.4   2021-01-20 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.2.0)
 readr       * 2.1.2   2022-01-30 [1] CRAN (R 4.2.0)
 rvest       * 1.0.2   2021-10-16 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.2.0)
 systemfonts * 1.0.4   2022-02-11 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0   2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     ggplot2 data visualization theme tidyverse NFL espnscrapeR https://themockup.blog/posts/2020-12-26-creating-and-using-custom-ggplot2-themes/index.html Sat, 26 Dec 2020 06:00:00 GMT     Extracting JSON data from websites and public APIs with R Thomas Mock https://themockup.blog/posts/2020-12-13-extracting-json-from-websites-and-public-apis-with-r/index.html

    Finding JSON Sources

    I’ve covered some strategies for parsing JSON with a few methods in base R and/or tidyverse in a previous blog post. I’d like to go one step up in the chain, and talk about pulling raw data/JSON from sites. While having a direct link to JSON is common, in some situations where you’re scraping JavaScript fed by APIs the raw data source is not always as easy to find.

    I have three examples for today:
    - FiveThirtyEight 2020 NFL Predictions
    - ESPN Win Percentage/play-by-play (embedded JSON)
    - ESPN Public API

    Web vs Analysis

    Most of these JSON data sources are intended to be used with JavaScript methods, and have not been oriented to a “flat” data style. This means the JSON has lots of separations of the data for a specific use/purpose inside the site, and efficient singular representations of each data in JSON storage as opposed to normalized data with repeats in a dataframe. While extreme detail is out of scope for this blogpost, JSON is structured as a “collection of name/value pairs” or a “an ordered list of values”. This means it is typically represented in R as repeated lists of list elements, where the list elements can be named lists, vectors, dataframes, or character strings.

    Alternatively typically data for analysis is usually most useful as a normalized rectangle eg a dataframe/tibble. “Under the hood a data frame is a list of equal length vectors” per Advanced R.

    One step further is tidy data which is essentially “3rd normal form”. Hadley goes into more detail in his “Tidy Data” publication. The takeaway here is that web designers are optimizing for their extremely focused interactive JavaScript apps and websites, as opposed to novel analyses that we often want to work with. This is often why there are quite a few steps to “rectangle” a JSON.

    An aside on Subsetting

    Subsetting in R is done many different ways, and Hadley Wickham has an entire chapter dedicated to this in Advanced R. It’s worth reading through that chapter to better understand the nuance, but I’ll provide a very brief summary of the options.

    # a VERY basic list of named elements
car_list <- list(manufacturer = "Honda", vehicle = "Civic", year = 2020)

    “Subsetting a list works in the same way as subsetting an atomic vector. Using [ always returns a list; [[ and $, … let you pull out elements of a list.”

    When working with lists, you can typically use $ and [[ interchangeably to extract single list elements by name. [[ requires exact matching whereas $ allows for partial matching, so I typically prefer to use [[. To extract by location from base R you need to use [[.

    purrr functions pluck() and chuck() implement a generalised form of [[ that allow you to index deeply and flexibly into data structures. pluck() consistently returns NULL when an element does not exist, chuck() always throws an error in that case.”

    So in short, you can use $, [[ and pluck/chuck in many of the same ways. I’ll compare all the base R and purrr versions below (all should return “Honda”).

    # $ subsets by name
car_list$manufacturer
    [1] "Honda"
    # notice partial match
car_list$man
    [1] "Honda"
    # [[ requires exact match or position
car_list[["manufacturer"]]
    [1] "Honda"
    car_list[[1]]
    [1] "Honda"
    # pluck and chuck provide a more strict version of [[
# and can subset by exact name or position
purrr::pluck(car_list, "manufacturer")
    [1] "Honda"
    purrr::pluck(car_list, 1)
    [1] "Honda"
    purrr::chuck(car_list, "manufacturer")
    [1] "Honda"
    purrr::chuck(car_list, 1)
    [1] "Honda"

    For one more warning of partial name matching with $, where we now have a case of two elements with similar names see below:

    car_list2 <- list(manufacturer = "Honda", vehicle = "Civic", manufactured_year = 2020)

# partial match throws a null
car_list2$man
    NULL
    # exact name returns actual elements
car_list2$manufacturer
    [1] "Honda"

    An aside on JavaScript

    If we dramatically oversimplify JavaScript or their R-based counterparts htmlwidgets, they are a combination of some type of JSON data and then functions to display or interact with that data.

    We can quickly show a htmlwidget example via the fantastic reactable R package.

    library(reactable)

table_ex <- mtcars %>% 
  select(cyl, mpg, disp) %>% 
  reactable()

table_ex

    That gives us the power of JavaScript in R! However, what’s going on with this function behind the scenes? We can extract the dataframe that has now been represented as a JSON file from the htmlwidget!

    table_data <- table_ex[["x"]][["tag"]][["attribs"]][["data"]]

table_data %>% class()
    [1] "json"

    This basic idea, that the data is embedded as JSON to fill the JavaScript app can be further applied to web-based apps! We can use a similar idea to scrape raw JSON or query a web API that returns JSON from a site.

    FiveThirtyEight

    FiveThirtyEight publishes their ELO ratings and playoff predictions for the NFL via a table at projects.fivethirtyeight.com/2020-nfl-predictions/. They are also kind enough to post this data as a download publicly! However, let’s see if we can “find” the data source feeding the JavaScript table.

    rvest

    We can try our classical rvest based approach to scrape the HTML content and get back a table. However, the side effect of this is we’re returning the literal data with units, some combined columns, and other formatting. You’ll notice that all the columns show up as character and this introduces a lot of other work we’d have to do to “clean” the data.

    library(xml2)
library(rvest)

url_538 <- "https://projects.fivethirtyeight.com/2020-nfl-predictions/"

raw_538_html <- read_html(url_538)

raw_538_table <- raw_538_html %>% 
  html_node("#standings-table") %>% 
  html_table(fill = TRUE) %>% 
  janitor::clean_names() %>% 
  tibble()

raw_538_table %>% glimpse()
    Rows: 36
Columns: 12
$ x                 <chr> "", "", "", "elo with top qbelo rating", "1734", "17…
$ x_2               <chr> "", "", "", "1-week change", "+34", "", "", "", "", …
$ x_3               <chr> "", "", "", "current qb adj.", "", "", "", "", "", "…
$ x_4               <chr> "", "playoff chances", "", "", "", "", "", "", "", "…
$ x_5               <chr> "playoff chances", "playoff chances", "", "team", "B…
$ x_6               <chr> "playoff chances", "playoff chances", "", "division"…
$ playoff_chances   <chr> "playoff chances", "playoff chances", "", "make div.…
$ playoff_chances_2 <chr> "playoff chances", NA, "", "make conf. champ", "✓", …
$ playoff_chances_3 <chr> NA, NA, "", "make super bowl", "✓", "✓", "—", "—", "…
$ playoff_chances_4 <chr> NA, NA, "", "win super bowl", "✓", "—", "—", "—", "—…
$ x_7               <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …
$ x_8               <lgl> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, …

    Inspect + Network

    Alternatively, we can Right Click + inspect the site, go to the Network tab, reload the site and see what sources are loaded. Again, FiveThirtyEight is very kind and essentially just loads the JSON as data.json.

    I have screenshots below of each item, and the below is a short video of the entire process.

    We can click over to the Network Tab after inspecting the site

    We need to reload the web page to find sources

    We can examine specific elements by clicking on them, which then shows us JSON!

    In our browser inspect, we can see the structure, and that it has some info about games, QBs, and forecasts. This looks like the right dataset! You can right click on data.json and open it in a new page. The url is https://projects.fivethirtyeight.com/2020-nfl-predictions/data.json, and note that we can adjust the year to get older or current data. So https://projects.fivethirtyeight.com/2019-nfl-predictions/data.json returns the data for 2019, and you can go all the way back to 2016! 2015 also exists, but with a different JSON structure, and AFAIK they don’t have data before 2015.

    Read the JSON

    Now that we have a JSON source, we can read it into R with jsonlite. By using the RStudio viewer or listviewer::jsonedit() we can take a look at what the overall structure of the JSON.

    library(jsonlite)

raw_538_json <- fromJSON("https://projects.fivethirtyeight.com/2020-nfl-predictions/data.json", simplifyVector = FALSE)

raw_538_json %>% str(max.level = 1)
    List of 9
 $ archie                :List of 24
 $ clinches              :List of 114
 $ distances             :List of 32
 $ games                 :List of 269
 $ pageconfig            :List of 20
 $ playoff_qb_adjustments:List of 32
 $ qbs                   :List of 87
 $ urls                  :List of 2
 $ weekly_forecasts      :List of 2

    Don’t forget that the RStudio Viewer also gives you the ability to export the base R code to access a specific component of the JSON!

    Screenshot of RStudio Viewer

    Which gives us the following code:

    raw_538_json[["weekly_forecasts"]][["forecasts"]][[1]][["types"]][["elo"]][[1]]

    ex_538_data <- raw_538_json[["weekly_forecasts"]][["forecasts"]][[1]][["types"]][["elo"]][[1]]

ex_538_data %>% str()
    List of 29
 $ conference           : chr "NFC"
 $ current_losses       : int 9
 $ current_ties         : int 0
 $ current_wins         : int 7
 $ division             : chr "NFC North"
 $ elo                  : num 1489
 $ losses               : int 9
 $ make_conference_champ: int 0
 $ make_divisional_round: int 0
 $ make_playoffs        : int 0
 $ make_superbowl       : int 0
 $ name                 : chr "MIN"
 $ point_diff           : int -45
 $ points_allowed       : int 475
 $ points_scored        : int 430
 $ rating               : num 1481
 $ rating_current       : num 1502
 $ rating_top           : num 1502
 $ seed_1               : int 0
 $ seed_2               : int 0
 $ seed_3               : int 0
 $ seed_4               : int 0
 $ seed_5               : int 0
 $ seed_6               : int 0
 $ seed_7               : int 0
 $ ties                 : int 0
 $ win_division         : int 0
 $ win_superbowl        : int 0
 $ wins                 : int 7

    We can also play around with listviewer.

    raw_538_json %>% 
  listviewer::jsonedit()

    Since these are unique list elements, we can turn it into a dataframe! This is the current projection for Minnesota.

    data.frame(ex_538_data) %>% glimpse()
    Rows: 1
Columns: 29
$ conference            <chr> "NFC"
$ current_losses        <int> 9
$ current_ties          <int> 0
$ current_wins          <int> 7
$ division              <chr> "NFC North"
$ elo                   <dbl> 1489.284
$ losses                <int> 9
$ make_conference_champ <int> 0
$ make_divisional_round <int> 0
$ make_playoffs         <int> 0
$ make_superbowl        <int> 0
$ name                  <chr> "MIN"
$ point_diff            <int> -45
$ points_allowed        <int> 475
$ points_scored         <int> 430
$ rating                <dbl> 1480.954
$ rating_current        <dbl> 1501.583
$ rating_top            <dbl> 1501.583
$ seed_1                <int> 0
$ seed_2                <int> 0
$ seed_3                <int> 0
$ seed_4                <int> 0
$ seed_5                <int> 0
$ seed_6                <int> 0
$ seed_7                <int> 0
$ ties                  <int> 0
$ win_division          <int> 0
$ win_superbowl         <int> 0
$ wins                  <int> 7

    Parse the JSON

    Ok so we’ve found at least one set of data that is pretty dataframe ready, let’s clean it all up in bulk! I’m most interested in the weekly_forecasts data, so let’s start there.

    raw_538_json$weekly_forecasts %>% str(max.level = 1)
    List of 2
 $ last_updated: chr "2021-02-08T03:15:55.357Z"
 $ forecasts   :List of 22

    Ok so last_updated is good to know, but not something I need right now. Let’s go one step deeper into forecasts.

    raw_538_json$weekly_forecasts$forecasts %>% str(max.level = 1)
    List of 22
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3
 $ :List of 3

    Ok now we have a list of 14 lists. This may seem not helpful, BUT remember that as of 2020-12-12, we are in Week 14 of the NFL season! So this is likely 1 list for each of the weekly forecasts, which makes sense as we are in weekly_forecasts$forecasts!

    At this point, I think I’m at the right data, so I’m going to take the list and put it in a tibble via tibble::enframe().

    raw_538_json$weekly_forecasts$forecasts %>% 
  enframe()
    # A tibble: 22 × 2
    name value           
   <int> <list>          
 1     1 <named list [3]>
 2     2 <named list [3]>
 3     3 <named list [3]>
 4     4 <named list [3]>
 5     5 <named list [3]>
 6     6 <named list [3]>
 7     7 <named list [3]>
 8     8 <named list [3]>
 9     9 <named list [3]>
10    10 <named list [3]>
# … with 12 more rows

    We need to separate the list items out, so we can try unnest_auto() to see if tidyr can parse the correct structure. Note that unnest_auto works and tells us we could have used unnest_wider().

    raw_538_json$weekly_forecasts$forecasts %>% 
  enframe() %>% 
  unnest_auto(value)
    Using `unnest_wider(value)`; elements have 3 names in common
    # A tibble: 22 × 4
    name last_updated              week types           
   <int> <chr>                    <int> <list>          
 1     1 2021-02-08T03:15:55.357Z    21 <named list [2]>
 2     2 2021-01-25T03:10:04.809Z    20 <named list [2]>
 3     3 2021-01-22T19:28:01.278Z    19 <named list [2]>
 4     4 2021-01-15T01:25:55.192Z    18 <named list [2]>
 5     5 2021-01-09T16:38:13.126Z    17 <named list [2]>
 6     6 2021-01-03T16:03:42.517Z    16 <named list [2]>
 7     7 2020-12-24T01:32:05.045Z    15 <named list [2]>
 8     8 2020-12-16T14:13:49.344Z    14 <named list [2]>
 9     9 2020-12-10T16:21:56.731Z    13 <named list [2]>
10    10 2020-12-06T15:29:51.523Z    12 <named list [2]>
# … with 12 more rows

    We can keep going on the types list column! Note that as unnest_auto() tells us “what” to do, I’m going to replace it with the appropriate function.

    raw_538_json$weekly_forecasts$forecasts %>% 
  enframe() %>% 
  unnest_wider(value) %>% # changed per recommendation
  unnest_auto(types)
    Using `unnest_wider(types)`; elements have 2 names in common
    # A tibble: 22 × 5
    name last_updated              week elo         rating     
   <int> <chr>                    <int> <list>      <list>     
 1     1 2021-02-08T03:15:55.357Z    21 <list [32]> <list [32]>
 2     2 2021-01-25T03:10:04.809Z    20 <list [32]> <list [32]>
 3     3 2021-01-22T19:28:01.278Z    19 <list [32]> <list [32]>
 4     4 2021-01-15T01:25:55.192Z    18 <list [32]> <list [32]>
 5     5 2021-01-09T16:38:13.126Z    17 <list [32]> <list [32]>
 6     6 2021-01-03T16:03:42.517Z    16 <list [32]> <list [32]>
 7     7 2020-12-24T01:32:05.045Z    15 <list [32]> <list [32]>
 8     8 2020-12-16T14:13:49.344Z    14 <list [32]> <list [32]>
 9     9 2020-12-10T16:21:56.731Z    13 <list [32]> <list [32]>
10    10 2020-12-06T15:29:51.523Z    12 <list [32]> <list [32]>
# … with 12 more rows

    We now have a list of 32 x 14 weeks. There are 32 teams so we’re most likely at the appropriate depth and can go longer vs wider now. We can also see that name/week don’t align so let’s drop name, and we can use unchop() to increase the length of the data for elo and rating at the same time.

    raw_538_json$weekly_forecasts$forecasts %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  unnest_wider(types) %>% # Changed per recommendation
  unchop(cols = c(elo, rating)) %>% 
  select(-name)
    # A tibble: 704 × 4
   last_updated              week elo               rating           
   <chr>                    <int> <list>            <list>           
 1 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 2 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 3 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 4 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 5 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 6 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 7 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 8 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
 9 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
10 2021-02-08T03:15:55.357Z    21 <named list [29]> <named list [29]>
# … with 694 more rows

    We now have 14 weeks x 32 teams (448 rows), along with last_updated, week, elo and rating data. We can use unnest_auto() on the elo column to see what’s the next step. Rating is duplicated so there’s been name repair to avoid duplicated names. We get the following warning that tells us this has occurred.

    * rating -> rating...18
    * rating -> rating...32

    You’ll see that I’ve done unnest_auto() on both elo and rating...32 (the renamed rating list column). If you look closely at the names, we can also see that there is duplication of the names for MANY of the columns. A tricky part is that elo/rating each have a LOT of overlap, and are most appropriate as separate data frames that could be stacked if desired.

    elo_raw <- raw_538_json$weekly_forecasts$forecasts %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  unnest_wider(types) %>% # Changed per recommendation
  unchop(cols = c(elo, rating)) %>% 
  select(-name) %>% 
  unnest_auto(elo) %>% 
  unnest_auto(rating...32)
    Using `unnest_wider(elo)`; elements have 29 names in common
    New names:
Using `unnest_wider(rating...32)`; elements have 29 names in common
New names:
• `rating` -> `rating...18`
• `rating` -> `rating...32`
    elo_raw %>% 
  names()
     [1] "last_updated"               "week"                      
 [3] "conference...3"             "current_losses...4"        
 [5] "current_ties...5"           "current_wins...6"          
 [7] "division...7"               "elo...8"                   
 [9] "losses...9"                 "make_conference_champ...10"
[11] "make_divisional_round...11" "make_playoffs...12"        
[13] "make_superbowl...13"        "name...14"                 
[15] "point_diff...15"            "points_allowed...16"       
[17] "points_scored...17"         "rating...18"               
[19] "rating_current...19"        "rating_top...20"           
[21] "seed_1...21"                "seed_2...22"               
[23] "seed_3...23"                "seed_4...24"               
[25] "seed_5...25"                "seed_6...26"               
[27] "seed_7...27"                "ties...28"                 
[29] "win_division...29"          "win_superbowl...30"        
[31] "wins...31"                  "conference...32"           
[33] "current_losses...33"        "current_ties...34"         
[35] "current_wins...35"          "division...36"             
[37] "elo...37"                   "losses...38"               
[39] "make_conference_champ...39" "make_divisional_round...40"
[41] "make_playoffs...41"         "make_superbowl...42"       
[43] "name...43"                  "point_diff...44"           
[45] "points_allowed...45"        "points_scored...46"        
[47] "rating...47"                "rating_current...48"       
[49] "rating_top...49"            "seed_1...50"               
[51] "seed_2...51"                "seed_3...52"               
[53] "seed_4...53"                "seed_5...54"               
[55] "seed_6...55"                "seed_7...56"               
[57] "ties...57"                  "win_division...58"         
[59] "win_superbowl...59"         "wins...60"

    Let’s try this again, with the knowledge that elo and rating should be treated separately for now. Since they have the same names, we can also combine the data by stacking (bind_rows()). I have added a new column so that we can differentiate between the two datasets (ELO vs Rating).

    weekly_raw <- raw_538_json$weekly_forecasts$forecasts %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  unnest_wider(types) %>% 
  select(-name) %>%
  unchop(cols = c(elo, rating))

weekly_elo <- weekly_raw %>% 
  select(-rating) %>% 
  unnest_wider(elo) %>% 
  mutate(measure = "ELO", .after = last_updated)

weekly_rating <- weekly_raw %>% 
  select(-elo) %>% 
  unnest_wider(rating) %>% 
  mutate(measure = "Rating", .after = last_updated)

# confirm same names
all.equal(
  names(weekly_elo),
  names(weekly_rating)
)
    [1] TRUE
    weekly_forecasts <- bind_rows(weekly_elo, weekly_rating)

weekly_forecasts %>% glimpse()
    Rows: 1,408
Columns: 32
$ last_updated          <chr> "2021-02-08T03:15:55.357Z", "2021-02-08T03:15:55…
$ measure               <chr> "ELO", "ELO", "ELO", "ELO", "ELO", "ELO", "ELO",…
$ week                  <int> 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, …
$ conference            <chr> "NFC", "AFC", "NFC", "NFC", "NFC", "AFC", "AFC",…
$ current_losses        <int> 9, 6, 10, 12, 11, 11, 14, 11, 6, 10, 6, 5, 10, 9…
$ current_ties          <int> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ current_wins          <int> 7, 10, 7, 4, 5, 4, 2, 5, 12, 6, 11, 13, 6, 7, 15…
$ division              <chr> "NFC North", "AFC East", "NFC East", "NFC South"…
$ elo                   <dbl> 1489.284, 1545.820, 1442.351, 1474.240, 1333.468…
$ losses                <dbl> 9, 6, 9, 12, 11, 11, 14, 11, 5, 10, 5, 4, 10, 9,…
$ make_conference_champ <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, …
$ make_divisional_round <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, …
$ make_playoffs         <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, …
$ make_superbowl        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ name                  <chr> "MIN", "MIA", "WSH", "ATL", "DET", "CIN", "NYJ",…
$ point_diff            <dbl> -45, 66, 6, -18, -142, -113, -214, -123, 165, -7…
$ points_allowed        <dbl> 475, 338, 329, 414, 519, 424, 457, 446, 303, 357…
$ points_scored         <dbl> 430, 404, 335, 396, 377, 311, 243, 323, 468, 280…
$ rating                <dbl> 1480.954, 1565.307, 1446.254, 1449.242, 1340.178…
$ rating_current        <dbl> 1501.583, 1529.565, 1462.552, 1448.424, 1338.309…
$ rating_top            <dbl> 1501.583, 1529.565, 1462.552, 1448.424, 1338.309…
$ seed_1                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ seed_2                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ seed_3                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ seed_4                <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, …
$ seed_5                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
$ seed_6                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ seed_7                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ ties                  <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ win_division          <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, …
$ win_superbowl         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ wins                  <dbl> 7, 10, 7, 4, 5, 4, 2, 5, 11, 6, 11, 12, 6, 7, 13…

    Create a Function

    Finally, we can combine the techniques we showed above as a function (and I’ve added it to espnscrapeR). Now we can use this to get data throughout the current season OR get info from past seasons (2015 and beyond). Again, note that 2015 has a different JSON structure but the core forecasts portion is still the same.

    get_weekly_forecast <- function(season) {
  
  # Fill URL and read in JSON
  raw_url <- glue::glue("https://projects.fivethirtyeight.com/{season}-nfl-predictions/data.json")
  raw_json <- fromJSON(raw_url, simplifyVector = FALSE)
  
  # get the two datasets
  weekly_raw <- raw_538_json$weekly_forecasts$forecasts %>%
    enframe() %>%
    unnest_wider(value) %>%
    unnest_wider(types) %>%
    select(-name) %>%
    unchop(cols = c(elo, rating))
  
  # get ELO
  weekly_elo <- weekly_raw %>%
    select(-rating) %>%
    unnest_wider(elo) %>%
    mutate(measure = "ELO", .after = last_updated)
  # get Rating
  weekly_rating <- weekly_raw %>%
    select(-elo) %>%
    unnest_wider(rating) %>%
    mutate(measure = "Rating", .after = last_updated)
  # combine
  bind_rows(weekly_elo, weekly_rating)
}

get_weekly_forecast(2015) %>% 
  glimpse()
    Rows: 1,408
Columns: 32
$ last_updated          <chr> "2021-02-08T03:15:55.357Z", "2021-02-08T03:15:55…
$ measure               <chr> "ELO", "ELO", "ELO", "ELO", "ELO", "ELO", "ELO",…
$ week                  <int> 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, 21, …
$ conference            <chr> "NFC", "AFC", "NFC", "NFC", "NFC", "AFC", "AFC",…
$ current_losses        <int> 9, 6, 10, 12, 11, 11, 14, 11, 6, 10, 6, 5, 10, 9…
$ current_ties          <int> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ current_wins          <int> 7, 10, 7, 4, 5, 4, 2, 5, 12, 6, 11, 13, 6, 7, 15…
$ division              <chr> "NFC North", "AFC East", "NFC East", "NFC South"…
$ elo                   <dbl> 1489.284, 1545.820, 1442.351, 1474.240, 1333.468…
$ losses                <dbl> 9, 6, 9, 12, 11, 11, 14, 11, 5, 10, 5, 4, 10, 9,…
$ make_conference_champ <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, …
$ make_divisional_round <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 1, 0, …
$ make_playoffs         <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, …
$ make_superbowl        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ name                  <chr> "MIN", "MIA", "WSH", "ATL", "DET", "CIN", "NYJ",…
$ point_diff            <dbl> -45, 66, 6, -18, -142, -113, -214, -123, 165, -7…
$ points_allowed        <dbl> 475, 338, 329, 414, 519, 424, 457, 446, 303, 357…
$ points_scored         <dbl> 430, 404, 335, 396, 377, 311, 243, 323, 468, 280…
$ rating                <dbl> 1480.954, 1565.307, 1446.254, 1449.242, 1340.178…
$ rating_current        <dbl> 1501.583, 1529.565, 1462.552, 1448.424, 1338.309…
$ rating_top            <dbl> 1501.583, 1529.565, 1462.552, 1448.424, 1338.309…
$ seed_1                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ seed_2                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, …
$ seed_3                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, …
$ seed_4                <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, …
$ seed_5                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, …
$ seed_6                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ seed_7                <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ ties                  <dbl> 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ win_division          <dbl> 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 1, …
$ win_superbowl         <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ wins                  <dbl> 7, 10, 7, 4, 5, 4, 2, 5, 11, 6, 11, 12, 6, 7, 13…

    Other FiveThirtyEight Data

    There’s several other interesting data points in this JSON, but they’re also much easier to extract.

    QB playoff adjustment values

    qb_playoff_adj <- raw_538_json$playoff_qb_adjustments %>% 
  enframe() %>% 
  unnest_wider(value)
    Output 
    qb_playoff_adj
    # A tibble: 32 × 4
    name team   week  qb_adj
   <int> <chr> <int>   <dbl>
 1     1 ARI      21  17.3  
 2     2 ATL      21  -0.819
 3     3 BAL      21  -2.72 
 4     4 BUF      21  33.1  
 5     5 CAR      21   4.26 
 6     6 CHI      21  19.2  
 7     7 CIN      21 -84.5  
 8     8 CLE      21  16.9  
 9     9 DAL      21 -60.9  
10    10 DEN      21  15.3  
# … with 22 more rows

    Games Data

    This one is interesting, it’s got ELO change as a result of win/loss along with the spread and ratings.

    games_df <- raw_538_json$games %>% 
  enframe() %>% 
  unnest_auto(value) %>% 
  select(-name)
    Using `unnest_wider(value)`; elements have 40 names in common
    Output 
    games_df
    # A tibble: 269 × 40
        id date  datetime  week status team1 team2 neutral playoff score1 score2
     <int> <chr> <chr>    <int> <chr>  <chr> <chr> <lgl>   <chr>    <int>  <int>
 1  4.01e8 2020… 2020-09…     1 post   KC    HOU   FALSE   <NA>        34     20
 2  4.01e8 2020… 2020-09…     1 post   DET   CHI   FALSE   <NA>        23     27
 3  4.01e8 2020… 2020-09…     1 post   BAL   CLE   FALSE   <NA>        38      6
 4  4.01e8 2020… 2020-09…     1 post   MIN   GB    FALSE   <NA>        34     43
 5  4.01e8 2020… 2020-09…     1 post   JAX   IND   FALSE   <NA>        27     20
 6  4.01e8 2020… 2020-09…     1 post   NE    MIA   FALSE   <NA>        21     11
 7  4.01e8 2020… 2020-09…     1 post   BUF   NYJ   FALSE   <NA>        27     17
 8  4.01e8 2020… 2020-09…     1 post   CAR   OAK   FALSE   <NA>        30     34
 9  4.01e8 2020… 2020-09…     1 post   WSH   PHI   FALSE   <NA>        27     17
10  4.01e8 2020… 2020-09…     1 post   ATL   SEA   FALSE   <NA>        25     38
# … with 259 more rows, and 29 more variables: overtime <lgl>, elo1_pre <dbl>,
#   elo2_pre <dbl>, elo_spread <dbl>, elo_prob1 <dbl>, elo_prob2 <dbl>,
#   elo1_post <dbl>, elo2_post <dbl>, rating1_pre <dbl>, rating2_pre <dbl>,
#   rating_spread <dbl>, rating_prob1 <dbl>, rating_prob2 <dbl>,
#   rating1_post <dbl>, rating2_post <dbl>, bettable <lgl>, outcome <dbl>,
#   qb_adj1 <dbl>, qb_adj2 <dbl>, rest_adj1 <int>, rest_adj2 <int>,
#   dist_adj <dbl>, rating1_top_qb <dbl>, rating2_top_qb <dbl>, …

    Distances

    This data has the distances for each team to other locations/stadiums.

    distance_df <- raw_538_json$distances %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  unnest_longer(distances)
    Output 
    distance_df
    # A tibble: 1,024 × 6
    name team    lat   lon distances distances_id
   <int> <chr> <dbl> <dbl>     <dbl> <chr>       
 1     1 TEN    36.2 -86.8        0  TEN         
 2     1 TEN    36.2 -86.8      758. NYG         
 3     1 TEN    36.2 -86.8      471. PIT         
 4     1 TEN    36.2 -86.8      339. CAR         
 5     1 TEN    36.2 -86.8      595. BAL         
 6     1 TEN    36.2 -86.8      619. TB          
 7     1 TEN    36.2 -86.8      251. IND         
 8     1 TEN    36.2 -86.8      698. MIN         
 9     1 TEN    36.2 -86.8     1454. ARI         
10     1 TEN    36.2 -86.8      634. DAL         
# … with 1,014 more rows

    QB Adjustment

    I believe this is the in-season QB adjustment for each team.

    qb_adj <- raw_538_json$qbs %>% 
  enframe() %>% 
  select(-name) %>% 
  unnest_wider(value)
    Output 
    qb_adj
    # A tibble: 87 × 6
    api_id name            team  priority elo_value starts
     <int> <chr>           <chr>    <int>     <int>  <int>
 1 3040206 Chris Streveler ARI          2         0      1
 2 4035003 Jacob Eason     IND          3        58      1
 3 3124900 Jake Luton      JAX          3        20      1
 4 3915436 Steven Montez   WSH          3         0      1
 5 4241479 Tua Tagovailoa  MIA          1       128      1
 6 4038941 Justin Herbert  LAC          1       200      1
 7 4040715 Jalen Hurts     PHI          1       120      1
 8 3895785 Ben DiNucci     DAL          3         6      1
 9 4036378 Jordan Love     GB           3       102      1
10   12471 Chase Daniel    DET          2        33      1
# … with 77 more rows

    ESPN

    ESPN has interactive win probability charts for their games. They also go a step farther than FiveThirtyEight and the JSON is embedded into the HTML “bundle”. They also have a hidden API, but I’m going to first show an example of how to get the JSON from within the page itself.

    Example End Function 
    get_espn_win_prob <- function(game_id){

  raw_url <-glue::glue("https://www.espn.com/nfl/game?gameId={game_id}")

  raw_html <- raw_url %>%
    read_html()

  raw_text <- raw_html %>%
    html_nodes("script") %>%
    .[23] %>%
    html_text()

  raw_json <- raw_text %>%
    gsub(".*(\\[\\{)", "\\1", .) %>%
    gsub("(\\}\\]).*", "\\1", .)

  parsed_json <- jsonlite::parse_json(raw_json)

  raw_df <- parsed_json %>%
    enframe() %>%
    rename(row_id = name) %>%
    unnest_wider(value) %>%
    unnest_wider(play) %>%
    hoist(period, quarter = "number") %>%
    unnest_wider(start) %>%
    hoist(team, pos_team_id = "id") %>%
    hoist(clock, clock = "displayValue") %>%
    hoist(type, play_type = "text") %>%
    select(-type) %>%
    janitor::clean_names() %>%
    mutate(game_id = game_id)

  raw_df

}

    Get the data

    Let’s use an example from a pretty wild swing in Win Percentage from Week 13 of the 2020 NFL season. The Vikings and Jaguars went to overtime, with a lot of back and forth. Since there is an interactive data visualization, I’m assuming the JSON data is present there as well.

    If we try our previous trick from FiveThirtyEight and the Inspect -> Network we get a total of… about 300 different requests! None of them appear big enough to be the “right” data. We’re expecting 4-5 Mb of data.

    Another trick is to look for embedded JSON in the site itself. The basic representation of JSON is [{name: item}], so let’s try looking for [{ as the start of a JSON structure.

    Inside the Google Chrome Dev tools we can search and find a few JSON files, including one inside some JavaScript called espn.gamepackage.probability! There’s a good amount of data there, but we need to extract it from the raw HTML. This JSON is inside a <script> object, so let’s parse the HTML and get script nodes.

    espn_url <-glue::glue("https://www.espn.com/nfl/game?gameId=401220303")

raw_espn_html <- espn_url %>%
    read_html()

raw_espn_html %>%
    html_nodes("script") 
    {xml_nodeset (27)}
 [1] <script type="application/ld+json">\n\t{\n\t\t"@context": "https://schem ...
 [2] <script type="text/javascript" src="https://dcf.espn.com/TWDC-DTCI/prod/ ...
 [3] <script type="text/javascript">\n;(function(){\n\nfunction rc(a){for(var ...
 [4] <script src="https://secure.espn.com/core/format/modules/head/i18n?editi ...
 [5] <script src="https://a.espncdn.com/redesign/0.591.3/js/espn-head.js"></s ...
 [6] <script>\n\t\t\tif (espn && espn.geoRedirect){\n\t\t\t\tespn.geoRedirect ...
 [7] <script>\n\tvar espn = espn || {};\n\tespn.isOneSite = false;\n\tespn.bu ...
 [8] <script src="https://a.espncdn.com/redesign/0.591.3/node_modules/espn-la ...
 [9] <script type="text/javascript">\n\t(function () {\n\t\tvar featureGating ...
[10] <script>\n\t\twindow.googletag = window.googletag || {};\n\n\t\t(functio ...
[11] <script type="text/javascript">\n\tif( typeof s_omni === "undefined" ) w ...
[12] <script type="text/javascript" src="https://a.espncdn.com/prod/scripts/a ...
[13] <script>\n\t// Picture element HTML shim|v it for old IE (pairs with Pic ...
[14] <script type="text/javascript">\n\t\t\tvar abtestData = {};\n\t\t\t\n\t\ ...
[15] <script type="text/javascript">\n\t\tvar espn = espn || {};\n\t\tespn.na ...
[16] <script type="text/javascript">\n\n    var __dataLayer = window.__dataLa ...
[17] <script>\n\tvar espn_ui = window.espn_ui || {};\n\tespn_ui.staticRef = " ...
[18] <script src="https://a.espncdn.com/redesign/0.591.3/js/espn-critical.js" ...
[19] <script type="text/javascript">\n\t\t\tvar espn = espn || {};\n\n\t\t\t/ ...
[20] <script type="text/javascript">jQuery.subscribe('espn.defer.end', functi ...
...

    Big oof. There’s 27 scripts here and just parsing through the start of the script as they are in XML is not helpful…So let’s get the raw text from each of these nodes and see if we can find the espn.gamepackage.probability element which we’re looking for!

    raw_espn_text <- raw_espn_html %>%
  html_nodes("script") %>% 
  html_text()

raw_espn_text %>% 
  str_which("espn.gamepackage.probability")
    [1] 23

    Ok! So we’re looking for the 23rd node, I’m going to hide the output inside an expandable tag, as it’s a long output!

    example_embed_json <- raw_espn_html %>%
    html_nodes("script") %>% 
    .[23] %>%
    html_text()
    Example Embed JSON 
    example_embed_json
    [1] "\n\t\t\t\t(function($) {\n\t\t\t\t\tvar espn = window.espn || {},\n\t\t\t\t\t\tDTCpackages = window.DTCpackages || [];\n\n\t\t\t\t\tespn.gamepackage = espn.gamepackage || {};\n\t\t\t\t\tespn.gamepackage.gameId = \"401220303\";\n\t\t\t\t\tespn.gamepackage.type = \"game\";\n\t\t\t\t\tespn.gamepackage.timestamp = \"2020-12-06T18:00Z\";\n\t\t\t\t\tespn.gamepackage.status = \"post\";\n\t\t\t\t\tespn.gamepackage.league = \"nfl\";\n\t\t\t\t\tespn.gamepackage.leagueId = 28;\n\t\t\t\t\tespn.gamepackage.sport = \"football\";\n\t\t\t\t\tespn.gamepackage.network = \"CBS\";\n\t\t\t\t\tespn.gamepackage.awayTeamName = \"jacksonville-jaguars\";\n\t\t\t\t\tespn.gamepackage.homeTeamName = \"minnesota-vikings\";\n\t\t\t\t\tespn.gamepackage.awayTeamId = \"30\";\n\t\t\t\t\tespn.gamepackage.homeTeamId = \"16\";\n\t\t\t\t\tespn.gamepackage.awayTeamColor = \"00839C\";\n\t\t\t\t\tespn.gamepackage.homeTeamColor = \"240A67\";\n\t\t\t\t\tespn.gamepackage.showGamebreak = true;\n\t\t\t\t\tespn.gamepackage.supportsHeadshots = true\n\t\t\t\t\tespn.gamepackage.playByPlaySource = \"full\";\n\t\t\t\t\tespn.gamepackage.numPeriods = null;\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\t\t\t\t\t\n\n\t\t\t\t\t\n\n\t\t\t\t\t\n\t\t\t\t\t\tespn.gamepackage.probability = espn.gamepackage.probability || {};\n\t\t\t\t\t\tespn.gamepackage.probability.data = [{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":0,\"start\":{\"distance\":0,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"D.Bailey kicks 65 yards from MIN 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"15:00\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.828,\"playId\":\"40122030340\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":0,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(15:00) M.Glennon pass deep middle to J.O'Shaughnessy to JAX 49 for 24 yards (A.Harris; E.Wilson).\",\"clock\":{\"displayValue\":\"15:00\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.807,\"playId\":\"40122030355\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":0,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 49\",\"downDistanceText\":\"1st & 10 at JAX 49\",\"distance\":10,\"yardLine\":51,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":51},\"text\":\"(14:25) (Shotgun) M.Glennon pass short right to J.Robinson pushed ob at MIN 43 for 8 yards (T.Dye).\",\"clock\":{\"displayValue\":\"14:25\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.796,\"playId\":\"40122030379\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":0,\"start\":{\"shortDownDistanceText\":\"2nd & 2\",\"possessionText\":\"MIN 43\",\"downDistanceText\":\"2nd & 2 at MIN 43\",\"distance\":2,\"yardLine\":43,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":43},\"text\":\"(13:54) J.Robinson left guard to MIN 34 for 9 yards (T.Davis; E.Wilson).\",\"clock\":{\"displayValue\":\"13:54\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.785,\"playId\":\"401220303108\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":0,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"1st & 10 at MIN 34\",\"distance\":10,\"yardLine\":34,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":34},\"text\":\"(13:21) J.Robinson left end to MIN 28 for 6 yards (A.Harris; S.Stephen).\",\"clock\":{\"displayValue\":\"13:21\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.777,\"playId\":\"401220303129\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"2nd & 4\",\"possessionText\":\"MIN 28\",\"downDistanceText\":\"2nd & 4 at MIN 28\",\"distance\":4,\"yardLine\":28,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":28},\"text\":\"Laviska Shenault Jr. 28 Yd pass from Mike Glennon (Chase McLaughlin PAT failed)\",\"clock\":{\"displayValue\":\"12:33\"},\"type\":{\"id\":\"67\",\"text\":\"Passing Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.742,\"playId\":\"401220303150\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"distance\":0,\"yardLine\":-4,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 69 yards from JAX 35 to MIN -4. A.Abdullah to MIN 21 for 25 yards (S.Quarterman).\",\"clock\":{\"displayValue\":\"12:33\"},\"type\":{\"id\":\"12\",\"text\":\"Kickoff Return (Offense)\"}},\"homeWinPercentage\":0.741,\"playId\":\"401220303191\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 21\",\"downDistanceText\":\"1st & 10 at MIN 21\",\"distance\":10,\"yardLine\":21,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":79},\"text\":\"(12:28) K.Cousins pass short left to A.Thielen pushed ob at MIN 29 for 8 yards (T.Herndon). PENALTY on JAX-M.Jack, Defensive Holding, 5 yards, enforced at MIN 21 - No Play.\",\"clock\":{\"displayValue\":\"12:28\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.747,\"playId\":\"401220303213\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"1st & 10 at MIN 26\",\"distance\":10,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":74},\"text\":\"(12:11) (Shotgun) K.Cousins pass incomplete deep right to A.Thielen.\",\"clock\":{\"displayValue\":\"12:11\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.719,\"playId\":\"401220303257\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"2nd & 10 at MIN 26\",\"distance\":10,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":74},\"text\":\"(12:06) D.Cook right tackle to MIN 33 for 7 yards (M.Jack).\",\"clock\":{\"displayValue\":\"12:06\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.731,\"playId\":\"401220303279\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"3rd & 3\",\"possessionText\":\"MIN 33\",\"downDistanceText\":\"3rd & 3 at MIN 33\",\"distance\":3,\"yardLine\":33,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":67},\"text\":\"(11:27) (Shotgun) K.Cousins pass incomplete short right to D.Cook.\",\"clock\":{\"displayValue\":\"11:27\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.683,\"playId\":\"401220303300\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"4th & 3\",\"possessionText\":\"MIN 33\",\"downDistanceText\":\"4th & 3 at MIN 33\",\"distance\":3,\"yardLine\":33,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":67},\"text\":\"(11:23) B.Colquitt punts 50 yards to JAX 17, Center-A.DePaola. K.Cole Sr. to JAX 30 for 13 yards (T.Conklin).\",\"clock\":{\"displayValue\":\"11:23\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.699,\"playId\":\"401220303322\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"1st & 10 at JAX 30\",\"distance\":10,\"yardLine\":70,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":70},\"text\":\"(11:11) J.Robinson left guard to JAX 34 for 4 yards (T.Dye).\",\"clock\":{\"displayValue\":\"11:11\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.693,\"playId\":\"401220303347\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 34\",\"downDistanceText\":\"2nd & 6 at JAX 34\",\"distance\":6,\"yardLine\":66,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":66},\"text\":\"(10:41) (Shotgun) J.Robinson left end to JAX 38 for 4 yards (T.Davis; J.Johnson).\",\"clock\":{\"displayValue\":\"10:41\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.685,\"playId\":\"401220303368\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"3rd & 2\",\"possessionText\":\"JAX 38\",\"downDistanceText\":\"3rd & 2 at JAX 38\",\"distance\":2,\"yardLine\":62,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":62},\"text\":\"(10:04) (Shotgun) M.Glennon pass short right to T.Eifert to JAX 44 for 6 yards (J.Gladney).\",\"clock\":{\"displayValue\":\"10:04\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.653,\"playId\":\"401220303389\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 44\",\"downDistanceText\":\"1st & 10 at JAX 44\",\"distance\":10,\"yardLine\":56,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":56},\"text\":\"(9:29) J.Robinson left tackle to MIN 47 for 9 yards (E.Wilson).\",\"clock\":{\"displayValue\":\"9:29\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.629,\"playId\":\"401220303413\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"2nd & 1\",\"possessionText\":\"MIN 47\",\"downDistanceText\":\"2nd & 1 at MIN 47\",\"distance\":1,\"yardLine\":47,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":47},\"text\":\"(8:48) M.Glennon pass short middle to J.O'Shaughnessy to MIN 40 for 7 yards (T.Dye).\",\"clock\":{\"displayValue\":\"8:48\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.62,\"playId\":\"401220303434\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 40\",\"downDistanceText\":\"1st & 10 at MIN 40\",\"distance\":10,\"yardLine\":40,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":40},\"text\":\"(8:06) (Shotgun) M.Glennon pass deep left to C.Johnson to MIN 6 for 34 yards (H.Smith) [J.Holmes].\",\"clock\":{\"displayValue\":\"8:06\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.688,\"playId\":\"401220303458\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"1st & Goal\",\"possessionText\":\"MIN 6\",\"downDistanceText\":\"1st & Goal at MIN 6\",\"distance\":6,\"yardLine\":6,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":6},\"text\":\"(7:28) (Shotgun) M.Glennon pass short right to J.Robinson to MIN 5 for 1 yard (T.Dye).\",\"clock\":{\"displayValue\":\"7:26\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.523,\"playId\":\"401220303482\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"2nd & Goal\",\"possessionText\":\"MIN 5\",\"downDistanceText\":\"2nd & Goal at MIN 5\",\"distance\":5,\"yardLine\":5,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":5},\"text\":\"(6:52) (Shotgun) J.Robinson up the middle to MIN 4 for 1 yard (E.Yarbrough; J.Gladney).\",\"clock\":{\"displayValue\":\"6:52\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.578,\"playId\":\"401220303506\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":6,\"start\":{\"shortDownDistanceText\":\"3rd & Goal\",\"possessionText\":\"MIN 4\",\"downDistanceText\":\"3rd & Goal at MIN 4\",\"distance\":4,\"yardLine\":4,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":4},\"text\":\"(6:12) (Shotgun) M.Glennon pass incomplete short left to K.Cole Sr..\",\"clock\":{\"displayValue\":\"6:12\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.621,\"playId\":\"401220303527\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & Goal\",\"possessionText\":\"MIN 4\",\"downDistanceText\":\"4th & Goal at MIN 4\",\"distance\":4,\"yardLine\":4,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":4},\"text\":\"Chase McLaughlin 22 Yd Field Goal\",\"clock\":{\"displayValue\":\"6:04\"},\"type\":{\"id\":\"59\",\"text\":\"Field Goal Good\",\"abbreviation\":\"FG\"}},\"homeWinPercentage\":0.619,\"playId\":\"401220303549\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"distance\":0,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 65 yards from JAX 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"6:04\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.624,\"playId\":\"401220303568\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 25\",\"downDistanceText\":\"1st & 10 at MIN 25\",\"distance\":10,\"yardLine\":25,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(6:04) D.Cook left end to MIN 31 for 6 yards (J.Schobert).\",\"clock\":{\"displayValue\":\"6:04\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.625,\"playId\":\"401220303583\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 4\",\"possessionText\":\"MIN 31\",\"downDistanceText\":\"2nd & 4 at MIN 31\",\"distance\":4,\"yardLine\":31,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":69},\"text\":\"(5:28) K.Cousins pass short left to J.Jefferson to MIN 36 for 5 yards (T.Herndon).\",\"clock\":{\"displayValue\":\"5:28\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.636,\"playId\":\"401220303604\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 36\",\"downDistanceText\":\"1st & 10 at MIN 36\",\"distance\":10,\"yardLine\":36,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":64},\"text\":\"(4:53) J.Jefferson right end pushed ob at MIN 38 for 2 yards (M.Jack).\",\"clock\":{\"displayValue\":\"4:53\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.553,\"playId\":\"401220303628\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 8\",\"possessionText\":\"MIN 38\",\"downDistanceText\":\"2nd & 8 at MIN 38\",\"distance\":8,\"yardLine\":38,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":62},\"text\":\"(4:17) D.Cook left end to MIN 35 for -3 yards (T.Herndon).\",\"clock\":{\"displayValue\":\"4:17\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.572,\"playId\":\"401220303649\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 11\",\"possessionText\":\"MIN 35\",\"downDistanceText\":\"3rd & 11 at MIN 35\",\"distance\":11,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":65},\"text\":\"(3:36) (Shotgun) K.Cousins sacked at MIN 30 for -5 yards (D.Smoot).\",\"clock\":{\"displayValue\":\"3:36\"},\"type\":{\"id\":\"7\",\"text\":\"Sack\"}},\"homeWinPercentage\":0.464,\"playId\":\"401220303670\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 16\",\"possessionText\":\"MIN 30\",\"downDistanceText\":\"4th & 16 at MIN 30\",\"distance\":16,\"yardLine\":30,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":70},\"text\":\"(3:08) B.Colquitt punts 49 yards to JAX 21, Center-A.DePaola. K.Cole Sr. to JAX 25 for 4 yards (R.Connelly). PENALTY on JAX-J.Giles-Harris, Offensive Holding, 10 yards, enforced at JAX 21.\",\"clock\":{\"displayValue\":\"3:08\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.565,\"playId\":\"401220303689\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 11\",\"downDistanceText\":\"1st & 10 at JAX 11\",\"distance\":10,\"yardLine\":89,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":89},\"text\":\"(2:56) L.Shenault Jr. left end to JAX 24 for 13 yards (T.Davis).\",\"clock\":{\"displayValue\":\"2:56\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.537,\"playId\":\"401220303731\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 24\",\"downDistanceText\":\"1st & 10 at JAX 24\",\"distance\":10,\"yardLine\":76,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":76},\"text\":\"(2:17) J.Robinson up the middle to JAX 28 for 4 yards (H.Mata'afa; T.Davis).\",\"clock\":{\"displayValue\":\"2:17\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.547,\"playId\":\"401220303752\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 28\",\"downDistanceText\":\"2nd & 6 at JAX 28\",\"distance\":6,\"yardLine\":72,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":72},\"text\":\"(1:41) M.Glennon pass short right to J.O'Shaughnessy to JAX 32 for 4 yards (J.Gladney).\",\"clock\":{\"displayValue\":\"1:41\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.536,\"playId\":\"401220303773\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 2\",\"possessionText\":\"JAX 32\",\"downDistanceText\":\"3rd & 2 at JAX 32\",\"distance\":2,\"yardLine\":68,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":68},\"text\":\"(:59) (Shotgun) PENALTY on JAX-J.Robinson, False Start, 5 yards, enforced at JAX 32 - No Play.\",\"clock\":{\"displayValue\":\"0:59\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.559,\"playId\":\"401220303797\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 7\",\"possessionText\":\"JAX 27\",\"downDistanceText\":\"3rd & 7 at JAX 27\",\"distance\":7,\"yardLine\":73,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":73},\"text\":\"(:38) (Shotgun) M.Glennon pass incomplete short right to D.Chark Jr..\",\"clock\":{\"displayValue\":\"0:38\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.591,\"playId\":\"401220303820\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 7\",\"possessionText\":\"JAX 27\",\"downDistanceText\":\"4th & 7 at JAX 27\",\"distance\":7,\"yardLine\":73,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":73},\"text\":\"(:33) L.Cooke punts 59 yards to MIN 14, Center-R.Matiscik. K.Osborn to MIN 21 for 7 yards (D.Ogunbowale).\",\"clock\":{\"displayValue\":\"0:33\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.567,\"playId\":\"401220303842\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 21\",\"downDistanceText\":\"1st & 10 at MIN 21\",\"distance\":10,\"yardLine\":21,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":79},\"text\":\"(:22) K.Cousins pass short right to J.Jefferson to MIN 28 for 7 yards (J.Jones).\",\"clock\":{\"displayValue\":\"0:22\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.577,\"playId\":\"401220303867\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":1},\"homeScore\":0,\"awayScore\":9,\"start\":{\"distance\":0,\"yardLine\":0,\"down\":2,\"yardsToEndzone\":72},\"text\":\"END QUARTER 1\",\"clock\":{\"displayValue\":\"0:00\"},\"type\":{\"id\":\"2\",\"text\":\"End Period\",\"abbreviation\":\"EP\"}},\"homeWinPercentage\":0.574,\"playId\":\"401220303891\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 3\",\"possessionText\":\"MIN 28\",\"downDistanceText\":\"2nd & 3 at MIN 28\",\"distance\":3,\"yardLine\":28,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":72},\"text\":\"(15:00) D.Cook left end to MIN 29 for 1 yard (M.Jack; D.Costin).\",\"clock\":{\"displayValue\":\"15:00\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.559,\"playId\":\"401220303910\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 2\",\"possessionText\":\"MIN 29\",\"downDistanceText\":\"3rd & 2 at MIN 29\",\"distance\":2,\"yardLine\":29,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":71},\"text\":\"(14:22) (Shotgun) K.Cousins pass incomplete short right to A.Thielen (G.Mabin).\",\"clock\":{\"displayValue\":\"14:22\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.489,\"playId\":\"401220303931\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 2\",\"possessionText\":\"MIN 29\",\"downDistanceText\":\"4th & 2 at MIN 29\",\"distance\":2,\"yardLine\":29,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":71},\"text\":\"(14:17) B.Colquitt punts 46 yards to JAX 25, Center-A.DePaola, downed by MIN-K.Boyd.\",\"clock\":{\"displayValue\":\"14:17\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.5,\"playId\":\"401220303953\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(14:06) J.Robinson left guard to JAX 28 for 3 yards (T.Davis; J.Johnson).\",\"clock\":{\"displayValue\":\"14:06\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.493,\"playId\":\"401220303972\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"JAX 28\",\"downDistanceText\":\"2nd & 7 at JAX 28\",\"distance\":7,\"yardLine\":72,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":72},\"text\":\"(13:27) (Shotgun) M.Glennon pass short left to L.Shenault Jr. to JAX 35 for 7 yards (H.Smith; E.Wilson).\",\"clock\":{\"displayValue\":\"13:27\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.474,\"playId\":\"401220303993\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 35\",\"downDistanceText\":\"1st & 10 at JAX 35\",\"distance\":10,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":65},\"text\":\"(12:50) M.Glennon pass incomplete deep left to D.Chark Jr..\",\"clock\":{\"displayValue\":\"12:50\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.507,\"playId\":\"4012203031017\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 35\",\"downDistanceText\":\"2nd & 10 at JAX 35\",\"distance\":10,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":65},\"text\":\"(12:44) (Shotgun) M.Glennon pass short right to C.Johnson to JAX 41 for 6 yards (H.Smith).\",\"clock\":{\"displayValue\":\"12:44\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.519,\"playId\":\"4012203031039\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 4\",\"possessionText\":\"JAX 41\",\"downDistanceText\":\"3rd & 4 at JAX 41\",\"distance\":4,\"yardLine\":59,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":59},\"text\":\"(12:03) (Shotgun) M.Glennon pass short left to T.Eifert to JAX 47 for 6 yards (C.Jones).\",\"clock\":{\"displayValue\":\"12:03\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.439,\"playId\":\"4012203031063\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 47\",\"downDistanceText\":\"1st & 10 at JAX 47\",\"distance\":10,\"yardLine\":53,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":53},\"text\":\"(11:24) J.Robinson right end to 50 for 3 yards (T.Davis; A.Watts).\",\"clock\":{\"displayValue\":\"11:24\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.458,\"playId\":\"4012203031087\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"50\",\"downDistanceText\":\"2nd & 7 at 50\",\"distance\":7,\"yardLine\":50,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":50},\"text\":\"(10:43) (Shotgun) L.Shenault Jr. right end to MIN 33 for 17 yards (A.Harris).\",\"clock\":{\"displayValue\":\"10:43\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.388,\"playId\":\"4012203031108\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 33\",\"downDistanceText\":\"1st & 10 at MIN 33\",\"distance\":10,\"yardLine\":33,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":33},\"text\":\"(10:02) PENALTY on JAX-J.Taylor, False Start, 5 yards, enforced at MIN 33 - No Play.\",\"clock\":{\"displayValue\":\"10:02\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.444,\"playId\":\"4012203031132\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 15\",\"possessionText\":\"MIN 38\",\"downDistanceText\":\"1st & 15 at MIN 38\",\"distance\":15,\"yardLine\":38,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":38},\"text\":\"(9:38) (Shotgun) D.Ogunbowale left end to MIN 34 for 4 yards (E.Yarbrough).\",\"clock\":{\"displayValue\":\"9:38\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.419,\"playId\":\"4012203031159\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 11\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"2nd & 11 at MIN 34\",\"distance\":11,\"yardLine\":34,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":34},\"text\":\"(8:58) (Shotgun) M.Glennon pass incomplete short left to D.Ogunbowale.\",\"clock\":{\"displayValue\":\"8:58\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.427,\"playId\":\"4012203031181\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 11\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"3rd & 11 at MIN 34\",\"distance\":11,\"yardLine\":34,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":34},\"text\":\"(8:55) (Shotgun) M.Glennon pass short right to T.Eifert to MIN 21 for 13 yards (E.Wilson).\",\"clock\":{\"displayValue\":\"8:55\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.486,\"playId\":\"4012203031203\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 21\",\"downDistanceText\":\"1st & 10 at MIN 21\",\"distance\":10,\"yardLine\":21,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":21},\"text\":\"(8:16) (Shotgun) J.Robinson right tackle to MIN 16 for 5 yards (C.Jones; A.Harris). PENALTY on JAX-L.Shenault Jr., Illegal Shift, 5 yards, enforced at MIN 21 - No Play.\",\"clock\":{\"displayValue\":\"8:16\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.386,\"playId\":\"4012203031227\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 15\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"1st & 15 at MIN 26\",\"distance\":15,\"yardLine\":26,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":26},\"text\":\"(7:46) (Shotgun) M.Glennon pass short left intended for E.Saubert INTERCEPTED by C.Dantzler at MIN 22. C.Dantzler to MIN 22 for no gain (E.Saubert).\",\"clock\":{\"displayValue\":\"7:46\"},\"type\":{\"id\":\"26\",\"text\":\"Pass Interception Return\",\"abbreviation\":\"INTR\"}},\"homeWinPercentage\":0.495,\"playId\":\"4012203031259\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 22\",\"downDistanceText\":\"1st & 10 at MIN 22\",\"distance\":10,\"yardLine\":22,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":78},\"text\":\"(7:40) D.Cook left tackle to MIN 26 for 4 yards (J.Jones).\",\"clock\":{\"displayValue\":\"7:40\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.502,\"playId\":\"4012203031285\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"2nd & 6 at MIN 26\",\"distance\":6,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":74},\"text\":\"(7:12) K.Cousins pass short right to A.Thielen pushed ob at MIN 40 for 14 yards (G.Mabin).\",\"clock\":{\"displayValue\":\"7:12\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.524,\"playId\":\"4012203031306\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 40\",\"downDistanceText\":\"1st & 10 at MIN 40\",\"distance\":10,\"yardLine\":40,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":60},\"text\":\"(6:41) D.Cook right tackle to MIN 44 for 4 yards (D.Costin; J.Giles-Harris).\",\"clock\":{\"displayValue\":\"6:41\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.507,\"playId\":\"4012203031335\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"MIN 44\",\"downDistanceText\":\"2nd & 6 at MIN 44\",\"distance\":6,\"yardLine\":44,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":56},\"text\":\"(6:07) K.Cousins pass short right to D.Cook to JAX 45 for 11 yards (J.Giles-Harris).\",\"clock\":{\"displayValue\":\"6:07\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.542,\"playId\":\"4012203031356\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 45\",\"downDistanceText\":\"1st & 10 at JAX 45\",\"distance\":10,\"yardLine\":55,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":45},\"text\":\"(5:27) K.Cousins scrambles left end to JAX 35 for 10 yards (G.Mabin).\",\"clock\":{\"displayValue\":\"5:27\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.556,\"playId\":\"4012203031380\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 35\",\"downDistanceText\":\"1st & 10 at JAX 35\",\"distance\":10,\"yardLine\":65,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":35},\"text\":\"(4:47) K.Cousins pass short right to A.Thielen pushed ob at JAX 23 for 12 yards (G.Mabin).\",\"clock\":{\"displayValue\":\"4:47\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.58,\"playId\":\"4012203031401\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 23\",\"downDistanceText\":\"1st & 10 at JAX 23\",\"distance\":10,\"yardLine\":77,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":23},\"text\":\"(4:16) K.Cousins pass incomplete deep left to K.Rudolph [J.Giles-Harris].\",\"clock\":{\"displayValue\":\"4:16\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.543,\"playId\":\"4012203031430\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 23\",\"downDistanceText\":\"2nd & 10 at JAX 23\",\"distance\":10,\"yardLine\":77,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":23},\"text\":\"(4:10) (Shotgun) K.Cousins pass short middle to D.Cook pushed ob at JAX 3 for 20 yards (M.Jack).\",\"clock\":{\"displayValue\":\"4:10\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.485,\"playId\":\"4012203031452\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":0,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & Goal\",\"possessionText\":\"JAX 3\",\"downDistanceText\":\"1st & Goal at JAX 3\",\"distance\":3,\"yardLine\":97,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":3},\"text\":\"(3:37) D.Cook left tackle to JAX 3 for no gain (J.Jones; J.Giles-Harris).\",\"clock\":{\"displayValue\":\"3:37\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.61,\"playId\":\"4012203031476\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & Goal\",\"possessionText\":\"JAX 3\",\"downDistanceText\":\"2nd & Goal at JAX 3\",\"distance\":3,\"yardLine\":97,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":3},\"text\":\"Adam Thielen 3 Yd pass from Kirk Cousins (Dan Bailey PAT failed)\",\"clock\":{\"displayValue\":\"2:50\"},\"type\":{\"id\":\"67\",\"text\":\"Passing Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.608,\"playId\":\"4012203031497\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":0,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"D.Bailey kicks 65 yards from MIN 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"2:50\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.601,\"playId\":\"4012203031538\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(2:50) (Shotgun) M.Glennon pass incomplete short middle to D.Ogunbowale [I.Odenigbo].\",\"clock\":{\"displayValue\":\"2:50\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.635,\"playId\":\"4012203031553\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"2nd & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":75},\"text\":\"(2:46) (Shotgun) M.Glennon pass short right to J.Robinson to JAX 31 for 6 yards (T.Davis).\",\"clock\":{\"displayValue\":\"2:46\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.62,\"playId\":\"4012203031575\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":4,\"yardLine\":69,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":69},\"text\":\"Two-Minute Warning\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"75\",\"text\":\"Two-minute warning\",\"abbreviation\":\"2Min Warn\"}},\"homeWinPercentage\":0.616,\"playId\":\"4012203031599\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 4\",\"possessionText\":\"JAX 31\",\"downDistanceText\":\"3rd & 4 at JAX 31\",\"distance\":4,\"yardLine\":69,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":69},\"text\":\"(2:00) (Shotgun) M.Glennon pass short left to L.Shenault Jr. to JAX 34 for 3 yards (I.Odenigbo; E.Wilson).\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.657,\"playId\":\"4012203031622\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":1,\"yardLine\":66,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":66},\"text\":\"Timeout #1 by MIN at 01:54.\",\"clock\":{\"displayValue\":\"1:54\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.645,\"playId\":\"4012203031646\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 1\",\"possessionText\":\"JAX 34\",\"downDistanceText\":\"4th & 1 at JAX 34\",\"distance\":1,\"yardLine\":66,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":66},\"text\":\"(1:54) L.Cooke punts 48 yards to MIN 18, Center-R.Matiscik. K.Osborn to MIN 26 for 8 yards (B.Watson).\",\"clock\":{\"displayValue\":\"1:54\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.641,\"playId\":\"4012203031663\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"1st & 10 at MIN 26\",\"distance\":10,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":74},\"text\":\"(1:45) (Shotgun) D.Cook left guard to MIN 28 for 2 yards (J.Schobert; C.Reid).\",\"clock\":{\"displayValue\":\"1:45\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.618,\"playId\":\"4012203031688\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 8\",\"possessionText\":\"MIN 28\",\"downDistanceText\":\"2nd & 8 at MIN 28\",\"distance\":8,\"yardLine\":28,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":72},\"text\":\"(1:28) (No Huddle, Shotgun) PENALTY on JAX-D.Smoot, Neutral Zone Infraction, 5 yards, enforced at MIN 28 - No Play.\",\"clock\":{\"displayValue\":\"1:28\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.646,\"playId\":\"4012203031709\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 3\",\"possessionText\":\"MIN 33\",\"downDistanceText\":\"2nd & 3 at MIN 33\",\"distance\":3,\"yardLine\":33,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":67},\"text\":\"(1:28) (Shotgun) K.Cousins pass short left to D.Cook to MIN 38 for 5 yards (T.Herndon) [A.Lynch].\",\"clock\":{\"displayValue\":\"1:28\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.652,\"playId\":\"4012203031732\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 38\",\"downDistanceText\":\"1st & 10 at MIN 38\",\"distance\":10,\"yardLine\":38,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":62},\"text\":\"(1:14) (Shotgun) K.Cousins pass short left to D.Cook to MIN 39 for 1 yard (T.Herndon).\",\"clock\":{\"displayValue\":\"1:14\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.63,\"playId\":\"4012203031756\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":9,\"yardLine\":39,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":61},\"text\":\"Timeout #2 by MIN at 01:05.\",\"clock\":{\"displayValue\":\"1:05\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.617,\"playId\":\"4012203031780\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"MIN 39\",\"downDistanceText\":\"2nd & 9 at MIN 39\",\"distance\":9,\"yardLine\":39,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":61},\"text\":\"(1:05) (Shotgun) PENALTY on MIN-T.Conklin, False Start, 5 yards, enforced at MIN 39 - No Play.\",\"clock\":{\"displayValue\":\"1:05\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.593,\"playId\":\"4012203031797\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 14\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"2nd & 14 at MIN 34\",\"distance\":14,\"yardLine\":34,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":66},\"text\":\"(1:05) (Shotgun) K.Cousins pass short left to C.Beebe pushed ob at MIN 39 for 5 yards (T.Herndon) [K.Chaisson].\",\"clock\":{\"displayValue\":\"1:05\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.603,\"playId\":\"4012203031820\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 9\",\"possessionText\":\"MIN 39\",\"downDistanceText\":\"3rd & 9 at MIN 39\",\"distance\":9,\"yardLine\":39,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":61},\"text\":\"(1:00) (Shotgun) K.Cousins sacked at MIN 32 for -7 yards (J.Schobert).\",\"clock\":{\"displayValue\":\"1:00\"},\"type\":{\"id\":\"7\",\"text\":\"Sack\"}},\"homeWinPercentage\":0.569,\"playId\":\"4012203031849\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":16,\"yardLine\":32,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":68},\"text\":\"Timeout #1 by JAX at 00:56.\",\"clock\":{\"displayValue\":\"0:56\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.579,\"playId\":\"4012203031868\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 16\",\"possessionText\":\"MIN 32\",\"downDistanceText\":\"4th & 16 at MIN 32\",\"distance\":16,\"yardLine\":32,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":68},\"text\":\"(:56) B.Colquitt punts 45 yards to JAX 23, Center-A.DePaola, fair catch by K.Cole Sr..\",\"clock\":{\"displayValue\":\"0:56\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.587,\"playId\":\"4012203031885\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 23\",\"downDistanceText\":\"1st & 10 at JAX 23\",\"distance\":10,\"yardLine\":77,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":77},\"text\":\"(:49) (Shotgun) M.Glennon pass short right to T.Eifert pushed ob at JAX 27 for 4 yards (C.Jones).\",\"clock\":{\"displayValue\":\"0:49\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.695,\"playId\":\"4012203031904\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 27\",\"downDistanceText\":\"2nd & 6 at JAX 27\",\"distance\":6,\"yardLine\":73,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":73},\"text\":\"(:43) (Shotgun) M.Glennon pass short left to J.Robinson ran ob at JAX 32 for 5 yards (C.Dantzler).\",\"clock\":{\"displayValue\":\"0:43\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.583,\"playId\":\"4012203031928\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 1\",\"possessionText\":\"JAX 32\",\"downDistanceText\":\"3rd & 1 at JAX 32\",\"distance\":1,\"yardLine\":68,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":68},\"text\":\"(:35) (Shotgun) M.Glennon pass incomplete short middle to D.Chark Jr. (H.Smith).\",\"clock\":{\"displayValue\":\"0:35\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.62,\"playId\":\"4012203031957\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"4th & 1\",\"possessionText\":\"JAX 32\",\"downDistanceText\":\"4th & 1 at JAX 32\",\"distance\":1,\"yardLine\":68,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":68},\"text\":\"(:31) L.Cooke punts 47 yards to MIN 21, Center-R.Matiscik, downed by JAX.\",\"clock\":{\"displayValue\":\"0:31\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.483,\"playId\":\"4012203031979\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 21\",\"downDistanceText\":\"1st & 10 at MIN 21\",\"distance\":10,\"yardLine\":21,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":79},\"text\":\"(:18) K.Cousins pass incomplete short right to C.Beebe (A.Lynch).\",\"clock\":{\"displayValue\":\"0:18\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.601,\"playId\":\"4012203031999\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"MIN 21\",\"downDistanceText\":\"2nd & 10 at MIN 21\",\"distance\":10,\"yardLine\":21,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":79},\"text\":\"(:15) (Shotgun) A.Abdullah right guard to MIN 25 for 4 yards (C.Reid).\",\"clock\":{\"displayValue\":\"0:15\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.603,\"playId\":\"4012203032021\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":6,\"yardLine\":25,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":75},\"text\":\"Timeout #2 by JAX at 00:10.\",\"clock\":{\"displayValue\":\"0:10\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.606,\"playId\":\"4012203032042\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"shortDownDistanceText\":\"3rd & 6\",\"possessionText\":\"MIN 25\",\"downDistanceText\":\"3rd & 6 at MIN 25\",\"distance\":6,\"yardLine\":25,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":75},\"text\":\"(:10) (Shotgun) A.Abdullah right tackle to MIN 32 for 7 yards (K.Chaisson).\",\"clock\":{\"displayValue\":\"0:10\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.531,\"playId\":\"4012203032059\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":2},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":0,\"yardLine\":0,\"down\":0,\"yardsToEndzone\":0},\"text\":\"END QUARTER 2\",\"clock\":{\"displayValue\":\"0:00\"},\"type\":{\"id\":\"65\",\"text\":\"End of Half\",\"abbreviation\":\"EH\"}},\"homeWinPercentage\":0.644,\"playId\":\"4012203032086\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":9,\"start\":{\"distance\":0,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 50 yards from JAX 35 to MIN 15, out of bounds.\",\"clock\":{\"displayValue\":\"15:00\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.673,\"playId\":\"4012203032117\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 40\",\"downDistanceText\":\"1st & 10 at MIN 40\",\"distance\":10,\"yardLine\":40,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":60},\"text\":\"Joe Schobert 43 Yrd Interception Return C.McLaughlin extra point is GOOD, Center-R.Matiscik, Holder-L.Cooke.\",\"clock\":{\"displayValue\":\"14:50\"},\"type\":{\"id\":\"36\",\"text\":\"Interception Return Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.329,\"playId\":\"4012203032143\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 65 yards from JAX 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"14:50\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.335,\"playId\":\"4012203032186\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 25\",\"downDistanceText\":\"1st & 10 at MIN 25\",\"distance\":10,\"yardLine\":25,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(14:50) D.Cook left tackle to MIN 26 for 1 yard (J.Schobert).\",\"clock\":{\"displayValue\":\"14:50\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.311,\"playId\":\"4012203032201\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"2nd & 9 at MIN 26\",\"distance\":9,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":74},\"text\":\"(14:21) K.Cousins pass short right to D.Cook pushed ob at MIN 36 for 10 yards (M.Jack).\",\"clock\":{\"displayValue\":\"14:21\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.311,\"playId\":\"4012203032222\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 36\",\"downDistanceText\":\"1st & 10 at MIN 36\",\"distance\":10,\"yardLine\":36,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":64},\"text\":\"(13:49) D.Cook left end to MIN 36 for no gain (J.Schobert; D.Costin).\",\"clock\":{\"displayValue\":\"13:49\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.323,\"playId\":\"4012203032246\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"MIN 36\",\"downDistanceText\":\"2nd & 10 at MIN 36\",\"distance\":10,\"yardLine\":36,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":64},\"text\":\"(13:14) K.Cousins pass incomplete short right to D.Cook [J.Giles-Harris].\",\"clock\":{\"displayValue\":\"13:14\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.299,\"playId\":\"4012203032267\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 10\",\"possessionText\":\"MIN 36\",\"downDistanceText\":\"3rd & 10 at MIN 36\",\"distance\":10,\"yardLine\":36,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":64},\"text\":\"(13:10) (Shotgun) K.Cousins pass to A.Thielen to MIN 47 for 11 yards (L.Barcoo).\",\"clock\":{\"displayValue\":\"13:10\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.363,\"playId\":\"4012203032289\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 47\",\"downDistanceText\":\"1st & 10 at MIN 47\",\"distance\":10,\"yardLine\":47,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":53},\"text\":\"(12:32) M.Boone up the middle to 50 for 3 yards (A.Gotsis). PENALTY on MIN-B.O'Neill, Offensive Holding, 10 yards, enforced at MIN 47 - No Play.\",\"clock\":{\"displayValue\":\"12:32\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.333,\"playId\":\"4012203032319\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 20\",\"possessionText\":\"MIN 37\",\"downDistanceText\":\"1st & 20 at MIN 37\",\"distance\":20,\"yardLine\":37,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":63},\"text\":\"(12:13) K.Cousins pass short right to J.Jefferson to MIN 48 for 11 yards (L.Barcoo).\",\"clock\":{\"displayValue\":\"12:13\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.328,\"playId\":\"4012203032351\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":6,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"MIN 48\",\"downDistanceText\":\"2nd & 9 at MIN 48\",\"distance\":9,\"yardLine\":48,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":52},\"text\":\"(11:41) K.Cousins pass deep right to J.Jefferson pushed ob at JAX 12 for 40 yards (L.Barcoo). Penalty on JAX-L.Barcoo, Defensive Pass Interference, declined.\",\"clock\":{\"displayValue\":\"11:41\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.282,\"playId\":\"4012203032375\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 12\",\"downDistanceText\":\"1st & 10 at JAX 12\",\"distance\":10,\"yardLine\":88,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":12},\"text\":\"C.J. Ham Pass From Kirk Cousins for 12 Yrds D.Bailey extra point is GOOD, Center-A.DePaola, Holder-B.Colquitt.\",\"clock\":{\"displayValue\":\"11:08\"},\"type\":{\"id\":\"67\",\"text\":\"Passing Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.538,\"playId\":\"4012203032410\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"D.Bailey kicks 65 yards from MIN 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"11:08\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.531,\"playId\":\"4012203032451\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(11:08) J.Robinson right end pushed ob at JAX 30 for 5 yards (H.Smith).\",\"clock\":{\"displayValue\":\"11:08\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.521,\"playId\":\"4012203032466\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"distance\":5,\"yardLine\":70,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":70},\"text\":\"Timeout #1 by JAX at 10:28.\",\"clock\":{\"displayValue\":\"10:28\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.536,\"playId\":\"4012203032493\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 5\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"2nd & 5 at JAX 30\",\"distance\":5,\"yardLine\":70,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":70},\"text\":\"(10:28) M.Glennon pass short right to J.Robinson to JAX 36 for 6 yards (K.Boyd).\",\"clock\":{\"displayValue\":\"10:28\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.513,\"playId\":\"4012203032510\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 36\",\"downDistanceText\":\"1st & 10 at JAX 36\",\"distance\":10,\"yardLine\":64,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":64},\"text\":\"(9:47) J.Robinson left end pushed ob at JAX 42 for 6 yards (C.Dantzler).\",\"clock\":{\"displayValue\":\"9:47\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.498,\"playId\":\"4012203032534\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 4\",\"possessionText\":\"JAX 42\",\"downDistanceText\":\"2nd & 4 at JAX 42\",\"distance\":4,\"yardLine\":58,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":58},\"text\":\"(9:23) (Shotgun) M.Glennon pass short right to J.O'Shaughnessy to JAX 48 for 6 yards (E.Wilson; J.Gladney).\",\"clock\":{\"displayValue\":\"9:23\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.475,\"playId\":\"4012203032566\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 48\",\"downDistanceText\":\"1st & 10 at JAX 48\",\"distance\":10,\"yardLine\":52,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":52},\"text\":\"(8:47) J.Robinson up the middle to 50 for 2 yards (E.Yarbrough; S.Stephen).\",\"clock\":{\"displayValue\":\"8:47\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.552,\"playId\":\"4012203032590\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 8\",\"possessionText\":\"50\",\"downDistanceText\":\"2nd & 8 at 50\",\"distance\":8,\"yardLine\":50,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":90},\"text\":\"(8:09) (Shotgun) M.Glennon pass incomplete deep right to C.Johnson.\",\"clock\":{\"displayValue\":\"8:09\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.615,\"playId\":\"4012203032611\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 8\",\"possessionText\":\"50\",\"downDistanceText\":\"3rd & 8 at 50\",\"distance\":8,\"yardLine\":50,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":50},\"text\":\"(8:04) (Shotgun) M.Glennon sacked at JAX 40 for -10 yards (sack split by H.Smith and H.Mata'afa).\",\"clock\":{\"displayValue\":\"8:04\"},\"type\":{\"id\":\"7\",\"text\":\"Sack\"}},\"homeWinPercentage\":0.556,\"playId\":\"4012203032633\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"4th & 18\",\"possessionText\":\"JAX 40\",\"downDistanceText\":\"4th & 18 at JAX 40\",\"distance\":18,\"yardLine\":60,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":60},\"text\":\"(7:26) L.Cooke punts 60 yards to end zone, Center-R.Matiscik, Touchback. PENALTY on MIN-K.Boyd, Illegal Block Above the Waist, 10 yards, enforced at MIN 20.\",\"clock\":{\"displayValue\":\"7:26\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.477,\"playId\":\"4012203032652\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 10\",\"downDistanceText\":\"1st & 10 at MIN 10\",\"distance\":10,\"yardLine\":10,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":90},\"text\":\"(7:17) D.Cook right end pushed ob at MIN 20 for 10 yards (J.Jones).\",\"clock\":{\"displayValue\":\"7:17\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.544,\"playId\":\"4012203032680\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 20\",\"downDistanceText\":\"1st & 10 at MIN 20\",\"distance\":10,\"yardLine\":20,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":80},\"text\":\"(6:50) K.Cousins pass short left to A.Thielen to MIN 29 for 9 yards (M.Jack).\",\"clock\":{\"displayValue\":\"6:50\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.575,\"playId\":\"4012203032706\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 1\",\"possessionText\":\"MIN 29\",\"downDistanceText\":\"2nd & 1 at MIN 29\",\"distance\":1,\"yardLine\":29,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":71},\"text\":\"(6:12) K.Cousins up the middle to MIN 31 for 2 yards (C.Reid).\",\"clock\":{\"displayValue\":\"6:12\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.561,\"playId\":\"4012203032730\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 31\",\"downDistanceText\":\"1st & 10 at MIN 31\",\"distance\":10,\"yardLine\":31,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":69},\"text\":\"(5:38) K.Cousins pass incomplete deep left to J.Jefferson (T.Herndon) [J.Jones]. PENALTY on JAX-J.Jones, Roughing the Passer, 15 yards, enforced at MIN 31 - No Play.\",\"clock\":{\"displayValue\":\"5:38\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.588,\"playId\":\"4012203032751\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 46\",\"downDistanceText\":\"1st & 10 at MIN 46\",\"distance\":10,\"yardLine\":46,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":54},\"text\":\"(5:31) D.Cook left end to MIN 47 for 1 yard (J.Schobert).\",\"clock\":{\"displayValue\":\"5:31\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.559,\"playId\":\"4012203032784\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"MIN 47\",\"downDistanceText\":\"2nd & 9 at MIN 47\",\"distance\":9,\"yardLine\":47,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":53},\"text\":\"(4:58) K.Cousins pass incomplete short left to J.Jefferson (D.Costin) [J.Giles-Harris].\",\"clock\":{\"displayValue\":\"4:58\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.534,\"playId\":\"4012203032805\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 9\",\"possessionText\":\"MIN 47\",\"downDistanceText\":\"3rd & 9 at MIN 47\",\"distance\":9,\"yardLine\":47,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":53},\"text\":\"(4:53) (Shotgun) K.Cousins pass short middle to A.Thielen to JAX 41 for 12 yards (J.Jones) [D.Smoot].\",\"clock\":{\"displayValue\":\"4:53\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.477,\"playId\":\"4012203032827\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 41\",\"downDistanceText\":\"1st & 10 at JAX 41\",\"distance\":10,\"yardLine\":59,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":41},\"text\":\"(4:14) D.Cook right end to JAX 38 for 3 yards (D.Costin; M.Jack).\",\"clock\":{\"displayValue\":\"4:14\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.592,\"playId\":\"4012203032851\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":13,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"JAX 38\",\"downDistanceText\":\"2nd & 7 at JAX 38\",\"distance\":7,\"yardLine\":62,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":38},\"text\":\"(3:40) K.Cousins pass incomplete deep right to J.Jefferson [A.Gotsis]. PENALTY on JAX-L.Barcoo, Defensive Pass Interference, 18 yards, enforced at JAX 38 - No Play.\",\"clock\":{\"displayValue\":\"3:40\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.67,\"playId\":\"4012203032872\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 20\",\"downDistanceText\":\"1st & 10 at JAX 20\",\"distance\":10,\"yardLine\":80,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":20},\"text\":\"Justin Jefferson 20 Yd pass from Kirk Cousins (Dan Bailey PAT failed)\",\"clock\":{\"displayValue\":\"3:27\"},\"type\":{\"id\":\"67\",\"text\":\"Passing Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.729,\"playId\":\"4012203032905\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"D.Bailey kicks 65 yards from MIN 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"3:27\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.722,\"playId\":\"4012203032946\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(3:27) M.Glennon pass incomplete deep left to C.Johnson.\",\"clock\":{\"displayValue\":\"3:27\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.749,\"playId\":\"4012203032961\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"2nd & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":75},\"text\":\"(3:22) (Shotgun) M.Glennon pass short right to C.Johnson to JAX 30 for 5 yards (K.Boyd).\",\"clock\":{\"displayValue\":\"3:22\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.739,\"playId\":\"4012203032983\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 5\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"3rd & 5 at JAX 30\",\"distance\":5,\"yardLine\":70,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":70},\"text\":\"(2:43) (Shotgun) M.Glennon scrambles right end to JAX 32 for 2 yards (J.Brailford). FUMBLES (J.Brailford), RECOVERED by MIN-J.Brailford at JAX 34.\",\"clock\":{\"displayValue\":\"2:43\"},\"type\":{\"id\":\"29\",\"text\":\"Fumble Recovery (Opponent)\"}},\"homeWinPercentage\":0.834,\"playId\":\"4012203033007\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 34\",\"downDistanceText\":\"1st & 10 at JAX 34\",\"distance\":10,\"yardLine\":66,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":34},\"text\":\"(2:24) K.Cousins pass incomplete short right [A.Gotsis].\",\"clock\":{\"displayValue\":\"2:24\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.813,\"playId\":\"4012203033044\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 34\",\"downDistanceText\":\"2nd & 10 at JAX 34\",\"distance\":10,\"yardLine\":66,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":34},\"text\":\"(2:19) D.Cook right end pushed ob at JAX 22 for 12 yards (J.Wilson).\",\"clock\":{\"displayValue\":\"2:19\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.726,\"playId\":\"4012203033066\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 22\",\"downDistanceText\":\"1st & 10 at JAX 22\",\"distance\":10,\"yardLine\":78,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":22},\"text\":\"(1:50) K.Cousins pass short right to A.Thielen to JAX 17 for 5 yards (L.Barcoo).\",\"clock\":{\"displayValue\":\"1:50\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.735,\"playId\":\"4012203033097\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 5\",\"possessionText\":\"JAX 17\",\"downDistanceText\":\"2nd & 5 at JAX 17\",\"distance\":5,\"yardLine\":83,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":17},\"text\":\"(1:16) D.Cook left guard to JAX 11 for 6 yards (J.Giles-Harris).\",\"clock\":{\"displayValue\":\"1:16\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.882,\"playId\":\"4012203033121\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 11\",\"downDistanceText\":\"1st & 10 at JAX 11\",\"distance\":10,\"yardLine\":89,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":11},\"text\":\"(:38) D.Cook up the middle to JAX 1 for 10 yards (J.Wilson; J.Schobert).\",\"clock\":{\"displayValue\":\"0:38\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.9,\"playId\":\"4012203033142\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":3},\"homeScore\":19,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":0,\"down\":1,\"yardsToEndzone\":1},\"text\":\"END QUARTER 3\",\"clock\":{\"displayValue\":\"0:00\"},\"type\":{\"id\":\"2\",\"text\":\"End Period\",\"abbreviation\":\"EP\"}},\"homeWinPercentage\":0.902,\"playId\":\"4012203033163\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & Goal\",\"possessionText\":\"JAX 1\",\"downDistanceText\":\"1st & Goal at JAX 1\",\"distance\":1,\"yardLine\":99,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":1},\"text\":\"(15:00) K.Cousins FUMBLES (Aborted) at JAX 4, RECOVERED by JAX-M.Jack at JAX 2.\",\"clock\":{\"displayValue\":\"15:00\"},\"type\":{\"id\":\"29\",\"text\":\"Fumble Recovery (Opponent)\"}},\"homeWinPercentage\":0.76,\"playId\":\"4012203033182\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 2\",\"downDistanceText\":\"1st & 10 at JAX 2\",\"distance\":10,\"yardLine\":98,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":98},\"text\":\"(14:55) J.Robinson up the middle to JAX 5 for 3 yards (J.Gladney). MIN-J.Gladney was injured during the play. JAX-B.Linder was injured during the play.\",\"clock\":{\"displayValue\":\"14:55\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.776,\"playId\":\"4012203033223\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":19,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"JAX 5\",\"downDistanceText\":\"2nd & 7 at JAX 5\",\"distance\":7,\"yardLine\":95,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":95},\"text\":\"(14:33) J.Robinson left end to JAX 4 for -1 yards (A.Harris). FUMBLES (A.Harris), RECOVERED by MIN-A.Harris at JAX 4. A.Harris to JAX 2 for 2 yards (E.Saubert). The Replay Official reviewed the fumble ruling, and the play was REVERSED. J.Robinson left end to JAX 4 for -1 yards (A.Harris).\",\"clock\":{\"displayValue\":\"14:33\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.797,\"playId\":\"4012203033257\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 8\",\"possessionText\":\"JAX 4\",\"downDistanceText\":\"3rd & 8 at JAX 4\",\"distance\":8,\"yardLine\":96,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":96},\"text\":\"Ifeadi Odenigbo Safety\",\"clock\":{\"displayValue\":\"14:11\"},\"type\":{\"id\":\"20\",\"text\":\"Safety\",\"abbreviation\":\"SF\"}},\"homeWinPercentage\":0.887,\"playId\":\"4012203033335\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":24,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":80},\"text\":\"L.Cooke kicks 56 yards from JAX 20 to MIN 24. K.Osborn to MIN 38 for 14 yards (Q.Williams; D.Middleton).\",\"clock\":{\"displayValue\":\"14:11\"},\"type\":{\"id\":\"12\",\"text\":\"Kickoff Return (Offense)\"}},\"homeWinPercentage\":0.851,\"playId\":\"4012203033354\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 38\",\"downDistanceText\":\"1st & 10 at MIN 38\",\"distance\":10,\"yardLine\":38,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":62},\"text\":\"(14:05) D.Cook up the middle to MIN 41 for 3 yards (D.Smoot).\",\"clock\":{\"displayValue\":\"14:05\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.837,\"playId\":\"4012203033379\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"MIN 41\",\"downDistanceText\":\"2nd & 7 at MIN 41\",\"distance\":7,\"yardLine\":41,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":59},\"text\":\"(13:29) D.Cook up the middle to MIN 41 for no gain (M.Jack).\",\"clock\":{\"displayValue\":\"13:29\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.822,\"playId\":\"4012203033400\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 7\",\"possessionText\":\"MIN 41\",\"downDistanceText\":\"3rd & 7 at MIN 41\",\"distance\":7,\"yardLine\":41,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":59},\"text\":\"(12:52) (Shotgun) K.Cousins pass short left to J.Jefferson to JAX 45 for 14 yards (J.Jones).\",\"clock\":{\"displayValue\":\"12:52\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.877,\"playId\":\"4012203033421\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 45\",\"downDistanceText\":\"1st & 10 at JAX 45\",\"distance\":10,\"yardLine\":55,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":45},\"text\":\"(12:14) D.Cook left guard to JAX 44 for 1 yard (K.Chaisson; M.Jack).\",\"clock\":{\"displayValue\":\"12:14\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.853,\"playId\":\"4012203033445\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"JAX 44\",\"downDistanceText\":\"2nd & 9 at JAX 44\",\"distance\":9,\"yardLine\":56,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":44},\"text\":\"(11:34) K.Cousins pass short left to J.Jefferson to JAX 40 for 4 yards (T.Herndon).\",\"clock\":{\"displayValue\":\"11:34\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.858,\"playId\":\"4012203033466\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 5\",\"possessionText\":\"JAX 40\",\"downDistanceText\":\"3rd & 5 at JAX 40\",\"distance\":5,\"yardLine\":60,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":40},\"text\":\"(10:50) (Shotgun) K.Cousins pass incomplete deep right to J.Jefferson.\",\"clock\":{\"displayValue\":\"10:50\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.81,\"playId\":\"4012203033490\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"4th & 5\",\"possessionText\":\"JAX 40\",\"downDistanceText\":\"4th & 5 at JAX 40\",\"distance\":5,\"yardLine\":60,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":40},\"text\":\"(10:45) B.Colquitt punts 40 yards to end zone, Center-A.DePaola, Touchback.\",\"clock\":{\"displayValue\":\"10:45\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.796,\"playId\":\"4012203033512\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 20\",\"downDistanceText\":\"1st & 10 at JAX 20\",\"distance\":10,\"yardLine\":80,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":80},\"text\":\"(10:32) J.Robinson left end to JAX 22 for 2 yards (H.Hand).\",\"clock\":{\"displayValue\":\"10:32\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.813,\"playId\":\"4012203033529\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 8\",\"possessionText\":\"JAX 22\",\"downDistanceText\":\"2nd & 8 at JAX 22\",\"distance\":8,\"yardLine\":78,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":78},\"text\":\"(9:58) (Shotgun) M.Glennon pass incomplete short middle to J.O'Shaughnessy (E.Wilson).\",\"clock\":{\"displayValue\":\"9:58\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.828,\"playId\":\"4012203033550\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 8\",\"possessionText\":\"JAX 22\",\"downDistanceText\":\"3rd & 8 at JAX 22\",\"distance\":8,\"yardLine\":78,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":78},\"text\":\"(9:51) (Shotgun) M.Glennon pass short left to T.Eifert to JAX 28 for 6 yards (K.Boyd; T.Davis).\",\"clock\":{\"displayValue\":\"9:51\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.848,\"playId\":\"4012203033572\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"4th & 2\",\"possessionText\":\"JAX 28\",\"downDistanceText\":\"4th & 2 at JAX 28\",\"distance\":2,\"yardLine\":72,\"team\":{\"id\":\"30\"},\"down\":4,\"yardsToEndzone\":72},\"text\":\"(9:13) L.Cooke punts 44 yards to MIN 28, Center-R.Matiscik. K.Osborn to MIN 34 for 6 yards (Q.Williams; R.Matiscik). FUMBLES (Q.Williams), and recovers at MIN 34.\",\"clock\":{\"displayValue\":\"9:13\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.66,\"playId\":\"4012203033596\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"1st & 10 at MIN 34\",\"distance\":10,\"yardLine\":34,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":66},\"text\":\"(9:02) D.Cook up the middle to MIN 35 for 1 yard (D.Ekuale).\",\"clock\":{\"displayValue\":\"9:02\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.664,\"playId\":\"4012203033637\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 9\",\"possessionText\":\"MIN 35\",\"downDistanceText\":\"2nd & 9 at MIN 35\",\"distance\":9,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":65},\"text\":\"(8:23) K.Cousins sacked at MIN 26 for -9 yards (D.Ekuale).\",\"clock\":{\"displayValue\":\"8:23\"},\"type\":{\"id\":\"7\",\"text\":\"Sack\"}},\"homeWinPercentage\":0.771,\"playId\":\"4012203033658\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 18\",\"possessionText\":\"MIN 26\",\"downDistanceText\":\"3rd & 18 at MIN 26\",\"distance\":18,\"yardLine\":26,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":74},\"text\":\"(7:41) (Shotgun) D.Cook up the middle to MIN 33 for 7 yards (A.Lynch).\",\"clock\":{\"displayValue\":\"7:41\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.774,\"playId\":\"4012203033677\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"4th & 11\",\"possessionText\":\"MIN 33\",\"downDistanceText\":\"4th & 11 at MIN 33\",\"distance\":11,\"yardLine\":33,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":67},\"text\":\"(7:08) B.Colquitt punts 49 yards to JAX 18, Center-A.DePaola, fair catch by K.Cole Sr..\",\"clock\":{\"displayValue\":\"7:08\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.802,\"playId\":\"4012203033698\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 18\",\"downDistanceText\":\"1st & 10 at JAX 18\",\"distance\":10,\"yardLine\":82,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":82},\"text\":\"(7:01) M.Glennon pass deep left to D.Chark Jr. to JAX 37 for 19 yards (K.Boyd; E.Wilson).\",\"clock\":{\"displayValue\":\"7:01\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.757,\"playId\":\"4012203033726\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 37\",\"downDistanceText\":\"1st & 10 at JAX 37\",\"distance\":10,\"yardLine\":63,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":63},\"text\":\"(6:26) M.Glennon scrambles up the middle to JAX 41 for 4 yards (E.Wilson).\",\"clock\":{\"displayValue\":\"6:26\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.769,\"playId\":\"4012203033750\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 41\",\"downDistanceText\":\"2nd & 6 at JAX 41\",\"distance\":6,\"yardLine\":59,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":59},\"text\":\"(5:39) M.Glennon pass short right to C.Conley to JAX 45 for 4 yards (C.Dantzler). FUMBLES (C.Dantzler), RECOVERED by MIN-C.Dantzler at JAX 44. C.Dantzler to JAX 44 for no gain (J.O'Shaughnessy).\",\"clock\":{\"displayValue\":\"5:39\"},\"type\":{\"id\":\"29\",\"text\":\"Fumble Recovery (Opponent)\"}},\"homeWinPercentage\":0.902,\"playId\":\"4012203033771\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 44\",\"downDistanceText\":\"1st & 10 at JAX 44\",\"distance\":10,\"yardLine\":56,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":44},\"text\":\"(5:29) K.Cousins pass short right to J.Jefferson to JAX 33 for 11 yards (T.Herndon).\",\"clock\":{\"displayValue\":\"5:29\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.923,\"playId\":\"4012203033811\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 33\",\"downDistanceText\":\"1st & 10 at JAX 33\",\"distance\":10,\"yardLine\":67,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":33},\"text\":\"(4:49) D.Cook left tackle to JAX 30 for 3 yards (J.Schobert; M.Jack).\",\"clock\":{\"displayValue\":\"4:49\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.922,\"playId\":\"4012203033835\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"2nd & 7 at JAX 30\",\"distance\":7,\"yardLine\":70,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":30},\"text\":\"(4:08) K.Cousins pass incomplete short right [J.Giles-Harris].\",\"clock\":{\"displayValue\":\"4:08\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.916,\"playId\":\"4012203033856\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":21,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 7\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"3rd & 7 at JAX 30\",\"distance\":7,\"yardLine\":70,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":15},\"text\":\"(4:01) (Shotgun) K.Cousins pass incomplete deep left to J.Jefferson (T.Herndon) [J.Schobert].\",\"clock\":{\"displayValue\":\"4:01\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.776,\"playId\":\"4012203033878\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"4th & 7\",\"possessionText\":\"JAX 30\",\"downDistanceText\":\"4th & 7 at JAX 30\",\"distance\":7,\"yardLine\":70,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":30},\"text\":\"Dan Bailey 48 Yd Field Goal\",\"clock\":{\"displayValue\":\"3:50\"},\"type\":{\"id\":\"59\",\"text\":\"Field Goal Good\",\"abbreviation\":\"FG\"}},\"homeWinPercentage\":0.94,\"playId\":\"4012203033900\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"distance\":0,\"yardLine\":35,\"team\":{\"id\":\"16\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"D.Bailey kicks 65 yards from MIN 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"3:50\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.936,\"playId\":\"4012203033919\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 25\",\"downDistanceText\":\"1st & 10 at JAX 25\",\"distance\":10,\"yardLine\":75,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(3:50) (Shotgun) M.Glennon pass short middle to K.Cole Sr. to JAX 32 for 7 yards (E.Wilson).\",\"clock\":{\"displayValue\":\"3:50\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.919,\"playId\":\"4012203033934\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 3\",\"possessionText\":\"JAX 32\",\"downDistanceText\":\"2nd & 3 at JAX 32\",\"distance\":3,\"yardLine\":68,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":68},\"text\":\"(3:29) (No Huddle, Shotgun) M.Glennon pass short left to J.Robinson to JAX 36 for 4 yards (E.Wilson; A.Harris).\",\"clock\":{\"displayValue\":\"3:29\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.918,\"playId\":\"4012203033958\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 36\",\"downDistanceText\":\"1st & 10 at JAX 36\",\"distance\":10,\"yardLine\":64,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":64},\"text\":\"(2:56) (No Huddle, Shotgun) M.Glennon pass short right to T.Eifert to JAX 46 for 10 yards (C.Dantzler; T.Davis).\",\"clock\":{\"displayValue\":\"2:56\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.905,\"playId\":\"4012203033982\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 46\",\"downDistanceText\":\"1st & 10 at JAX 46\",\"distance\":10,\"yardLine\":54,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":54},\"text\":\"(2:29) (No Huddle, Shotgun) M.Glennon pass incomplete deep right to D.Chark Jr..\",\"clock\":{\"displayValue\":\"2:29\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.928,\"playId\":\"4012203034006\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 46\",\"downDistanceText\":\"2nd & 10 at JAX 46\",\"distance\":10,\"yardLine\":54,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":54},\"text\":\"(2:23) (Shotgun) M.Glennon pass short left to C.Conley to MIN 45 for 9 yards (T.Davis; K.Boyd).\",\"clock\":{\"displayValue\":\"2:23\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.887,\"playId\":\"4012203034028\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"distance\":1,\"yardLine\":45,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":45},\"text\":\"Two-Minute Warning\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"75\",\"text\":\"Two-minute warning\",\"abbreviation\":\"2Min Warn\"}},\"homeWinPercentage\":0.9,\"playId\":\"4012203034052\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 1\",\"possessionText\":\"MIN 45\",\"downDistanceText\":\"3rd & 1 at MIN 45\",\"distance\":1,\"yardLine\":45,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":45},\"text\":\"(2:00) PENALTY on JAX-J.Taylor, False Start, 5 yards, enforced at MIN 45 - No Play.\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.932,\"playId\":\"4012203034069\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"3rd & 6\",\"possessionText\":\"50\",\"downDistanceText\":\"3rd & 6 at 50\",\"distance\":6,\"yardLine\":50,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":50},\"text\":\"(2:00) (Shotgun) M.Glennon pass deep left to D.Chark Jr. pushed ob at MIN 28 for 22 yards (H.Hand).\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.977,\"playId\":\"4012203034092\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 28\",\"downDistanceText\":\"1st & 10 at MIN 28\",\"distance\":10,\"yardLine\":28,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":28},\"text\":\"(1:53) (Shotgun) M.Glennon scrambles left end ran ob at MIN 25 for 3 yards (H.Mata'afa).\",\"clock\":{\"displayValue\":\"1:53\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.881,\"playId\":\"4012203034116\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"2nd & 7\",\"possessionText\":\"MIN 25\",\"downDistanceText\":\"2nd & 7 at MIN 25\",\"distance\":7,\"yardLine\":25,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":25},\"text\":\"(1:46) (Shotgun) M.Glennon pass deep right to C.Johnson to MIN 4 for 21 yards (H.Smith).\",\"clock\":{\"displayValue\":\"1:46\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.771,\"playId\":\"4012203034142\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"shortDownDistanceText\":\"1st & Goal\",\"possessionText\":\"MIN 4\",\"downDistanceText\":\"1st & Goal at MIN 4\",\"distance\":4,\"yardLine\":4,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":4},\"text\":\"(1:18) (No Huddle, Shotgun) D.Ogunbowale up the middle to MIN 1 for 3 yards (J.Brailford).\",\"clock\":{\"displayValue\":\"1:18\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.766,\"playId\":\"4012203034166\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":16,\"start\":{\"distance\":1,\"yardLine\":1,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":1},\"text\":\"Timeout #1 by MIN at 01:12.\",\"clock\":{\"displayValue\":\"1:12\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.77,\"playId\":\"4012203034187\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & Goal\",\"possessionText\":\"MIN 1\",\"downDistanceText\":\"2nd & Goal at MIN 1\",\"distance\":1,\"yardLine\":1,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":1},\"text\":\"James Robinson 1 Yard Rush (Pass formation) TWO-POINT CONVERSION ATTEMPT. M.Glennon pass to C.Johnson is complete. ATTEMPT SUCCEEDS.\",\"clock\":{\"displayValue\":\"1:08\"},\"type\":{\"id\":\"68\",\"text\":\"Rushing Touchdown\",\"abbreviation\":\"TD\"}},\"homeWinPercentage\":0.521,\"playId\":\"4012203034204\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":0,\"yardLine\":65,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 65 yards from JAX 35 to end zone, Touchback.\",\"clock\":{\"displayValue\":\"1:08\"},\"type\":{\"id\":\"53\",\"text\":\"Kickoff\",\"abbreviation\":\"K\"}},\"homeWinPercentage\":0.551,\"playId\":\"4012203034263\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 25\",\"downDistanceText\":\"1st & 10 at MIN 25\",\"distance\":10,\"yardLine\":25,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":75},\"text\":\"(1:08) (Shotgun) D.Cook right end pushed ob at MIN 29 for 4 yards (J.Scott; J.Schobert).\",\"clock\":{\"displayValue\":\"1:08\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.414,\"playId\":\"4012203034278\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"MIN 29\",\"downDistanceText\":\"2nd & 6 at MIN 29\",\"distance\":6,\"yardLine\":29,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":71},\"text\":\"(1:03) (Shotgun) K.Cousins pass short left to C.Beebe pushed ob at MIN 34 for 5 yards (T.Herndon).\",\"clock\":{\"displayValue\":\"1:03\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.442,\"playId\":\"4012203034299\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 1\",\"possessionText\":\"MIN 34\",\"downDistanceText\":\"3rd & 1 at MIN 34\",\"distance\":1,\"yardLine\":34,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":66},\"text\":\"(:58) (Shotgun) D.Cook up the middle to MIN 40 for 6 yards (J.Wilson).\",\"clock\":{\"displayValue\":\"0:58\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.643,\"playId\":\"4012203034323\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":10,\"yardLine\":40,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":60},\"text\":\"Timeout #2 by MIN at 00:53.\",\"clock\":{\"displayValue\":\"0:53\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.618,\"playId\":\"4012203034350\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 40\",\"downDistanceText\":\"1st & 10 at MIN 40\",\"distance\":10,\"yardLine\":40,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":60},\"text\":\"(:53) (Shotgun) K.Cousins pass short middle to A.Abdullah to JAX 42 for 18 yards (J.Scott).\",\"clock\":{\"displayValue\":\"0:53\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.737,\"playId\":\"4012203034367\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 42\",\"downDistanceText\":\"1st & 10 at JAX 42\",\"distance\":10,\"yardLine\":58,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":42},\"text\":\"(:34) (No Huddle, Shotgun) K.Cousins pass incomplete short left [K.Chaisson].\",\"clock\":{\"displayValue\":\"0:34\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.64,\"playId\":\"4012203034391\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":10,\"yardLine\":58,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":42},\"text\":\"Timeout #3 by JAX at 00:29.\",\"clock\":{\"displayValue\":\"0:29\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.642,\"playId\":\"4012203034413\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 42\",\"downDistanceText\":\"2nd & 10 at JAX 42\",\"distance\":10,\"yardLine\":58,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":42},\"text\":\"(:29) (Shotgun) K.Cousins pass short right to J.Jefferson to JAX 33 for 9 yards (L.Barcoo).\",\"clock\":{\"displayValue\":\"0:29\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.835,\"playId\":\"4012203034430\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":1,\"yardLine\":67,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":33},\"text\":\"Timeout #3 by MIN at 00:23.\",\"clock\":{\"displayValue\":\"0:23\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.812,\"playId\":\"4012203034454\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 1\",\"possessionText\":\"JAX 33\",\"downDistanceText\":\"3rd & 1 at JAX 33\",\"distance\":1,\"yardLine\":67,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":33},\"text\":\"(:23) (Shotgun) K.Cousins pass incomplete deep right to A.Thielen (L.Barcoo).\",\"clock\":{\"displayValue\":\"0:23\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.706,\"playId\":\"4012203034471\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"4th & 1\",\"possessionText\":\"JAX 33\",\"downDistanceText\":\"4th & 1 at JAX 33\",\"distance\":1,\"yardLine\":67,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":33},\"text\":\"(:18) D.Bailey 51 yard field goal is No Good, Wide Left, Center-A.DePaola, Holder-B.Colquitt.\",\"clock\":{\"displayValue\":\"0:18\"},\"type\":{\"id\":\"60\",\"text\":\"Field Goal Missed\",\"abbreviation\":\"FGM\"}},\"homeWinPercentage\":0.494,\"playId\":\"4012203034493\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 41\",\"downDistanceText\":\"1st & 10 at JAX 41\",\"distance\":10,\"yardLine\":59,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":59},\"text\":\"(:13) (Shotgun) J.Robinson up the middle to MIN 44 for 15 yards (T.Davis).\",\"clock\":{\"displayValue\":\"0:13\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.452,\"playId\":\"4012203034525\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 44\",\"downDistanceText\":\"1st & 10 at MIN 44\",\"distance\":10,\"yardLine\":44,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":85},\"text\":\"(:02) M.Glennon spiked the ball to stop the clock.\",\"clock\":{\"displayValue\":\"0:01\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.5,\"playId\":\"4012203034546\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"MIN 44\",\"downDistanceText\":\"2nd & 10 at MIN 44\",\"distance\":10,\"yardLine\":44,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":44},\"text\":\"(:01) C.McLaughlin 62 yard field goal is No Good, Short, Center-R.Matiscik, Holder-L.Cooke.\",\"clock\":{\"displayValue\":\"0:01\"},\"type\":{\"id\":\"60\",\"text\":\"Field Goal Missed\",\"abbreviation\":\"FGM\"}},\"homeWinPercentage\":0.502,\"playId\":\"4012203034568\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"period\":{\"number\":4},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":0,\"yardLine\":0,\"down\":0,\"yardsToEndzone\":0},\"text\":\"END QUARTER 4\",\"clock\":{\"displayValue\":\"0:00\"},\"type\":{\"id\":\"79\",\"text\":\"End of Regulation\",\"abbreviation\":\"ER\"}},\"homeWinPercentage\":0.5,\"playId\":\"4012203034588\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":1,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":0,\"yardLine\":0,\"team\":{\"id\":\"30\"},\"down\":0,\"yardsToEndzone\":65},\"text\":\"L.Cooke kicks 65 yards from JAX 35 to MIN 0. A.Abdullah to MIN 24 for 24 yards (S.Quarterman; N.Cottrell).\",\"clock\":{\"displayValue\":\"10:00\"},\"type\":{\"id\":\"12\",\"text\":\"Kickoff Return (Offense)\"}},\"homeWinPercentage\":0.546,\"playId\":\"4012203034607\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":2,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"MIN 24\",\"downDistanceText\":\"1st & 10 at MIN 24\",\"distance\":10,\"yardLine\":24,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":76},\"text\":\"(9:56) K.Cousins sacked at MIN 15 for -9 yards (D.Smoot).\",\"clock\":{\"displayValue\":\"9:56\"},\"type\":{\"id\":\"7\",\"text\":\"Sack\"}},\"homeWinPercentage\":0.348,\"playId\":\"4012203034629\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":3,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 19\",\"possessionText\":\"MIN 15\",\"downDistanceText\":\"2nd & 19 at MIN 15\",\"distance\":19,\"yardLine\":15,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":85},\"text\":\"(9:17) (Shotgun) K.Cousins pass incomplete short middle to K.Rudolph (J.Schobert).\",\"clock\":{\"displayValue\":\"9:17\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.325,\"playId\":\"4012203034648\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":4,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":19,\"yardLine\":15,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":85},\"text\":\"Timeout #1 by MIN at 09:13.\",\"clock\":{\"displayValue\":\"9:13\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.325,\"playId\":\"4012203034670\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":5,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 19\",\"possessionText\":\"MIN 15\",\"downDistanceText\":\"3rd & 19 at MIN 15\",\"distance\":19,\"yardLine\":15,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":85},\"text\":\"(9:13) (Shotgun) K.Cousins pass deep left to J.Jefferson to JAX 38 for 47 yards (J.Wilson) [C.Reid]. PENALTY on MIN-J.Jefferson, Offensive Pass Interference, 7 yards, enforced at MIN 15 - No Play.\",\"clock\":{\"displayValue\":\"9:13\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.255,\"playId\":\"4012203034687\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":6,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 26\",\"possessionText\":\"MIN 8\",\"downDistanceText\":\"3rd & 26 at MIN 8\",\"distance\":26,\"yardLine\":8,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":92},\"text\":\"(8:52) (Shotgun) K.Cousins pass short right to D.Cook to MIN 20 for 12 yards (J.Scott).\",\"clock\":{\"displayValue\":\"8:52\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.083,\"playId\":\"4012203034722\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":7,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"4th & 14\",\"possessionText\":\"MIN 20\",\"downDistanceText\":\"4th & 14 at MIN 20\",\"distance\":14,\"yardLine\":20,\"team\":{\"id\":\"16\"},\"down\":4,\"yardsToEndzone\":80},\"text\":\"(8:16) B.Colquitt punts 52 yards to JAX 28, Center-A.DePaola. K.Cole Sr. to JAX 29 for 1 yard (D.Chisena). PENALTY on JAX-B.Watson, Offensive Holding, 10 yards, enforced at JAX 28.\",\"clock\":{\"displayValue\":\"8:16\"},\"type\":{\"id\":\"52\",\"text\":\"Punt\",\"abbreviation\":\"PUNT\"}},\"homeWinPercentage\":0.52,\"playId\":\"4012203034746\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":8,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 18\",\"downDistanceText\":\"1st & 10 at JAX 18\",\"distance\":10,\"yardLine\":82,\"team\":{\"id\":\"30\"},\"down\":1,\"yardsToEndzone\":82},\"text\":\"(8:06) M.Glennon pass incomplete short right to J.O'Shaughnessy (A.Harris).\",\"clock\":{\"displayValue\":\"8:06\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.593,\"playId\":\"4012203034782\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":9,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 10\",\"possessionText\":\"JAX 18\",\"downDistanceText\":\"2nd & 10 at JAX 18\",\"distance\":10,\"yardLine\":82,\"team\":{\"id\":\"30\"},\"down\":2,\"yardsToEndzone\":82},\"text\":\"(8:01) J.Robinson left end to JAX 20 for 2 yards (K.Boyd; H.Hand).\",\"clock\":{\"displayValue\":\"8:01\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.597,\"playId\":\"4012203034804\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":10,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 8\",\"possessionText\":\"JAX 20\",\"downDistanceText\":\"3rd & 8 at JAX 20\",\"distance\":8,\"yardLine\":80,\"team\":{\"id\":\"30\"},\"down\":3,\"yardsToEndzone\":80},\"text\":\"(7:19) (Shotgun) M.Glennon pass deep middle intended for D.Chark Jr. INTERCEPTED by H.Smith [I.Odenigbo] at JAX 46. H.Smith to JAX 46 for no gain (D.Chark Jr.).\",\"clock\":{\"displayValue\":\"7:19\"},\"type\":{\"id\":\"26\",\"text\":\"Pass Interception Return\",\"abbreviation\":\"INTR\"}},\"homeWinPercentage\":0.764,\"playId\":\"4012203034825\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":11,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 46\",\"downDistanceText\":\"1st & 10 at JAX 46\",\"distance\":10,\"yardLine\":54,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":46},\"text\":\"(7:13) K.Cousins pass short left to A.Thielen to JAX 37 for 9 yards (J.Wilson).\",\"clock\":{\"displayValue\":\"7:13\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.793,\"playId\":\"4012203034851\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":12,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 1\",\"possessionText\":\"JAX 37\",\"downDistanceText\":\"2nd & 1 at JAX 37\",\"distance\":1,\"yardLine\":63,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":37},\"text\":\"(6:41) K.Cousins pass incomplete short right to T.Conklin (J.Jones). PENALTY on MIN-J.Jefferson, Offensive Offside, 5 yards, enforced at JAX 37 - No Play.\",\"clock\":{\"displayValue\":\"6:41\"},\"type\":{\"id\":\"3\",\"text\":\"Pass Incompletion\"}},\"homeWinPercentage\":0.719,\"playId\":\"4012203034875\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":13,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 42\",\"downDistanceText\":\"2nd & 6 at JAX 42\",\"distance\":6,\"yardLine\":58,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":42},\"text\":\"(6:35) K.Cousins pass short middle to T.Conklin to JAX 32 for 10 yards (J.Jones).\",\"clock\":{\"displayValue\":\"6:35\"},\"type\":{\"id\":\"24\",\"text\":\"Pass Reception\",\"abbreviation\":\"REC\"}},\"homeWinPercentage\":0.844,\"playId\":\"4012203034908\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":14,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 32\",\"downDistanceText\":\"1st & 10 at JAX 32\",\"distance\":10,\"yardLine\":68,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":32},\"text\":\"(5:57) D.Cook right guard to JAX 27 for 5 yards (J.Giles-Harris; J.Jones).\",\"clock\":{\"displayValue\":\"5:57\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.883,\"playId\":\"4012203034932\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":15,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 5\",\"possessionText\":\"JAX 27\",\"downDistanceText\":\"2nd & 5 at JAX 27\",\"distance\":5,\"yardLine\":73,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":27},\"text\":\"(5:21) D.Cook left end to JAX 28 for -1 yards (J.Schobert; M.Jack).\",\"clock\":{\"displayValue\":\"5:21\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.871,\"playId\":\"4012203034953\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":16,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 6\",\"possessionText\":\"JAX 28\",\"downDistanceText\":\"3rd & 6 at JAX 28\",\"distance\":6,\"yardLine\":72,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":28},\"text\":\"(4:38) D.Cook up the middle to JAX 18 for 10 yards (J.Jones).\",\"clock\":{\"displayValue\":\"4:38\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.925,\"playId\":\"4012203034974\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":17,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & 10\",\"possessionText\":\"JAX 18\",\"downDistanceText\":\"1st & 10 at JAX 18\",\"distance\":10,\"yardLine\":82,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":18},\"text\":\"(4:03) D.Cook up the middle to JAX 14 for 4 yards (J.Schobert; T.Herndon).\",\"clock\":{\"displayValue\":\"4:03\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.949,\"playId\":\"4012203034995\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":18,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & 6\",\"possessionText\":\"JAX 14\",\"downDistanceText\":\"2nd & 6 at JAX 14\",\"distance\":6,\"yardLine\":86,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":14},\"text\":\"(3:28) D.Cook right end to JAX 11 for 3 yards (D.Costin).\",\"clock\":{\"displayValue\":\"3:28\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.966,\"playId\":\"4012203035016\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":20,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & 3\",\"possessionText\":\"JAX 11\",\"downDistanceText\":\"3rd & 3 at JAX 11\",\"distance\":3,\"yardLine\":89,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":11},\"text\":\"(3:03) D.Cook left guard to JAX 5 for 6 yards (J.Wilson; J.Jones).\",\"clock\":{\"displayValue\":\"3:03\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.981,\"playId\":\"4012203035054\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":19,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":5,\"yardLine\":95,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":5},\"text\":\"Timeout #2 by MIN at 03:03.\",\"clock\":{\"displayValue\":\"3:01\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.966,\"playId\":\"4012203035037\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":21,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"1st & Goal\",\"possessionText\":\"JAX 5\",\"downDistanceText\":\"1st & Goal at JAX 5\",\"distance\":5,\"yardLine\":95,\"team\":{\"id\":\"16\"},\"down\":1,\"yardsToEndzone\":5},\"text\":\"(2:27) D.Cook left guard to JAX 2 for 3 yards (J.Schobert).\",\"clock\":{\"displayValue\":\"2:27\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.992,\"playId\":\"4012203035075\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":22,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":2,\"yardLine\":98,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":2},\"text\":\"Two-Minute Warning\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"75\",\"text\":\"Two-minute warning\",\"abbreviation\":\"2Min Warn\"}},\"homeWinPercentage\":0.992,\"playId\":\"4012203035096\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":23,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"2nd & Goal\",\"possessionText\":\"JAX 2\",\"downDistanceText\":\"2nd & Goal at JAX 2\",\"distance\":2,\"yardLine\":98,\"team\":{\"id\":\"16\"},\"down\":2,\"yardsToEndzone\":2},\"text\":\"(2:00) D.Cook up the middle to JAX 1 for 1 yard (D.Smoot; A.Gotsis).\",\"clock\":{\"displayValue\":\"2:00\"},\"type\":{\"id\":\"5\",\"text\":\"Rush\",\"abbreviation\":\"RUSH\"}},\"homeWinPercentage\":0.996,\"playId\":\"4012203035113\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":24,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"distance\":1,\"yardLine\":99,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":1},\"text\":\"Timeout #1 by JAX at 01:53.\",\"clock\":{\"displayValue\":\"1:53\"},\"type\":{\"id\":\"21\",\"text\":\"Timeout\",\"abbreviation\":\"TO\"}},\"homeWinPercentage\":0.996,\"playId\":\"4012203035134\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":25,\"period\":{\"number\":5},\"homeScore\":24,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & Goal\",\"possessionText\":\"JAX 1\",\"downDistanceText\":\"3rd & Goal at JAX 1\",\"distance\":1,\"yardLine\":99,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":1},\"text\":\"(1:53) PENALTY on MIN-D.Dozier, False Start, 4 yards, enforced at JAX 1 - No Play.\",\"clock\":{\"displayValue\":\"1:53\"},\"type\":{\"id\":\"8\",\"text\":\"Penalty\",\"abbreviation\":\"PEN\"}},\"homeWinPercentage\":0.987,\"playId\":\"4012203035151\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":26,\"period\":{\"number\":5},\"homeScore\":27,\"awayScore\":24,\"start\":{\"shortDownDistanceText\":\"3rd & Goal\",\"possessionText\":\"JAX 5\",\"downDistanceText\":\"3rd & Goal at JAX 5\",\"distance\":5,\"yardLine\":95,\"team\":{\"id\":\"16\"},\"down\":3,\"yardsToEndzone\":5},\"text\":\"Dan Bailey 23 Yd Field Goal\",\"clock\":{\"displayValue\":\"1:49\"},\"type\":{\"id\":\"59\",\"text\":\"Field Goal Good\",\"abbreviation\":\"FG\"}},\"homeWinPercentage\":1,\"playId\":\"4012203035174\",\"tiePercentage\":0,\"secondsLeft\":0},{\"play\":{\"overtimePlayCount\":27,\"period\":{\"number\":5},\"homeScore\":27,\"awayScore\":24,\"start\":{\"distance\":0,\"yardLine\":0,\"down\":1,\"yardsToEndzone\":65},\"text\":\"END GAME\",\"clock\":{\"displayValue\":\"0:00\"},\"type\":{\"id\":\"66\",\"text\":\"End of Game\",\"abbreviation\":\"EG\"}},\"homeWinPercentage\":1,\"playId\":\"4012203035193\",\"tiePercentage\":0,\"secondsLeft\":0}];\n\t\t\t\t\t\n\n\t\t\t\t\t\n\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\t\t\t\t\t\t\n\n\t\t\t\t\t\t\n\n\t\t\t\t\t\tfunction loadScripts() {\n\t\t\t\t\t\t\tvar src = \"https://a.espncdn.com/redesign/0.591.3/js/dist/gamepackage-static.min.js\",\n\t\t\t\t\t\t\t\tscript;\n\t\t\t\t\t\t\t\t\n\t\t\t\t\t\t\tif (espn.gamepackage.status === \"in\") {\n\t\t\t\t\t\t\t\tif (!espn.gamepackage.core) {\n\t\t\t\t\t\t\t\t\tsrc = src.replace(\"gamepackage.\", \"gamepackage.core.\");\n\t\t\t\t\t\t\t\t} else if (espn.gamepackage.bundles && typeof espn.gamepackage.bundles[espn.gamepackage.sport] === \"function\") {\n\t\t\t\t\t\t\t\t\tespn.gamepackage.init();\n\t\t\t\t\t\t\t\t\tespn.gamepackage.bundles[espn.gamepackage.sport]();\n\t\t\t\t\t\t\t\t\treturn;\n\t\t\t\t\t\t\t\t}\n\t\t\t\t\t\t\t} else if (espn.gamepackage.init) {\n\t\t\t\t\t\t\t\tespn.gamepackage.init();\n\t\t\t\t\t\t\t\treturn;\n\t\t\t\t\t\t\t}\n\n\t\t\t\t\t\t\tscript = document.createElement(\"script\");\n\t\t\t\t\t\t\tscript.type = \"text/javascript\";\n\t\t\t\t\t\t\tscript.src = src;\n\t\t\t\t\t\t\tdocument.getElementsByTagName(\"head\")[0].appendChild(script);\n\t\t\t\t\t\t}\n\n\t\t\t\t\t\t\n\t\t\t\t\t\t\tif (window.espn_ui.deferReady === true) {\n\t\t\t\t\t\t\t\t$(document).one(\"page.render\", loadScripts);\n\t\t\t\t\t\t\t} else {\n\t\t\t\t\t\t\t\t$.subscribe(\"espn.defer.end\", loadScripts);\n\t\t\t\t\t\t\t}\n\t\t\t\t\t\t\n\n\t\t\t\t\t\tif( typeof(newrelic) !== \"undefined\" ){\n\t\t\t\t\t\t\tnewrelic.setCustomAttribute( \"game-state\", espn.gamepackage.status );\n\t\t\t\t\t\t}\n\t\t\t\t\t\n\t\t\t\t})(jQuery);\n\t\t\t"

    Now the short of this is that we have the full script text, so there’s a lot of random JavaScript and logic along with HTML around the actual JSON we want. We want to find the “starting edge” and the end of the JSON file, which should be [{ and }] respectively.

    I’ll start by removing all the new lines (\n) and tabs (\t), then finding anything that matches [{ and replace anything before it with [{, followed by the same idea for }].

    This should return a raw string of the JSON content, which we can then parse with jsonlite! Regex is #magic, but in short the pattern of ".*(\\[\\{)" finds any text .* ahead of [{ which needs to be escaped as (\\[\\{) and replaces it with the matched component (\\1) which should be [{. We do that for both the start and end of the JSON file, to remove all the extra text and just get the JSON file itself.

    raw_json_embed <- example_embed_json %>%
  str_remove_all("\\n|\\t") %>% 
  str_replace(".*(\\[\\{)", "\\1") %>% 
  str_replace("(\\}\\]).*", "\\1")

ex_parsed_json <- jsonlite::parse_json(raw_json_embed)

ex_parsed_json %>% enframe()
    # A tibble: 216 × 2
    name value           
   <int> <list>          
 1     1 <named list [5]>
 2     2 <named list [5]>
 3     3 <named list [5]>
 4     4 <named list [5]>
 5     5 <named list [5]>
 6     6 <named list [5]>
 7     7 <named list [5]>
 8     8 <named list [5]>
 9     9 <named list [5]>
10    10 <named list [5]>
# … with 206 more rows

    ESPN’s native API

    Now that was a lot of work to just get at the JSON, but I wanted to show an example of where JSON data is embedded into the site. Alternatively, ESPN has a native pseudo-public API that returns the same data!

    Let’s use that to get the data instead! (Note the summary below shows the full script if you want to skip ahead).

    Full Script 
    espn_url <- "http://site.api.espn.com/apis/site/v2/sports/football/nfl/summary?event=401220303"

raw_espn_json <- httr::GET(espn_url) %>% 
  httr::content()

win_pct_df <- raw_espn_json[["winprobability"]] %>%
  enframe() %>%
  rename(row_id = name) %>%
  unnest_wider(value) %>%
  janitor::clean_names()

pbp_raw_espn <- raw_espn_json[["drives"]][[1]] %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  rename(
    drive_id = id,
    drive_start = start,
    drive_end = end
  ) 

pbp_raw_espn_plays <- pbp_raw_espn %>% 
  unnest_longer(plays) %>% 
  unnest_wider(plays) %>% 
  rename(play_id = id)

espn_pbp_clean <- pbp_raw_espn_plays %>% 
  hoist(
    .col = team,
    pos_team = "name",
    pos_abb = "abbreviation",
    pos_full = "displayName",
    pos_short = 4 # could also use "shortDisplayName"
  ) %>% 
  hoist(
    type,
    play_type_id = "id",
    play_type = "text",
    play_type_abb = "abbreviation"
  ) %>% 
  hoist(
    period,
    quarter = "number"
  ) %>% 
  hoist(
    clock,
    clock = "displayValue"
  ) %>% 
    janitor::clean_names() %>% 
  # drop remaining list columns
  select(-where(is.list))

espn_joined <- left_join(espn_pbp_clean, win_pct_df, by = "play_id") 

final_espn <- espn_joined %>% 
  mutate(
    home_team = raw_espn_json[["boxscore"]][["teams"]][[1]][["team"]][["abbreviation"]],
    away_team = raw_espn_json[["boxscore"]][["teams"]][[2]][["team"]][["abbreviation"]]
    )
    final_espn %>% 
  ggplot(aes(x = row_id, y = 1 - home_win_percentage)) +
  geom_line(size = 1) +
  scale_y_continuous(breaks = c(0, 0.25, .5, .75, 1), labels = c(100, "", 50, "", 100), limits = c(0, 1)) +
  theme_minimal() +
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank()
  ) + 
  labs(x = "", y = "")
    Warning: Removed 1 row(s) containing missing values (geom_path).

    tidyr::hoist()

    We’re going to introduce a new tidyr function in this section called hoist(). You can think of tidyr::hoist() as a way of extracting or hoisting specific list column elements into a new named column. This is especially helpful where the JSON has duplicate names, like id which really means game_id and id which really means play_id. With repeated names, unnest_ functions will error or append names as you’re essentially recreating existing columns.

    espn_url <- "http://site.api.espn.com/apis/site/v2/sports/football/nfl/summary?event=401220303"

raw_espn_json <- httr::GET(espn_url) %>% 
  httr::content()

raw_espn_json %>% str(max.level = 1)
    List of 17
 $ boxscore        :List of 2
 $ format          :List of 2
 $ gameInfo        :List of 3
 $ drives          :List of 1
 $ leaders         :List of 2
 $ broadcasts      : list()
 $ predictor       :List of 3
 $ pickcenter      :List of 4
 $ againstTheSpread:List of 2
 $ odds            : list()
 $ winprobability  :List of 217
 $ header          :List of 8
 $ scoringPlays    :List of 10
 $ news            :List of 3
 $ article         :List of 22
 $ videos          : list()
 $ standings       :List of 2

    Now I’m most interested in the winprobability data, although you could get all sorts of metadata about simple play-by-play, news, etc. This is a VERY long output, so I’m just going to grab the first few.

    raw_espn_json[["winprobability"]] %>% length()
    [1] 217
    raw_espn_json[["winprobability"]] %>% 
  .[1:3] %>% 
  str(max.level = 2)
    List of 3
 $ :List of 4
  ..$ tiePercentage    : num 0
  ..$ homeWinPercentage: num 0.832
  ..$ secondsLeft      : int 0
  ..$ playId           : chr "4012203031"
 $ :List of 4
  ..$ tiePercentage    : num 0
  ..$ homeWinPercentage: num 0.828
  ..$ secondsLeft      : int 0
  ..$ playId           : chr "40122030340"
 $ :List of 4
  ..$ tiePercentage    : num 0
  ..$ homeWinPercentage: num 0.807
  ..$ secondsLeft      : int 0
  ..$ playId           : chr "40122030355"

    Sinec we have a long list of repeated lists of length 4, we can assume that unnest_wider() is the right choice here (4 distinct columns, that are already “long”). We could always rely on unnest_auto() to guess for us and then replace it with the correct function afterwards.

    I’m going to stick with my preferred workflow of tibble::enframe() and then unnest_wider.

    win_pct_df <- raw_espn_json[["winprobability"]] %>%
  enframe() %>%
  rename(row_id = name) %>%
  unnest_wider(value) %>%
  janitor::clean_names()

win_pct_df
    # A tibble: 217 × 5
   row_id tie_percentage home_win_percentage seconds_left play_id     
    <int>          <dbl>               <dbl>        <int> <chr>       
 1      1              0               0.832            0 4012203031  
 2      2              0               0.828            0 40122030340 
 3      3              0               0.807            0 40122030355 
 4      4              0               0.796            0 40122030379 
 5      5              0               0.785            0 401220303108
 6      6              0               0.777            0 401220303129
 7      7              0               0.742            0 401220303150
 8      8              0               0.741            0 401220303191
 9      9              0               0.747            0 401220303213
10     10              0               0.719            0 401220303257
# … with 207 more rows

    Play-by-play

    Now the other datasets we’re interested in are the drive info (for play-by-play), along with the game info like teams playing, play type, period, and time remaining.

    Let’s start with the core JSON data, and then extract the drives data.

    raw_espn_json %>% str(max.level = 1)
    List of 17
 $ boxscore        :List of 2
 $ format          :List of 2
 $ gameInfo        :List of 3
 $ drives          :List of 1
 $ leaders         :List of 2
 $ broadcasts      : list()
 $ predictor       :List of 3
 $ pickcenter      :List of 4
 $ againstTheSpread:List of 2
 $ odds            : list()
 $ winprobability  :List of 217
 $ header          :List of 8
 $ scoringPlays    :List of 10
 $ news            :List of 3
 $ article         :List of 22
 $ videos          : list()
 $ standings       :List of 2
    raw_espn_json[["drives"]][[1]] %>% enframe()
    # A tibble: 30 × 2
    name value            
   <int> <list>           
 1     1 <named list [13]>
 2     2 <named list [13]>
 3     3 <named list [13]>
 4     4 <named list [13]>
 5     5 <named list [13]>
 6     6 <named list [13]>
 7     7 <named list [13]>
 8     8 <named list [13]>
 9     9 <named list [13]>
10    10 <named list [13]>
# … with 20 more rows

    Again we notice that this is already “long” so we can assume we need to unnest_wider(). I’ll also rename a few columns since they’re not very descriptive (and duplicates of other columns).

    pbp_raw_espn <- raw_espn_json[["drives"]][[1]] %>% 
  enframe() %>% 
  unnest_wider(value) %>% 
  rename(
    drive_id = id,
    drive_start = start,
    drive_end = end
  ) 

pbp_raw_espn %>% str(max.level = 2)
    tibble [30 × 14] (S3: tbl_df/tbl/data.frame)
 $ name              : int [1:30] 1 2 3 4 5 6 7 8 9 10 ...
 $ drive_id          : chr [1:30] "4012203031" "4012203032" "4012203033" "4012203034" ...
 $ description       : chr [1:30] "5 plays, 75 yards, 2:27" "3 plays, 12 yards, 1:22" "10 plays, 66 yards, 5:07" "5 plays, 5 yards, 3:08" ...
 $ team              :List of 30
 $ drive_start       :List of 30
 $ drive_end         :List of 30
 $ timeElapsed       :List of 30
 $ yards             : int [1:30] 75 12 66 5 16 8 49 78 9 6 ...
 $ isScore           : logi [1:30] TRUE FALSE TRUE FALSE FALSE FALSE ...
 $ offensivePlays    : int [1:30] 5 3 10 5 4 3 11 10 3 5 ...
 $ result            : chr [1:30] "TD" "PUNT" "FG" "PUNT" ...
 $ shortDisplayResult: chr [1:30] "TD" "PUNT" "FG" "PUNT" ...
 $ displayResult     : chr [1:30] "Touchdown" "Punt" "Field Goal" "Punt" ...
 $ plays             :List of 30

    Let’s go longer

    At this point we can see the data is at the drive level, and the description is the metadata about how long the drive lasted. We want actual plays, and there is a list column named plays. We’ll need to increase the length of the data, so let’s try unnest_longer().

    pbp_raw_espn %>%  
  unnest_longer(plays) %>% 
  str(max.level = 2)
    tibble [217 × 14] (S3: tbl_df/tbl/data.frame)
 $ name              : int [1:217] 1 1 1 1 1 1 2 2 2 2 ...
 $ drive_id          : chr [1:217] "4012203031" "4012203031" "4012203031" "4012203031" ...
 $ description       : chr [1:217] "5 plays, 75 yards, 2:27" "5 plays, 75 yards, 2:27" "5 plays, 75 yards, 2:27" "5 plays, 75 yards, 2:27" ...
 $ team              :List of 217
 $ drive_start       :List of 217
 $ drive_end         :List of 217
 $ timeElapsed       :List of 217
 $ yards             : int [1:217] 75 75 75 75 75 75 12 12 12 12 ...
 $ isScore           : logi [1:217] TRUE TRUE TRUE TRUE TRUE TRUE ...
 $ offensivePlays    : int [1:217] 5 5 5 5 5 5 3 3 3 3 ...
 $ result            : chr [1:217] "TD" "TD" "TD" "TD" ...
 $ shortDisplayResult: chr [1:217] "TD" "TD" "TD" "TD" ...
 $ displayResult     : chr [1:217] "Touchdown" "Touchdown" "Touchdown" "Touchdown" ...
 $ plays             :List of 217

    This gives us 188 plays, but plays is still a list column, so we need to “widen” it with unnest_wider(). Let’s go ahead and do that and then look at what the data looks like.

    pbp_raw_espn_plays <- pbp_raw_espn %>% 
  unnest_longer(plays) %>% 
  unnest_wider(plays) %>% 
  rename(play_id = id)

pbp_raw_espn_plays %>% 
  glimpse()
    Rows: 217
Columns: 29
$ name               <int> 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, …
$ drive_id           <chr> "4012203031", "4012203031", "4012203031", "40122030…
$ description        <chr> "5 plays, 75 yards, 2:27", "5 plays, 75 yards, 2:27…
$ team               <list> ["Jaguars", "JAX", "Jacksonville Jaguars", "Jaguar…
$ drive_start        <list> [["quarter", 1], ["15:00"], 75, "JAX 25"], [["quar…
$ drive_end          <list> [["quarter", 1], ["12:33"], 0, "MIN 0"], [["quarte…
$ timeElapsed        <list> ["2:27"], ["2:27"], ["2:27"], ["2:27"], ["2:27"], …
$ yards              <int> 75, 75, 75, 75, 75, 75, 12, 12, 12, 12, 12, 12, 66,…
$ isScore            <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, F…
$ offensivePlays     <int> 5, 5, 5, 5, 5, 5, 3, 3, 3, 3, 3, 3, 10, 10, 10, 10,…
$ result             <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT",…
$ shortDisplayResult <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT",…
$ displayResult      <chr> "Touchdown", "Touchdown", "Touchdown", "Touchdown",…
$ play_id            <chr> "40122030340", "40122030355", "40122030379", "40122…
$ sequenceNumber     <chr> "4000", "5500", "7900", "10800", "12900", "15000", …
$ type               <list> ["53", "Kickoff", "K"], ["24", "Pass Reception", "…
$ text               <chr> "D.Bailey kicks 65 yards from MIN 35 to end zone, T…
$ awayScore          <int> 0, 0, 0, 0, 0, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, …
$ homeScore          <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
$ period             <list> [1], [1], [1], [1], [1], [1], [1], [1], [1], [1], …
$ clock              <list> ["15:00"], ["15:00"], ["14:25"], ["13:54"], ["13:2…
$ scoringPlay        <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FAL…
$ priority           <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FA…
$ modified           <chr> "2020-12-06T22:12Z", "2020-12-06T22:12Z", "2020-12-…
$ wallclock          <chr> "2020-12-06T18:02:32Z", "2020-12-06T18:03:13Z", "20…
$ start              <list> [0, 0, 35, 65, ["16"]], [1, 10, 75, 75, "1st & 10 …
$ end                <list> [1, 10, 75, 75, "1st & 10 at JAX 25", "1st & 10", …
$ statYardage        <int> 0, 24, 8, 9, 6, 28, 25, 5, 0, 7, 0, 13, 4, 4, 6, 9,…
$ scoringType        <list> <NULL>, <NULL>, <NULL>, <NULL>, <NULL>, ["touchdow…

    Hoist away!

    Looking good! We still have some list-columns to work on though (team, period, clock, start). Let’s pull some selected items from those columns via hoist(). I’m going to start with a small example, and limit the columns shown so that we don’t get overwhelmed.

    pbp_raw_espn_plays %>%
  select(drive_id, play_id, yards, team) %>% 
  slice(1) %>% 
  str(max.level = 4)
    tibble [1 × 4] (S3: tbl_df/tbl/data.frame)
 $ drive_id: chr "4012203031"
 $ play_id : chr "40122030340"
 $ yards   : int 75
 $ team    :List of 1
  ..$ :List of 5
  .. ..$ name            : chr "Jaguars"
  .. ..$ abbreviation    : chr "JAX"
  .. ..$ displayName     : chr "Jacksonville Jaguars"
  .. ..$ shortDisplayName: chr "Jaguars"
  .. ..$ logos           :List of 4

    This shows us that the team list column has 5 named list items within it (name, abbreviation, displayName, shortDisplayName, and another list of lists for logos).

    hoist() takes several arguments, first a column to work on (.col), and then some new columns to create. Note that we’re using raw strings ("name") to pull named list elements from the list column or we could use a number to grab by position.

    pbp_raw_espn_plays %>%
  select(drive_id, play_id, yards, team) %>% 
  hoist(
    .col = team,
    pos_team = "name",
    pos_abb = "abbreviation",
    pos_full = "displayName",
    pos_short = 4 # could also use "shortDisplayName"
  )
    # A tibble: 217 × 8
   drive_id   play_id     yards pos_team pos_abb pos_full pos_short team        
   <chr>      <chr>       <int> <chr>    <chr>   <chr>    <chr>     <list>      
 1 4012203031 40122030340    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 2 4012203031 40122030355    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 3 4012203031 40122030379    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 4 4012203031 4012203031…    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 5 4012203031 4012203031…    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 6 4012203031 4012203031…    75 Jaguars  JAX     Jackson… Jaguars   <named list>
 7 4012203032 4012203031…    12 Vikings  MIN     Minneso… Vikings   <named list>
 8 4012203032 4012203032…    12 Vikings  MIN     Minneso… Vikings   <named list>
 9 4012203032 4012203032…    12 Vikings  MIN     Minneso… Vikings   <named list>
10 4012203032 4012203032…    12 Vikings  MIN     Minneso… Vikings   <named list>
# … with 207 more rows

    Ok, so hopefully that shows you how we can first find the list column elements, and then hoist() a select few of them by name/position. For the next section I’m just going to hoist() the ones I want and then save the dataframe. While there are some other list columns, I’m just going to drop them as I’m not interested in them right now.

    espn_pbp_clean <- pbp_raw_espn_plays %>% 
  hoist(
    .col = team,
    pos_team = "name",
    pos_abb = "abbreviation",
    pos_full = "displayName",
    pos_short = 4 # could also use "shortDisplayName"
  ) %>% 
  hoist(
    type,
    play_type_id = "id",
    play_type = "text",
    play_type_abb = "abbreviation"
  ) %>% 
  hoist(
    period,
    quarter = "number"
  ) %>% 
  hoist(
    clock,
    clock = "displayValue"
  ) %>% 
    janitor::clean_names() %>% 
  # drop remaining list columns
  select(-where(is.list))

    Join the data

    The next thing we have to do is join the Win Probability data with the play-by-play info! This is easy as we have a common key column with play_id.

    espn_joined <- left_join(espn_pbp_clean, win_pct_df, by = "play_id") 

espn_joined %>% 
  glimpse()
    Rows: 217
Columns: 31
$ name                 <int> 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3…
$ drive_id             <chr> "4012203031", "4012203031", "4012203031", "401220…
$ description          <chr> "5 plays, 75 yards, 2:27", "5 plays, 75 yards, 2:…
$ pos_team             <chr> "Jaguars", "Jaguars", "Jaguars", "Jaguars", "Jagu…
$ pos_abb              <chr> "JAX", "JAX", "JAX", "JAX", "JAX", "JAX", "MIN", …
$ pos_full             <chr> "Jacksonville Jaguars", "Jacksonville Jaguars", "…
$ pos_short            <chr> "Jaguars", "Jaguars", "Jaguars", "Jaguars", "Jagu…
$ yards                <int> 75, 75, 75, 75, 75, 75, 12, 12, 12, 12, 12, 12, 6…
$ is_score             <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE,…
$ offensive_plays      <int> 5, 5, 5, 5, 5, 5, 3, 3, 3, 3, 3, 3, 10, 10, 10, 1…
$ result               <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT…
$ short_display_result <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT…
$ display_result       <chr> "Touchdown", "Touchdown", "Touchdown", "Touchdown…
$ play_id              <chr> "40122030340", "40122030355", "40122030379", "401…
$ sequence_number      <chr> "4000", "5500", "7900", "10800", "12900", "15000"…
$ play_type_id         <chr> "53", "24", "24", "5", "5", "67", "12", "24", "3"…
$ play_type            <chr> "Kickoff", "Pass Reception", "Pass Reception", "R…
$ play_type_abb        <chr> "K", "REC", "REC", "RUSH", "RUSH", "TD", NA, "REC…
$ text                 <chr> "D.Bailey kicks 65 yards from MIN 35 to end zone,…
$ away_score           <int> 0, 0, 0, 0, 0, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6…
$ home_score           <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ quarter              <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ scoring_play         <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, F…
$ priority             <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, …
$ modified             <chr> "2020-12-06T22:12Z", "2020-12-06T22:12Z", "2020-1…
$ wallclock            <chr> "2020-12-06T18:02:32Z", "2020-12-06T18:03:13Z", "…
$ stat_yardage         <int> 0, 24, 8, 9, 6, 28, 25, 5, 0, 7, 0, 13, 4, 4, 6, …
$ row_id               <int> 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1…
$ tie_percentage       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ home_win_percentage  <dbl> 0.828, 0.807, 0.796, 0.785, 0.777, 0.742, 0.741, …
$ seconds_left         <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…

    Now there’s one more tricky point, which is that there isn’t a column that says “home” vs “away”.

    ESPN’s JSON reports this simply by position, we can access this data, and will need to create a logical statement in order to assign home vs away.

    raw_espn_json[["boxscore"]][["teams"]] %>% str(max.level = 2)
    List of 2
 $ :List of 2
  ..$ team      :List of 11
  ..$ statistics:List of 25
 $ :List of 2
  ..$ team      :List of 11
  ..$ statistics:List of 25

    From comparing the box scores and the JSON, the team listed first is always the away team. So for this game that means the Jaguars.

    # 1st team == AWAY
raw_espn_json[["boxscore"]][["teams"]][[1]][["team"]][["abbreviation"]]
    [1] "JAX"
    # 2nd team == HOME
raw_espn_json[["boxscore"]][["teams"]][[2]][["team"]][["abbreviation"]]
    [1] "MIN"
    final_espn <- espn_joined %>% 
  mutate(
    home_team = raw_espn_json[["boxscore"]][["teams"]][[1]][["team"]][["abbreviation"]],
    away_team = raw_espn_json[["boxscore"]][["teams"]][[2]][["team"]][["abbreviation"]]
    )

    Just for fun, let’s create a very quick graph to compare against the ESPN Win Percentage plot! Note that we still need to calculate the game seconds (from the clock data), so I’ll just use the row number as the x-axis for now. We can see that this aligns well with the “actual” plot from ESPN’s box score!

    final_espn %>% 
  ggplot(aes(x = row_id, y = 1 - home_win_percentage)) +
  geom_line(size = 1) +
  scale_y_continuous(breaks = c(0, 0.25, .5, .75, 1), labels = c(100, "", 50, "", 100), limits = c(0, 1)) +
  theme_minimal() +
  theme(
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_blank(),
    axis.text.y.right = element_text(size = 24),
    axis.text.x = element_blank()
  ) + 
  labs(x = "", y = "")
    Warning: Removed 1 row(s) containing missing values (geom_path).

    Roll it into a Function

    We can quickly convert that into a function. Eventually this will be rolled into espnscrapeR proper. For now, I just have espnscrapeR::get_espn_win_prob().

    get_espn_pbp <- function(game_id) {
  espn_url <- glue::glue("http://site.api.espn.com/apis/site/v2/sports/football/nfl/summary?event={game_id}")

  raw_espn_json <- fromJSON(espn_url, simplifyVector = FALSE)

  win_pct_df <- raw_espn_json[["winprobability"]] %>%
    enframe() %>%
    rename(row_id = name) %>%
    unnest_wider(value) %>%
    janitor::clean_names()

  espn_df <- raw_espn_json[["drives"]][[1]] %>%
    enframe() %>%
    unnest_wider(value) %>%
    rename(
      drive_id = id,
      drive_start = start,
      drive_end = end
    ) %>%
    unnest_longer(plays) %>%
    unnest_wider(plays)

  pbp_raw_espn_plays <- pbp_raw_espn %>%
    unnest_longer(plays) %>%
    unnest_wider(plays) %>%
    rename(play_id = id)

  espn_pbp_clean <- pbp_raw_espn_plays %>%
    hoist(
      .col = team,
      pos_team = "name",
      pos_abb = "abbreviation",
      pos_full = "displayName",
      pos_short = 4 # could also use "shortDisplayName"
    ) %>%
    hoist(
      type,
      play_type_id = "id",
      play_type = "text",
      play_type_abb = "abbreviation"
    ) %>%
    hoist(
      period,
      quarter = "number"
    ) %>%
    hoist(
      clock,
      clock = "displayValue"
    ) %>%
    janitor::clean_names() %>%
    # drop remaining list columns
    select(-where(is.list))

  espn_joined <- left_join(espn_pbp_clean, win_pct_df, by = "play_id")

  final_espn <- espn_joined %>%
    mutate(
      home_team = raw_espn_json[["boxscore"]][["teams"]][[1]][["team"]][["abbreviation"]],
      away_team = raw_espn_json[["boxscore"]][["teams"]][[2]][["team"]][["abbreviation"]]
    )

  final_espn
}

get_espn_pbp("401220303") %>% glimpse()
    Rows: 217
Columns: 33
$ name                 <int> 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3…
$ drive_id             <chr> "4012203031", "4012203031", "4012203031", "401220…
$ description          <chr> "5 plays, 75 yards, 2:27", "5 plays, 75 yards, 2:…
$ pos_team             <chr> "Jaguars", "Jaguars", "Jaguars", "Jaguars", "Jagu…
$ pos_abb              <chr> "JAX", "JAX", "JAX", "JAX", "JAX", "JAX", "MIN", …
$ pos_full             <chr> "Jacksonville Jaguars", "Jacksonville Jaguars", "…
$ pos_short            <chr> "Jaguars", "Jaguars", "Jaguars", "Jaguars", "Jagu…
$ yards                <int> 75, 75, 75, 75, 75, 75, 12, 12, 12, 12, 12, 12, 6…
$ is_score             <lgl> TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, FALSE, FALSE,…
$ offensive_plays      <int> 5, 5, 5, 5, 5, 5, 3, 3, 3, 3, 3, 3, 10, 10, 10, 1…
$ result               <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT…
$ short_display_result <chr> "TD", "TD", "TD", "TD", "TD", "TD", "PUNT", "PUNT…
$ display_result       <chr> "Touchdown", "Touchdown", "Touchdown", "Touchdown…
$ play_id              <chr> "40122030340", "40122030355", "40122030379", "401…
$ sequence_number      <chr> "4000", "5500", "7900", "10800", "12900", "15000"…
$ play_type_id         <chr> "53", "24", "24", "5", "5", "67", "12", "24", "3"…
$ play_type            <chr> "Kickoff", "Pass Reception", "Pass Reception", "R…
$ play_type_abb        <chr> "K", "REC", "REC", "RUSH", "RUSH", "TD", NA, "REC…
$ text                 <chr> "D.Bailey kicks 65 yards from MIN 35 to end zone,…
$ away_score           <int> 0, 0, 0, 0, 0, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6…
$ home_score           <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ quarter              <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1…
$ scoring_play         <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, F…
$ priority             <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, …
$ modified             <chr> "2020-12-06T22:12Z", "2020-12-06T22:12Z", "2020-1…
$ wallclock            <chr> "2020-12-06T18:02:32Z", "2020-12-06T18:03:13Z", "…
$ stat_yardage         <int> 0, 24, 8, 9, 6, 28, 25, 5, 0, 7, 0, 13, 4, 4, 6, …
$ row_id               <int> 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 1…
$ tie_percentage       <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ home_win_percentage  <dbl> 0.828, 0.807, 0.796, 0.785, 0.777, 0.742, 0.741, …
$ seconds_left         <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0…
$ home_team            <chr> "JAX", "JAX", "JAX", "JAX", "JAX", "JAX", "JAX", …
$ away_team            <chr> "MIN", "MIN", "MIN", "MIN", "MIN", "MIN", "MIN", …

    More ESPN

    Now you may be asking yourself, how the heck do I get the game_id to use with our fancy new function?!

    ESPN provides the “scoreboard” for many sports, including the NFL, you can query it like so, which returns 333 games from 2018 for example. Note that this includes playoffs from the 2017 season (it is just returning any games that were played in the 2018 calendar year).

    espn_scores_url <- "http://site.api.espn.com/apis/site/v2/sports/football/nfl/scoreboard?dates=2018&limit=500"

raw_json_scores <- httr::GET(espn_scores_url) %>% 
  httr::content()

raw_json_scores %>% str(max.level = 1)
    List of 2
 $ leagues:List of 1
 $ events :List of 333

    Looks like we’re interested in the events list element, so let’s take a look at the first few observations in it, and see what we’re working with.

    raw_json_scores[["events"]] %>% 
  .[1:3] %>% # get the first 3 elements
  str(max.level = 2)
    List of 3
 $ :List of 9
  ..$ id          : chr "400999175"
  ..$ uid         : chr "s:20~l:28~e:400999175"
  ..$ date        : chr "2018-01-06T21:20Z"
  ..$ name        : chr "Tennessee Titans at Kansas City Chiefs"
  ..$ shortName   : chr "TEN @ KC"
  ..$ season      :List of 3
  ..$ competitions:List of 1
  ..$ links       :List of 5
  ..$ status      :List of 4
 $ :List of 9
  ..$ id          : chr "400999171"
  ..$ uid         : chr "s:20~l:28~e:400999171"
  ..$ date        : chr "2018-01-07T01:15Z"
  ..$ name        : chr "Atlanta Falcons at Los Angeles Rams"
  ..$ shortName   : chr "ATL @ LAR"
  ..$ season      :List of 3
  ..$ competitions:List of 1
  ..$ links       :List of 3
  ..$ status      :List of 4
 $ :List of 9
  ..$ id          : chr "400999176"
  ..$ uid         : chr "s:20~l:28~e:400999176"
  ..$ date        : chr "2018-01-07T18:05Z"
  ..$ name        : chr "Buffalo Bills at Jacksonville Jaguars"
  ..$ shortName   : chr "BUF @ JAX"
  ..$ season      :List of 3
  ..$ competitions:List of 1
  ..$ links       :List of 5
  ..$ status      :List of 4

    Yep! That’s the one of interest, and we’ve got essentially a data.frame inside each of the list elements. So we can apply our typical workflow of enframe() + unnest_wider().

    espn_games_2018 <- raw_json_scores[["events"]] %>% 
  enframe() %>% 
  rename(row_id = name) %>% 
  unnest_wider(value) %>% 
  rename(game_id = id)

espn_games_2018 %>% 
  glimpse()
    Rows: 333
Columns: 10
$ row_id       <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17…
$ game_id      <chr> "400999175", "400999171", "400999176", "400999177", "4009…
$ uid          <chr> "s:20~l:28~e:400999175", "s:20~l:28~e:400999171", "s:20~l…
$ date         <chr> "2018-01-06T21:20Z", "2018-01-07T01:15Z", "2018-01-07T18:…
$ name         <chr> "Tennessee Titans at Kansas City Chiefs", "Atlanta Falcon…
$ shortName    <chr> "TEN @ KC", "ATL @ LAR", "BUF @ JAX", "CAR @ NO", "ATL @ …
$ season       <list> [2017, 3, "post-season"], [2017, 3, "post-season"], [201…
$ competitions <list> [["400999175", "s:20~l:28~e:400999175~c:400999175", "201…
$ links        <list> [["en-US", ["summary", "desktop", "event"], "https://www…
$ status       <list> [0, "0:00", 4, ["3", "STATUS_FINAL", "post", TRUE, "Fina…

    We still need to grab some information from the season column, and there are few other list-columns if we wanted to further clean the data.

    espn_season_2018 <- espn_games_2018 %>% 
  unnest_wider(season) %>% 
  unchop(competitions)
    espn_season_2018 %>% 
  select(competitions) %>% 
  slice(1) %>% 
  str(max.level = 5)
    tibble [1 × 1] (S3: tbl_df/tbl/data.frame)
 $ competitions:List of 1
  ..$ :List of 19
  .. ..$ id                   : chr "400999175"
  .. ..$ uid                  : chr "s:20~l:28~e:400999175~c:400999175"
  .. ..$ date                 : chr "2018-01-06T21:20Z"
  .. ..$ attendance           : int 73319
  .. ..$ type                 :List of 2
  .. .. ..$ id          : chr "14"
  .. .. ..$ abbreviation: chr "RD16"
  .. ..$ timeValid            : logi TRUE
  .. ..$ neutralSite          : logi FALSE
  .. ..$ conferenceCompetition: logi FALSE
  .. ..$ recent               : logi FALSE
  .. ..$ venue                :List of 5
  .. .. ..$ id      : chr "3622"
  .. .. ..$ fullName: chr "GEHA Field at Arrowhead Stadium"
  .. .. ..$ address :List of 2
  .. .. ..$ capacity: int 72936
  .. .. ..$ indoor  : logi FALSE
  .. ..$ competitors          :List of 2
  .. .. ..$ :List of 11
  .. .. ..$ :List of 11
  .. ..$ notes                :List of 1
  .. .. ..$ :List of 2
  .. ..$ status               :List of 4
  .. .. ..$ clock       : num 0
  .. .. ..$ displayClock: chr "0:00"
  .. .. ..$ period      : int 4
  .. .. ..$ type        :List of 7
  .. ..$ broadcasts           :List of 1
  .. .. ..$ :List of 2
  .. ..$ leaders              :List of 3
  .. .. ..$ :List of 5
  .. .. ..$ :List of 5
  .. .. ..$ :List of 5
  .. ..$ format               :List of 1
  .. .. ..$ regulation:List of 1
  .. ..$ startDate            : chr "2018-01-06T21:20Z"
  .. ..$ geoBroadcasts        :List of 2
  .. .. ..$ :List of 5
  .. .. ..$ :List of 5
  .. ..$ headlines            :List of 1
  .. .. ..$ :List of 3

    hoist again

    So we’re going to use hoist() to again grab specific items from our list columns. Here I’m passing increasing “depth” to hoist() via a list(). While it can be a bit hard to initially wrap your head around, hoist() is similar to native subsetting with R.

    So the following code is roughly equivalent in base R and hoist(). Note that the subsetting base R version with [[ is getting the first element (of 333), so I’m going to grab the first element of our new home_team_id column from our vectorized hoist() call.

    ex_id_subset <- espn_season_2018[["competitions"]][[1]][["competitors"]][[1]][["id"]]

ex_id_hoist <- espn_season_2018 %>%
  hoist(competitions, home_team_id = list("competitors", 1, "id"))

all.equal(ex_id_subset, ex_id_hoist[["home_team_id"]][1])
    [1] TRUE

    So we can now use that same idea to grab a few desired columns. We can sanity check our work by seeing how many games we have of each “type” with a quick count(). There should be 256 regular season games in each season.

    espn_season_2018_final <- espn_season_2018 %>%
  hoist(
    competitions,
    home_team_id = list("competitors", 1, "id"),
    home_team_abb = list("competitors", 1, "team", "abbreviation"),
    away_team_id = list("competitors", 2, "id"),
    away_team_abb = list("competitors", 2, "team", "abbreviation"),
    home_score = list("competitors", 1, "score"),
    away_score = list("competitors", 2, "score")
  ) %>%
  select(-where(is.list), -row_id) %>%
  janitor::clean_names() %>%
  rename(season_type = type) %>%
  mutate(
    season_type = case_when(
      season_type == 1L ~ "Preseason",
      season_type == 2L ~ "Regular Season",
      season_type == 3L ~ "Playoffs",
      TRUE ~ as.character(season_type),
    )
  )

espn_season_2018_final %>% 
  count(season_type)
    # A tibble: 3 × 2
  season_type        n
  <chr>          <int>
1 Playoffs          12
2 Preseason         65
3 Regular Season   256

    We could then find a specific game or purrr::map() across all the games as needed.

    Inside the below detail tag, we have the full method of getting the data as JSON, cleaning/rectangling, and returning as a relatively tidy dataframe.

    ESPN Schedule Function 
    get_espn_schedule <- function(season) {
  espn_scores_url <- glue::glue("http://site.api.espn.com/apis/site/v2/sports/football/nfl/scoreboard?dates={season}&limit=500")

  raw_json_scores <- fromJSON(espn_scores_url, simplifyVector = FALSE)

  espn_games <- raw_json_scores[["events"]] %>%
    enframe() %>%
    rename(row_id = name) %>%
    unnest_wider(value) %>%
    rename(game_id = id)
  
  espn_season <- espn_games %>% 
    unnest_wider(season) %>% 
    unchop(competitions)

  espn_season_final <- espn_season %>%
    hoist(
      competitions,
      home_team_id = list("competitors", 1, "id"),
      home_team_abb = list("competitors", 1, "team", "abbreviation"),
      away_team_id = list("competitors", 2, "id"),
      away_team_abb = list("competitors", 2, "team", "abbreviation"),
      home_score = list("competitors", 1, "score"),
      away_score = list("competitors", 2, "score")
    ) %>%
    select(-where(is.list), -row_id) %>%
    janitor::clean_names() %>%
    rename(season_type = type) %>%
    mutate(
      season_type = case_when(
        season_type == 1L ~ "Preseason",
        season_type == 2L ~ "Regular Season",
        season_type == 3L ~ "Playoffs",
        TRUE ~ as.character(season_type),
      )
    )
  
  espn_season_final
}
    ─ Session info ───────────────────────────────────────────────────────────────
 setting  value
 version  R version 4.2.0 (2022-04-22)
 os       macOS Monterey 12.2.1
 system   aarch64, darwin20
 ui       X11
 language (EN)
 collate  en_US.UTF-8
 ctype    en_US.UTF-8
 tz       America/Chicago
 date     2022-04-28
 pandoc   2.18 @ /Applications/RStudio.app/Contents/MacOS/quarto/bin/tools/ (via rmarkdown)
 quarto   0.9.294 @ /usr/local/bin/quarto

─ Packages ───────────────────────────────────────────────────────────────────
 package     * version date (UTC) lib source
 dplyr       * 1.0.8   2022-02-08 [1] CRAN (R 4.2.0)
 forcats     * 0.5.1   2021-01-27 [1] CRAN (R 4.2.0)
 ggplot2     * 3.3.5   2021-06-25 [1] CRAN (R 4.2.0)
 jsonlite    * 1.8.0   2022-02-22 [1] CRAN (R 4.2.0)
 purrr       * 0.3.4   2020-04-17 [1] CRAN (R 4.2.0)
 reactable   * 0.2.3   2020-10-04 [1] CRAN (R 4.2.0)
 readr       * 2.1.2   2022-01-30 [1] CRAN (R 4.2.0)
 rvest       * 1.0.2   2021-10-16 [1] CRAN (R 4.2.0)
 sessioninfo * 1.2.2   2021-12-06 [1] CRAN (R 4.2.0)
 stringr     * 1.4.0   2019-02-10 [1] CRAN (R 4.2.0)
 tibble      * 3.1.6   2021-11-07 [1] CRAN (R 4.2.0)
 tidyr       * 1.2.0   2022-02-01 [1] CRAN (R 4.2.0)
 tidyverse   * 1.3.1   2021-04-15 [1] CRAN (R 4.2.0)
 xml2        * 1.3.3   2021-11-30 [1] CRAN (R 4.2.0)

 [1] /Library/Frameworks/R.framework/Versions/4.2-arm64/Resources/library

──────────────────────────────────────────────────────────────────────────────
    ]]>     JSON web scraping NFL espnscrapeR https://themockup.blog/posts/2020-12-13-extracting-json-from-websites-and-public-apis-with-r/index.html Sun, 13 Dec 2020 06:00:00 GMT     Bullet Chart Variants in R Thomas Mock https://themockup.blog/posts/2020-11-29-bullet-chart-variants-in-r/index.html

    Bullet Charts

    A bullet chart is a rich variant of the simple bar chart. Most commonly they can be used to replace “flashier” gauges, and are more compact/efficient in their display of multiple measures at once.

    Classically they encode a quantitative measure, a qualitative scale, and a comparison or target measure.

    Figure from Stephen Few via Wikipedia

    The original design of bullet charts can be given to Stephen Few, and the above image is from his blog - perceptualedge.com.

    Others have tried some various strategies to robustly graph these with ggplot2 - notably Bob Rudis’ Rbulletgraph and Ryo Nakagawara/Amit Kohli’s bulletchartr, and my own geom_bullet.

    It’s a hard problem to solve with a general function, given that often the bullet charts don’t typically adhere nicely to a single data frame and tidy-data principles, typically require re-factoring of the input data or external reference data, or at the least require multiple columns to be charted.

    My personal attempts are very much modeled after Bob’s approach, which is layering graph components as opposed a single geom_ call.

    The bulletchartr approach on the other hand (which is relatively similar to my geom_bullet()) is to create a function that takes a summary data frame and plots several columns from the data.

    bulletchartr::bullet_chart(dataframe = bc_ex)

    This is a fine approach for an opinionated take on bullet charts, but I’ll focus on building your own from scratch in case you only want some of the features.

    Component Parts

    We can break down the bullet chart into the comparative range and the quantitative measure. Thus we can approximate the chart by overlaying 2x geom_col() calls in ggplot2.

    tibble(
  name = "Example",
  quant_value = 75,
  qualitative = 100
) %>% 
  ggplot(aes(x = quant_value, y = name)) +
  geom_col(aes(x = qualitative), fill = "grey") +
  geom_col(width = 0.5, fill = "black") +
  coord_cartesian(ylim = c(0.3, 1.7)) +
  theme_minimal() +
  theme(panel.grid.major.y = element_blank())

    Alternatively, we can do it in one call if the data is arranged in a longer format.

    ex_df <- tibble(
  name = rep("Example", 2),
  group = c("Qualitative", "Measure"),
  value = c(100, 75),
  width = c(0.9, 0.5)
)
ex_df %>% 
  ggplot(aes(x = value, y = name, fill = group)) +
  geom_col(width = ex_df$width) +
  coord_cartesian(ylim = c(0.3, 1.7)) +
  scale_fill_manual(values = c("black", "grey")) +
  theme_minimal() +
  theme(panel.grid.major.y = element_blank())

    Add a target

    Next we can also include a target measure. At this point you can see that we’re really stretching what is reasonable for one dataset, as we’re duplicating a lot of values that don’t really need to be duplicated. We could store this outside or indicate them manually but again you can see why this can in theory be generalized, but it’s complex.

    ex_df <- bind_rows(
  tibble(
  name = rep("Ex 1", 2),
  group = c("Qualitative", "Measure"),
  color = c("grey", "black"),
  value = c(100, 75),
  width = c(0.9, 0.5),
  target = rep(82, 2),
  ymin = rep(0.7, 2),
  ymax = rep(1.3, 2)
  ),
  tibble(
  name = rep("Ex 2", 2),
  group = c("Qualitative", "Measure"),
  color = c("grey", "black"),
  value = c(88, 64),
  width = c(0.9, 0.5),
  target = rep(77, 2),
  ymin = rep(1.7, 2),
  ymax = rep(2.3, 2)
  )
)

ex_df %>% 
  ggplot(aes(x = value, y = name, fill = color)) +
  geom_col(width = c(0.9, 0.5, 0.9, 0.5)) +
  geom_linerange(
    aes(x = target, ymin = ymin, ymax = ymax),
    size = 2, color = "red"
    ) +
  coord_cartesian(ylim = c(0.3, 2.7)) +
  scale_fill_identity() +
  theme_minimal() +
  theme(panel.grid.major.y = element_blank())

    Add qualitative ranges

    The next layer of complexity arises around the idea of creating more qualitative ranges (ie poor, good, great). I’ve hidden the code in an expandable section due to the length, but it’s all there! This is an example from an older #TidyTuesday plot I did in 2019.

    Full Code 
    big_epa_cars <- readr::read_csv("https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2019/2019-10-15/big_epa_cars.csv")

cars_clean <- big_epa_cars %>%
  janitor::clean_names()

range_cars <- cars_clean %>%
  filter(!is.na(eng_dscr)) %>%
  filter(year == 2018) %>%
  summarize(
    q50 = quantile(highway08, probs = 0.50),
    q95 = quantile(highway08, probs = 0.95),
    q100 = quantile(highway08, probs = 1.00)
  )

top_cars <- cars_clean %>%
  filter(!is.na(eng_dscr)) %>%
  filter(year == 2018) %>%
  group_by(make) %>%
  top_n(1, city08) %>%
  ungroup() %>%
  filter(make %in% c(
    "Subaru",
    "Volvo",
    "Chevrolet",
    "Ford",
    "Mazda",
    "Honda",
    "Toyota",
    "Volkswagen"
  )) %>%
  distinct(make, .keep_all = TRUE) %>%
  select(make, model, highway08, city08, eng_dscr, year) %>%
  arrange(desc(highway08), city08) %>%
  mutate(
    eng_type = if_else(
      str_detect(eng_dscr, "PHEV|Hybrid"), 
      "Hybrid", "Gas"
      )
    ) %>%
  mutate(make_model = paste(make, eng_type, sep = " - "))

mpg_levels <- top_cars %>%
  arrange(desc(highway08), city08) %>%
  pull(make_model)

plot_cars <- top_cars %>%
  mutate(
    min_mpg = pull(range_cars, q50),
    middle_mpg = pull(range_cars, q95),
    max_mpg = pull(range_cars, q100)
  ) %>%
  mutate(make_model = factor(make_model, levels = rev(mpg_levels)))

bar_cars <- plot_cars %>%
  distinct(make, .keep_all = TRUE)

car_plot <- bar_cars %>%
  ggplot() +
  geom_col(
    aes(x = make_model, y = max_mpg),
    fill = "#A9A9A9",
    width = 0.6,
    alpha = 0.9
  ) +
  geom_col(
    aes(x = make_model, y = middle_mpg),
    fill = "#808080",
    width = 0.6,
    alpha = 0.9
  ) +
  geom_col(
    aes(x = make_model, y = min_mpg),
    fill = "#696969",
    width = 0.6,
    alpha = 0.9
  ) +
  geom_col(
    aes(x = make_model, y = highway08),
    fill = "black",
    color = NA,
    width = 0.2
  ) +
  geom_errorbar(
    aes(x = make_model, ymin = city08, ymax = city08),
    color = "red",
    width = 0.45,
    size = 2
  ) +
  coord_flip() +
  theme_minimal() +
  labs(
    x = "",
    y = "\nMiles per Gallon",
    title = "Some hybrids are more efficient in the <span style='color:#FF0000'>**City**</span> than <span style='color:#000000'>**Highway**</span>",
    subtitle = "Typically, vehicles are more efficient on the highway"
  ) +
  theme(
    panel.grid = element_blank(),
    plot.title = element_markdown(),
    axis.text = element_text(face = "bold")
  ) +
  annotate(
    "text",
    x = c(rep((8 + .45), 4)),
    y = c(
      bar_cars$min_mpg[1] * 0.5,
      bar_cars$middle_mpg[1] * 0.85,
      bar_cars$max_mpg[1] * 0.8,
      bar_cars$city08[1]
    ),
    label = c("Poor", "Good", "Great", "City"),
    color = c(rep("black", 3), "red")
  ) +
  scale_y_continuous(breaks = seq(0, 60, 10)) +
  NULL
    car_plot

    At this point, we’ve essentially recreated the approach of things like geom_bullet() or bulletchartr. As you can see this is a bit of work, but once you have the rough structure setup you could create or use a function (like bulletchartrt) or a geom_ like geom_bullet().

    The buried lede

    The whole reason I got started on this post was my interest in re-creating ESPN’s Playoff Probablity Leverage from Brian Burke’s team. He outlined the process in a nice Twitter thread.

    Number one, these are gorgeous, and I really loved the addition of an example legend rather than a long description, which Brian Burke also noted was an extremly simple explanation of a relatively complex chart. Additionally, he mentioned that they were automated, which is always a driving force for why code is useful!

    We can pretty quickly recreate the basic concept as seen below. Note that I have some additional data collection steps that we’ll go over in just a second.

    team_df %>%
  ggplot(aes(x = win_cur, y = fct_reorder(abb_name, win_pct))) +
  geom_col(aes(x = 100), fill="white", color = "grey", width = 0.7) +
  geom_col(aes(x = win_pct), alpha = 0.5, width = 0.7) +
  geom_col(width = 0.7) +
  labs(x = "Win Probability", y = "")

    We could make these more “bullet-chart-y” by altering the width of the columns, but I honestly think the stacked/alpha approach is more appealing here given the amount of variables. Also, since we’re showing the minimal range and then the potential achievement (leverage) I think the stack is more appropriate than a classical bullet. Regardless, both can work and I’ll leave it up to the reader to decide which is more informative.

    team_df %>%
  ggplot(aes(x = win_cur, y = fct_reorder(abb_name, win_pct))) +
  geom_col(aes(x = 100), fill="white", color = "grey", width = 0.7) +
  geom_col(aes(x = win_pct), alpha = 0.5, width = 0.7) +
  geom_col(width = 0.3) +
  labs(x = "Win Probability", y = "")

    So the next step is to add in team colors, replace team names with logos, and add the explanatory legend.

    Data Collection

    I’m going to be getting team standings, colors and logos from my own espnscrapeR. Also, to cheat I’m not going to do the 20K simulations that ESPN and many others do to create the underlying data, but rather “borrow” the data from the original chart. Note I’m also loading patchwork for combining plots, and ggtext to use for the team logos on the axis. Lastly, I’m using a few custom fonts which I’ll load via the systemfonts package.

    Returning 2020
    team_meta <- espnscrapeR::get_nfl_teams() %>% 
  select(abb_name = team_abb, team_color)
    Getting NFL teams!
    team_df <- teams %>% 
  select(abb_name = team_abb, logos = team_logo, playoff_seed = seed) %>% 
  left_join(team_meta) %>% 
  group_by(playoff_seed) %>% 
  mutate(
    count = row_number(),
    conf = if_else(count == 1, "AFC", "NFC")) %>% 
  ungroup() %>% 
  filter(conf == "AFC") %>% 
  mutate(
    win_cur = c(
      99, 99, 81, 60, 73, 59, 52, 59, 16, 1, 3, 1, 1, 1, 0, 0
    ),
    win_pct = c(
    99,99.01,94, 91, 95, 83, 69, 86, 39, 3, 13, 1, 1,1,1, 0
    ),
    win_chg = round(win_pct - win_cur, 1)
  ) %>% 
  mutate(
    abb_name = factor(abb_name),
    abb_name = fct_reorder(abb_name, win_pct, .desc = TRUE),
    abb_name = fct_rev(abb_name)
  ) %>% 
  arrange(desc(win_pct))
    Joining, by = "abb_name"

    I’ve also defined a function to take the logo url and convert it to a HTML <img> tag which ggtext can then plot in ggplot2 for us!

    link_to_img <- function(x, width = 30) {
  glue::glue("<img src='{x}' width='{width}'/>")
}

    Plot with colors/logos

    I’m really pleased with this, as it’s a very close approximation of the original, and Brian Burke did a great job on the original aesthetics. We still need to create the legend plot and then “attach” it to the bottom of this plot. We can combine the plots with patchwork, but first let’s try building it!

    team_logo_plot <- team_df %>%
  mutate(logos = link_to_img(logos)) %>% 
  ggplot(aes(x = win_cur, y = fct_reorder(logos, win_pct), fill = team_color)) +
  geom_text(
    aes(x = 100, label = paste0(win_chg, "%")), 
    nudge_x = 6, hjust = 1, fontface= "bold", family = "Chivo", size = 6
    ) +
  geom_col(aes(x = 100), fill="white", color = "grey", width = 0.7) +
  geom_col(aes(x = win_pct), alpha = 0.5, width = 0.7) +
  geom_col(width = 0.7) +
  scale_fill_identity() +
  scale_x_continuous(breaks = c(25, 50, 75), labels = scales::percent_format(scale = 1)) +
  theme_minimal() +
  theme(
    text = element_text(family = "Chivo"),
    panel.grid.major.y = element_blank(),
    panel.grid.minor = element_blank(),
    panel.grid.major.x = element_line(color = "grey", size = 0.2),
    panel.ontop = TRUE,
    axis.text.y = element_markdown(margin = margin(r = -25, unit = "pt")),
    axis.text.x = element_text(size = 16, color = "grey"),
    plot.title = element_text(size = 36, face = "bold"),
    plot.subtitle = element_text(size = 24),
    plot.margin = unit(c(0.5, 1.5, 0.5, 1.5), "cm")
  ) +
  labs(
    x = "", y = "", 
    title = "Playoff Probability Leverage",
    subtitle = "AFC Week 12"
  )

    Create a legend

    I’m going to be creating a few dataframes to plot in my legend. These include labels, and some “segments” to create the lines around the labels.

    # Core dataset with the basic labels
label_df <- tibble(
  x = c(15, 15, 77, 101),
  y = c(1.6, 0.35, 0.35, 1),
  label = c("Chance to make playoffs with win ", "Chance to make playoffs with loss ", "Leverage", "X%")
)


# the horizontal lines
seg_df <- tibble(
  x1 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
  x2 = c(0.2, 90, 0.2, 74.8, 75.3, 90, 103),
  y1 = c(1.3, 1.3, rep(.7, 5)),
  y2 = c(1.61, 1.61, rep(.343, 5))

)

# vertical lines
seg2_df <- tibble(
  x1 = c(0.2, 0.2, 75.3),
  x2 = c(90, 74.8, 103),
  y1 = c(1.6, .35, .35),
  y2 = c(1.6, .35, .35)
)

    The first plot is very simple, and close to our examples at the very beginning of this post!

    legend_plot <- tibble(
  x = 75,
  y = factor("Y"),
  x2 = 90
) %>%
  ggplot(aes(x = x, y = y)) +
  geom_col(aes(x = 100), fill = "white", color = "grey", width = 0.4) +
  geom_col(aes(x = x2), width = 0.4, color = "#DC143C", fill = "grey") +
  geom_col(width = 0.4, color = "black", fill = "black")

legend_plot

    You’ll notice a few things. Since our y-axis is a factor it’s essentially an integer where Y == 1. Each additional factor will be placed at N + 1

    legend_plot +
  geom_text(aes(x = 50, y = 1, label = "Label at 1"), color = "red", size = 8) +
  geom_text(aes(x = 50, y = 1.5, label = "Label at 1.5"), color = "red", size = 8)

    Since we can place labels above or below or measure of interest, we can use that concept to create line segments via