{"id":12794,"date":"2020-07-24T16:25:15","date_gmt":"2020-07-24T21:25:15","guid":{"rendered":"https:\/\/rud.is\/b\/?p=12794"},"modified":"2020-07-24T16:25:15","modified_gmt":"2020-07-24T21:25:15","slug":"aligning-the-dots-on-covid-prison-waffles","status":"publish","type":"post","link":"https:\/\/rud.is\/b\/2020\/07\/24\/aligning-the-dots-on-covid-prison-waffles\/","title":{"rendered":"Aligning the Dots On COVID Prison Waffles"},"content":{"rendered":"

The Marshall Project has a solid story and set of visualizations<\/a> on the impact of COVID-19 in U.S. prisons. They keep the data (and vis) regularly updated. They do great work and this is an important topic, but this visualization breaks my “ordered grid” OCD:<\/p>\n

\"\"<\/a><\/p>\n

To be fair, it’s not supposed to line up as the dots are part of an animation process that has them drop from top to bottom and appears to be designed to have an “organic” feel.<\/p>\n

We can use the {waffle} package to iron out these wrinkled non-grids into some semblance of order, and try to replicate the chart as much as possible along the way.<\/p>\n

Getting the Data<\/h3>\n

We first need the data and, thankfully, the MP folks provided it…just not in a way you’d expect (or that’s straightforward to use).<\/p>\n

Do a “view source” on that URL in your browser and scroll down to line ~1,455 and you should see this:<\/p>\n

\"\"<\/a><\/p>\n

That’s the data, right on the page, encoded in javascript?. This makes sense as it is fueling a javascript visualization and many sites are embedding data right on the page vs fetch via an XHR request to make it easier for web archives to store and retrieve working visualizations. We can totally work with this data, and we’ll do that now, along with getting some boilerplate out of the way:<\/p>\n

library(V8)         # work with javascript data\nlibrary(stringi)    # string ops\nlibrary(rvest)      # web scrape\nlibrary(ggtext)     # pretty ggplot text with markdown\nlibrary(waffle)     # waffle charts \/\/ install_github(\"hrbrmstr\/waffle\")\nlibrary(hrbrthemes) # install_github(\"hrbrmstr\/hrbrthemes\") or don't use the font theme and pick another one\nlibrary(tidyerse)   # duh\n\ngg <- glue::glue # for plot labels (later)\n\n# get the page source\npg <- read_html(\"https:\/\/www.themarshallproject.org\/2020\/05\/01\/a-state-by-state-look-at-coronavirus-in-prisons\")\n\n# setup a V8 VM context\nctx <- v8()\n\n# grab the \"data\" and make it a V8 VM object\nhtml_nodes(pg, xpath=\".\/\/script[contains(., 'var STATES_DATA')]\") %>%\n  html_text() %>%\n  ctx$eval()\n\n# get the data into R\nstates_data <- ctx$get(\"STATES_DATA\")\n\nglimpse(states_data)\n## Rows: 918\n## Columns: 20\n## $ ``                 <chr> \"1\", \"2\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\", \"10\", \"11\", \"12\", \"13\", \"14\", \"15\", \"16\", \"17\", \"18\", \"19\", \"20\",\u2026\n## $ name               <chr> \"Alabama\", \"Alaska\", \"Arizona\", \"Arkansas\", \"California\", \"Colorado\", \"Connecticut\", \"Delaware\", \"Florida\", \"G\u2026\n## $ abbreviation       <chr> \"AL\", \"AK\", \"AZ\", \"AR\", \"CA\", \"CO\", \"CT\", \"DE\", \"FL\", \"GA\", \"HI\", \"ID\", \"IL\", \"IN\", \"IA\", \"KS\", \"KY\", \"LA\", \"M\u2026\n## $ week_of            <chr> \"2020-03-26\", \"2020-03-26\", \"2020-03-26\", \"2020-03-26\", \"2020-03-26\", \"2020-03-26\", \"2020-03-26\", \"2020-03-26\"\u2026\n## $ unrevised_cases    <chr> \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"N\u2026\n## $ cases              <chr> \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"NA\", \"0\", \"0\", \"4\", \"0\", \"0\", \"3\", \"0\", \"0\", \"0\", \"NA\", \"0\", \"0\", \"0\", \"9\", \"23\u2026\n## $ new_cases          <chr> \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"NA\", \"0\", \"0\", \"4\", \"0\", \"0\", \"3\", \"0\", \"0\", \"0\", \"NA\", \"0\", \"0\", \"0\", \"9\", \"23\u2026\n## $ filled_cases       <chr> \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"0\", \"0\", \"0\", \"4\", \"0\", \"0\", \"3\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"9\", \"23\",\u2026\n## $ case_rate          <chr> \"0\", \"0\", \"0\", \"0\", \"0.0812809883768187\", \"0\", \"NA\", \"0\", \"0\", \"0.728318857996031\", \"0\", \"0\", \"0.7865757734661\u2026\n## $ deaths             <chr> \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"NA\", \"0\", \"0\", \"0\", \"0\", \"0\",\u2026\n## $ new_deaths         <chr> \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"NA\", \"0\", \"0\", \"0\", \"0\", \"0\",\u2026\n## $ filled_deaths      <chr> \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"1\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \u2026\n## $ death_rate         <chr> \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0.182079714499008\", \"0\", \"0\", \"0\", \"0\", \"0\", \"0\", \"NA\", \"0\", \"0\"\u2026\n## $ staff_multiples    <chr> \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"N\u2026\n## $ prisoner_multiples <chr> \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"NA\", \"N\u2026\n## $ tested             <chr> \"NA\", \"4\", \"15\", \"0\", \"166\", \"NA\", \"NA\", \"4\", \"NA\", \"NA\", \"NA\", \"10\", \"13\", \"NA\", \"NA\", \"0\", \"NA\", \"32\", \"NA\",\u2026\n## $ as_of_date         <chr> \"NA\", \"2019-12-31\", \"2020-04-15\", \"2020-02-29\", \"2020-04-15\", \"NA\", \"NA\", \"2020-04-15\", \"NA\", \"NA\", \"NA\", \"202\u2026\n## $ march_pop          <chr> \"NA\", \"4997\", \"42282\", \"18181\", \"123030\", \"NA\", \"NA\", \"5042\", \"NA\", \"NA\", \"NA\", \"7816\", \"38140\", \"NA\", \"NA\", \"\u2026\n## $ april_pop          <chr> \"NA\", \"4997\", \"41674\", \"18181\", \"118466\", \"NA\", \"NA\", \"4624\", \"NA\", \"NA\", \"NA\", \"7641\", \"36904\", \"NA\", \"NA\", \"\u2026\n## $ test_rate          <chr> \"NA\", \"8.00480288172904\", \"3.54760891159359\", \"0\", \"13.4926440705519\", \"NA\", \"NA\", \"7.93335977786593\", \"NA\", \"\u2026\n<\/code><\/pre>\n
The comments in the code go a long way, but jist is that we extract out the javascript block containing that var STATES_DATA\u2026<\/code> data, have {V8} wrangle it in javascript for us, then get the result and take a look at it. Now for the real work.<\/p>\n
Making the Data Useful<\/h3>\n
We need \u2014 at a minimum \u2014 dates and numbers. We’re also going to mimic the visualization, so we’ll be dividing new case counts by 10 for the “1 dot == 10 cases” waffle chart and creating useful axis labels. This is pretty basic wrangling:<\/p>\n
states_data %>% \n  select(week_of, new_cases) %>% \n  mutate(\n    week_of = as.Date(week_of),\n    new_cases = suppressWarnings(as.numeric(new_cases))\n  ) %>%\n  count(week_of, wt = new_cases) %>%\n  arrange(week_of) %>%\n  mutate(\n    wk = format(week_of, \"Week of\\n%b %d\"),\n    div10 = as.integer(round(n\/10)),\n  ) %>%\n  as_tibble() -> cases\n\nglimpse(cases)\n## Rows: 18\n## Columns: 4\n## $ week_of <date> 2020-03-26, 2020-04-01, 2020-04-08, 2020-04-15, 2020-04-22, 2020-04-29, 2020-05-06, 2020-05-13, 2020-05-20, 2020-05-27, \u2026\n## $ n       <dbl> 56, 268, 810, 1672, 6872, 4788, 5538, 5115, 3940, 5323, 6027, 3335, 2258, 2452, 3856, 4488, 7324, 6595\n## $ wk      <chr> \"Week of\\nMar 26\", \"Week of\\nApr 01\", \"Week of\\nApr 08\", \"Week of\\nApr 15\", \"Week of\\nApr 22\", \"Week of\\nApr 29\", \"Week o\u2026\n## $ div10   <int> 6, 27, 81, 167, 687, 479, 554, 512, 394, 532, 603, 334, 226, 245, 386, 449, 732, 660\n<\/code><\/pre>\n
Using the {waffle} package to make “waffle bar charts” means we’ll end up with panels\/strips which will become “axis labels”. I like the fact that the MP folks did not label each week, so we’ll have to account for that as well. One of the simplest ways to do that is to make those labels spaces, but a unique number of them since we’re going to make an ordered factor to ensure the strips are in the right order. This is also pretty straightforward:<\/p>\n
cases$wk[c(1, 3:5, 7:9, 11:13, 15:17)] <- stri_pad(\"\", 1:13)\ncases$wk <- fct_inorder(cases$wk)\n<\/code><\/pre>\n
The vector of numbers in the first line are the weeks we want to be blank and we’ll turn them into space-padded strings, each with an increasing number of spaces, then we’ll turn the entire vector of weeks into a factor in the right order.<\/p>\n
Making the Chart<\/h3>\n
The rest is all {ggplot2} magic, so let’s get the whole plot code out of the way before talking about it:<\/p>\n
ggplot() +\n  geom_waffle(\n    data = cases,\n    aes(fill = \"new cases\", values = div10),\n    flip = TRUE, n_cols = 10, radius = unit(3, \"pt\"),           \n    color = \"white\"\n  ) +\n  geom_text(\n    data = tibble(\n      idx = c(1, 17, 18),\n      wk = cases$wk[idx],\n      y = (cases$div10[idx] %\/% 10),\n      actual_cases = cases$n[idx],\n      lab = gg(\"{scales::comma(actual_cases, 1)} new\\ncases\")\n    ),\n    aes(1, y, label = lab),\n    vjust = 0, hjust = 0, nudge_y = 2,\n    size = 3.5, family = font_gs, lineheight = 0.875\n  ) +\n  scale_y_continuous(\n    expand = c(0, 0.125),\n    breaks = seq(0, 70, 10),\n    labels = scales::comma(seq(0, 7000, 1000)),\n    limits = c(0, 80)\n  ) +\n  scale_fill_manual(\n    values = c(\"#366b7b\")\n  ) +\n  facet_wrap(~wk, nrow=1, strip.position = \"bottom\") +\n  coord_fixed() +\n  labs(\n    x = NULL, y = NULL,\n    title = \"There have been at least<br\/><span style='color:#366b7b;font-size:32pt;'>**70,717**<\/span> <span style='font-size:24pt'>cases<\/span><br\/>of coronavirus reported among prisoners.<br\/><span style='font-size:18pt;'>**46,846** prisoners have recovered.<\/span>\",\n    subtitle = \"Each <span style='color:#366b7b;font-size:16pt;'>&bull;<\/span> represents 10 new cases.\",\n    caption = \"Source: (data) <www.themarshallproject.org\/2020\/05\/01\/a-state-by-state-look-at-coronavirus-in-prisons>\"\n  ) +\n  theme_ipsum_gs(\n    grid=\"Y\",\n    strip_text_family = font_gs, strip_text_face = \"plain\",\n    plot_title_family = font_gs, plot_title_face = \"plain\",\n    subtitle_family = font_an, subtitle_face = \"plain\", subtitle_size = 10\n  ) +\n  theme(\n    legend.position = \"none\",\n    strip.text = element_text(hjust = 0.5),\n    axis.text.x = element_blank(),\n    panel.spacing.x = unit(20, \"pt\"),\n    plot.title = element_markdown(),\n    plot.subtitle = element_markdown(),\n  )\n<\/code><\/pre>\n
There’s quite a bit going on there, so let’s break it down:<\/p>\n