index.Rmd

---
title: "Carnegie Mellon's COVIDcast for Indiana"
output:
   flexdashboard::flex_dashboard:
      orientation: rows
      vertical_layout: scroll
      social: menu
      source_code: embed
      theme: yeti
      css: covidcast-style.css
      favicon: images/ind-state-fav.png
      logo: images/rsz_ind-state-logo.png
      navbar:
         - {icon: "fa-arrow-alt-circle-left", href: "https://ercbk.github.io/Indiana-COVID-19-Website/static.html", align: right, title: "Back to Tracker"}
---



```{r setup-data}
pacman::p_load(extrafont, dplyr, glue, leaflet, leaflet.extras, plotly, crosstalk, htmltools, reactable, dataui)

# clean combined indicator datasets for line, leaflet, and dumbbell charts
ci_clean_line <- readr::read_rds(glue("{rprojroot::find_rstudio_root_file()}/data/dash-ci-line.rds"))
ci_clean_leaf <- readr::read_rds(glue("{rprojroot::find_rstudio_root_file()}/data/dash-ci-leaf.rds"))
ci_clean_db <- readr::read_rds(glue("{rprojroot::find_rstudio_root_file()}/data/dash-ci-db.rds"))

# reactable/sparkline data
react_dat <- readr::read_rds(glue("{rprojroot::find_rstudio_root_file()}/data/dash-case-pos.rds"))
react_dates <- readr::read_rds(glue("{rprojroot::find_rstudio_root_file()}/data/dash-case-pos-dates.rds"))


```




```{r shared}

# {crosstalk} functions so charts can react to selections
ci_shared_line <- SharedData$new(ci_clean_line,
                                 ~name,
                                 group = "covidcast")
ci_shared_leaf <- SharedData$new(ci_clean_leaf,
                                 ~name,
                                 group = "covidcast")
ci_shared_db <- SharedData$new(ci_clean_db,
                               ~name,
                               group = "covidcast")
react_shared <- SharedData$new(react_dat,
                               ~msa,
                               group = "covidcast")

```

<!-- js code fixes flexdashboard issue with reactable not loading/resizing when starting on About tab and going to Dashboard tab -->
<script>
$(document).on('shown.bs.tab',function() { HTMLWidgets. staticRender() })
</script>



About {data-icon="fa-question-circle"}
=====================================


![](https://github.com/ercbk/Indiana-COVIDcast-Dashboard/workflows/covidcast-update/badge.svg)  
Changelog located in [NEWS.md](https://github.com/ercbk/Indiana-COVID-19-Tracker/blob/master/NEWS.md)

<H2>Description</H2>

Carnegie Mellon University's Delphi Research Group derives it's **"Combined" indicator** from multiple data sources that include:<br>

<UL>
<LI><U>Doctor Visits</U> - Percentage of doctor's visits that are due to COVID-like symptoms<br> 
<LI><U>Symptoms</U> (Facebook) - Random Facebook users are directed to a survey that asks for the number of household members with COVID-like symptoms.<br>
<LI><U>Symptoms in Community</U> (Facebook) - Same as for "Symptoms" but asks about people they know outside of their household.<br>
<LI><U>Search Trends</U> (Google) - Google searchs for COVID-related topics relative to an area's population<br>
</UL>
<P>

The higher the combined indicator value, the greater the signaling of higher COVID-19 prevalence in that [metropolitan area (MSA)](https://www.census.gov/programs-surveys/metro-micro/about.html). The value has no upper bound, but for reference, here are some of the combined indicator values from some of the hotspots around the country as of July 3rd, 2020.<br>
<UL>
<LI>San Antonio, Texas: 2.69<br>
<LI>Phoenix, Arizona: 1.92<br>
<LI>Naples, Florida: 2.76<br>
</UL>


Only metropolitan areas in Indiana with sufficient data have combined indicator values calculated, so not all areas are shown in the map. More details about the methodology behind this project can be found on their [website](https://covidcast.cmu.edu/index.html?sensor=doctor-visits-smoothed_adj_cli&level=county&region=42003&date=20200701&signalType=value).

The table shows the current **COVID-19 cases per 100,000 population** (Cases per 100K) and **positivity rates** (Positive Test Rate) for each MSA. The trend columns show historic values of each metric with the maximum value labelled.  

The Cases per 100K value is the current, scaled weekly average of COVID-19 cases. By scaling (per 100K population) this value, we can make valid comparisons between MSAs. The trend column for this value is color coded based on the value of Cases per 100K column. Taken from the [Harvard Global Health Institute](https://globalepidemics.org/key-metrics-for-covid-suppression/), there are four possible colors to which are assigned four statuses: "Tipping Point", "Accelerated Spread", "Community Spread", or "On Track for Containment".  

Positivity rates are the number of positive test results divided by the total number of tests administered for that week. While Cases per 100K is a *rolling average*, each Positive Test Rate value is calculated in weekly steps. For example, the week 28 value is calculated from 7/05/2020 to 7/11/2020 , and the week 29 value is calculated from 7/12/2020 to 7/18/2020. The diagonal-lined band in the line chart shows a 0% to 5% target range. Kentucky and Ohio do not have testing data that is publicly available, so I couldn't calculate positivity rates for Evansville, Cincinnati, and Louisville.



<H2> Charts </H2>

<H4> Line </H4>

The grouped line chart shows historic combined indicator values for each MSA.<br>

<UL>
<LI>Clicking a line highlights the line and deemphasizes the others. Multiple lines can be highlighted. Highlighting a line also has the same effect on that MSA's error bar in the dumbbell chart.<br>
<LI>Clicking on the brush color in the top-left allows you to change the default color (red) to either blue, green, or purple.<br>
<LI>Drawing a window around a section of the chart zooms into that time window  
<LI>Pan or Zoom-out (toolbar) can be useful for looking at edge values  
<LI>Home button (toolbar) or double-clicking in the plot area resets the chart  
<LI>Compare-data-on-hover button (toolbar) shows every label for each MSA as you move your cursor across the days.
</UL>


<H4> Dumbbell </H4>

The dumbbell chart shows the combined indicator value (gray) and the 95% confidence interval.  

<UL>
<LI> Clicking on a point, highlights that MSA's value and deemphasizes the others. It also has the same effect for the MSA's values in the line chart. Multiple MSA values may be selected.<br>
<LI> Double-clicking in the plot area resets the chart. 
</UL>


<H4> Map </H4>

The map shows the metropolitan statistical areas that have calculated combined indicator values.  

<UL>
<LI> Hovering over an area highlights the borders of that area.  
<LI> Clicking on an area shows its estimated combined indicator value.  
<LI> Reset button (upper-left) resets the map view. It's a bit buggy, so you might need to refresh the webpage instead.
</UL>

<H4> Table </H4>

The table shows a scaled, weekly average of COVID-19 cases and a weekly positivity rate for MSAs that include states that have made their testing data available.  

Both values can be used to gain a better understanding of the current situation in each MSA. For example, a moderate Cases per 100K value and a relatively higher Positive Test Rate could be interpreted as an area with substantial viral transmission but not enough testing.  

The data date for Cases per 100K and Positive Test Rate displays by hovering over column names or over last value of trend column.  

<section>

<div class='cases-legend'>
<div class='legend-title'>Cases per 100K</div>
<div class='legend-scale'>
<ul class='legend-labels'>
      <li><span style='background:#941020FF;'></span>Tipping Point (25+ cases)</li>
      <li><span style='background:#D23E0AFF;'></span>Accelerated Spread (10 - 24 cases)</li>
      <li><span style='background:#B19210FF;'></span>Community Spread (1 - 9 cases)</li>
      <li><span style='background:#6D8D3CFF;'></span>On Track for Containment (less than 1)</li>
</ul>
</div>
</div>


<div class='pos-legend'>
<div class='legend-title'>Positive Test Rate</div>
<div class='legend-scale'>
<ul class='legend-labels'>
      <li><span style='background:#800026;'></span>20%</li>
      <li><span style='background:#E31A1C;'></span>15%</li>
      <li><span style='background:#FD8D3C;'></span>10%</li>
      <li><span style='background:#FED976;'></span>5%</li>
      <li><span style='background:#FFF8BA;'></span>1%</li>
</ul>
</div>
</div>

</section>






Dashboard {data-icon="glyphicon-stats"}
=====================================

<head>

<!-- Global site tag (gtag.js) - Google Analytics -->
<script async src="https://www.googletagmanager.com/gtag/js?id=G-GNVB4LJFPH"></script>
<script>
  window.dataLayer = window.dataLayer || [];
  function gtag(){dataLayer.push(arguments);}
  gtag('js', new Date());

  gtag('config', 'G-GNVB4LJFPH');
</script>

</head>



Row {data-height=360}
-------------------------------------


### Historic Values 


```{r}

# styling for axes labels and ticks
x_style_line <- list(
   title = "Combined indicator over time",
   titlefont = list(
      color = "black",
      face = "bold",
      size = 18
   ),
   tickfont = list(
      face = "bold",
      size = 14
   )
)

y_style_line <- list(
   title = "",
   tickfont = list(
      color = "black",
      face = "bold",
      size = 16
   )
)


# tried to get hoverlabel to have background color conditional on value (bgcolor) but failed. Text color would depend on darkness of bgcolor.
# group_by was screwing up something, but I forget (maybe crosstalk). Split does same/similar thing
ci_shared_line %>%
   # group_by(name) %>% 
   # "~" are for variables in df
   plot_ly(x = ~time_value, y = ~value,
           color = I("black"), split = ~name,
           text = ~name,
           # <extra> part removes "trace" from text
           hovertemplate = paste(
              "%{x}<br>",
              "<b>%{text}</b><br>",
              "Combined: %{y}",
              "<extra></extra>"
           ),
           hoverlabel = list(
              #bgcolor = ~color,
              align = 'left',
              bordercolor = 'transparent',
              font = list(
                 # need b/c of bug with setting border to 'transparent'
                 #color = ~text_col
                 color = 'white'
              )
           )
   ) %>%
   add_lines(showlegend = FALSE) %>% 
   layout(xaxis = x_style_line,
          yaxis = y_style_line,
          showlegend = FALSE,
          # sets global value for font family
          font = list(family = "Roboto"),
          # x-axis tick labels get cut off with default margin
          margin = list(b = 90)
   ) %>% 
   highlight(dynamic = TRUE, persistent = TRUE)



```




Row {data-height=625}
-------------------------------------



### Metropolitan Statistical Areas 


```{r}

yelorared <- RColorBrewer::brewer.pal(n = 30, name = "YlOrRd")
yor_darker <- unclass(prismatic::clr_darken(yelorared,
                                       shift = 0.20))


# needed because leaflet legend default direction of values is backwards
pal_rev <- leaflet::colorNumeric(yor_darker,
                                 domain = seq(3.00, 0.00, by = -0.10),
                                 na.color = "#66001EFF", reverse = TRUE)

# minzoom is the maximum you can zoomout; viceversa for maxzoom; 0 would be for zooming all the out
leaflet(
        options = leafletOptions(minZoom = 6.5,
                                 maxZoom = 18,
                                 # remove caption
                                 attributionControl = FALSE)) %>% 
   # black and white basemap
   addProviderTiles("Stamen.Toner") %>% 
   # sets starting point; coords for center of Indiana
   setView(lat = 40.2672, lng = 86.1349,
           zoom = 7) %>% 
   # set panning range; if user tries to go beyond, it springs back
   setMaxBounds(lat1 = 37.62598, lng1 = -89.53418,
                lat2 = 42.64689, lng2 = -83.05625) %>% 
   # add msa shapes
   addPolygons(data = ci_shared_leaf,
               # weight is thickness of stroke
               weight = 2, smoothFactor = 0.5,
               opacity = 1.0, fillOpacity = 0.5,
               color = ~color, popup = ~popup,
               # popupOptions = ,
               # bringtofront makes highlight stroke standout more
               highlightOptions = highlightOptions(color = "black", weight = 2,
                                                   bringToFront = TRUE)) %>% 
   addLegend("bottomleft", pal = pal_rev,
             # values - I think in this format, 3 is upper limit and 0.10 is the lower value and step size
             opacity = 1, values = c(3, 0.1),
             # reverses direction of values in legend
             labFormat = labelFormat(transform = function(x) sort(x, decreasing = TRUE))
   ) %>% 
   # {leaflet.extras}
   addResetMapButton()


```



### Combined Indicator with Uncertainty Range


```{r}

ci_data_date <- glue("Data Date: {ci_clean_db$time_value[[1]]}")

# styling for axes labels and ticks
x_style_db <- list(
   title = "Combined indicator",
   titlefont = list(
      color = "black",
      face = "bold",
      size = 18
   ),
   tickfont = list(
      face = "bold",
      size = 14
   )
)

y_style_db <- list(
   title = "",
   tickfont = list(
      color = "black",
      face = "bold",
      size = 16
   )
)


dumbell_plotly <- ci_shared_db %>% 
   plot_ly(y = ~name,
           text = ~name,
           # <extra> part removes "trace" from text
           hovertemplate = paste(
              "<b>%{text}</b><br>",
              "Combined: %{x}",
              "<extra></extra>"
           ),
           hoverlabel = list(
              bordercolor = 'transparent',
              font = list(
                 # need b/c of bug with setting border to 'transparent'
                 color = ~text_col
              )
           )) %>%
   # removes toolbar
   config(displayModeBar = F) %>% 
   add_segments(
      # "~" are for variables in df
      x = ~lower,
      xend = ~upper, yend = ~name, 
      # "I" means asis
      color = I("gray")
   ) %>%
   add_markers(
      x = ~lower, 
      color = ~I(lower_col), size = I(65)
   ) %>%
   add_markers(
      x = ~upper, 
      color = ~I(upper_col), size = I(65)
   ) %>%
   add_markers(
      x = ~value,
      color = I("gray"), size = I(40)
   ) %>% 
   layout(title = list(text = ci_data_date, x = 0.99,
                       font = list(size = 14, color = "gray")),
          xaxis = x_style_db,
          yaxis = y_style_db,
          showlegend = FALSE,
          # sets global value for font family
          font = list(family = "Roboto")
   ) %>% 
   highlight(persistent = TRUE)

htmlwidgets::saveWidget(dumbell_plotly, file = glue("{rprojroot::find_rstudio_root_file()}/images/dashboard/covidcast-msa-dumbbell-{ci_clean_db$time_value[[1]]}.html"))

dumbell_plotly


```   


Row {data-height=800}
-------------------------------------

### COVID-19 Cases per 100,000 population and Positivity Rates

```{r reactable}

react_dates_pretty <- react_dates %>% 
   mutate_all(~format(., "%B %d"))

# data dates
cases_100k_tooltip <- as.character(react_dates_pretty$cases_date[[1]])
posrate_tooltip <- glue("
MSAs except Chicago: {react_dates_pretty$other_pos_date[[1]]}
Chicago: {react_dates_pretty$chi_pos_date[[1]]}
")
# header function to create tooltip
with_tooltip <- function(value, tooltip) {
      span(title = tooltip, value)
}

# sparkline column specifications
cases_spark <- function(...) {
   colDef(
      name = "Cases per 100K Trend",
      cell = dui_for_reactable(
         dui_sparkline(
            data = htmlwidgets::JS("cellInfo.value.cases_list"),
            # y axis value
            valueAccessor = htmlwidgets::JS("(d) => d.cases[0]"),
            renderTooltip = htmlwidgets::JS(
               htmltools::HTML(
                  "function (_ref) {
                   var datum = _ref.datum;
                   // div around two spans makes horiz. date-value tooltip
                   // react element format (type, style, function)
                   return React.createElement(
                     'div',
                     null,
                     datum.date && React.createElement(
                        'span',
                        {style: {
                             backgroundColor: 'black', color: 'white',
                             padding: '3px', margin: '0px 4px 0px 0px', textAlign: 'center'
                           }},
                        // treats as string, splits date at '-', removes first elt, pastes remainder elts with '/'   
                        datum.date[0].split('-').slice(1).join('/')
                     ),
                     React.createElement(
                        'span',
                        {style: {
                        fontWeight: 'bold', fontSize: '1.1em',
                        padding: '2px'
                        }},
                        // undefined is the region (ie locale), {options}, maximumFractionDigits rounds up
                        datum.y ? datum.y.toLocaleString(undefined, {maximumFractionDigits: 0}) : '--'
                     )
                   );
                  }"
               )
            ),
            components = list(
               dui_sparklineargradient(
                  # I think this creates an unique id with cases value and msa, so it know what color to assign
                  # Think cellInfo.original refers to the overall dataset the reactable is using
                  id = htmlwidgets::JS("'cases' + cellInfo.original.msa.split(' ').join('-')"),
                  from = htmlwidgets::JS("cellInfo.original.cases_color"),
                  to = htmlwidgets::JS("cellInfo.original.cases_color_light"),
                  fromOffset = "10%"
               ),
               dui_sparklineseries(
                  showLine = FALSE,
                  showArea = TRUE,
                  fill = htmlwidgets::JS("'url(#cases' + cellInfo.original.msa.split(' ').join('-') + ')'"),
                  # stroke = htmlwidgets::JS("cellInfo.original.cases_color"),
                  fillOpacity = htmlwidgets::JS("(d, i) => (i > 40 && i < 90 ? 0.5 : 1)")
               ),
               dui_sparkpointseries(
                  points = list("max"),
                  fill = htmlwidgets::JS("cellInfo.original.cases_color"),
                  stroke = htmlwidgets::JS("cellInfo.original.cases_color_light"),
                  renderLabel = htmlwidgets::JS("(d) => React.createElement('tspan',{fontWeight: 'bold'},d.toFixed(0))"),
                  labelPosition = "left",
                  size = 3
               )
            )
         )
      )
   )
}


posrate_spark <- function(...){
   colDef(
      name = "Positive Test Rate Trend",
      cell = dui_for_reactable(
         dui_sparkline(
            data = htmlwidgets::JS("cellInfo.value.pos_list"),
            valueAccessor = htmlwidgets::JS("(d) => d.posRate[0]"),
            renderTooltip = htmlwidgets::JS(
               htmltools::HTML(
                  "function (_ref) {
                   var datum = _ref.datum;
                   // div around two spans makes horiz. date-value tooltip
                   // react element format (type, style, function)
                   return React.createElement(
                     'div',
                     null,
                     datum.endDate && React.createElement(
                        'span',
                        {style: {
                             backgroundColor: 'black', color: 'white',
                             padding: '3px', margin: '0px 4px 0px 0px', textAlign: 'center'
                           }},
                        // splits date at '-', removes first elt, pastes remainder elts with '/'
                        datum.endDate[0].split('-').slice(1).join('/')
                     ),
                     React.createElement(
                        'span',
                        {style: {
                        fontWeight: 'bold', fontSize: '1.1em',
                        padding: '2px'
                        }},
                        // undefined is the region (ie locale), {options}, maximumFractionDigits rounds up
                        datum.y ? datum.y.toLocaleString(undefined, {maximumFractionDigits: 1, style: 'percent'}) : '--'
                     )
                   );
                  }"
               )
            ),
            components = list(
               dui_sparkpatternlines(
                  id = "band_pattern_misc",
                  height = 4,
                  width = 4,
                  stroke = "#aaa",
                  strokeWidth = 1,
                  orientation = list('diagonal')
               ),
               dui_sparkbandline(
                  band = list( from = list( y = 0 ), to = list( y = 0.05 ) ),
                  fill = "url(#band_pattern_misc)"
               ),
               dui_sparklineseries(
                  stroke = htmlwidgets::JS("cellInfo.original.pos_color")
               ),
               dui_sparkpointseries(
                  points = list("max"),
                  fill = htmlwidgets::JS("cellInfo.original.pos_color"),
                  stroke = htmlwidgets::JS("cellInfo.original.pos_color_light"),
                  # see tooltip comments for react element format
                  renderLabel = htmlwidgets::JS("d => React.createElement('tspan',{fontWeight: 'bold'},d.toLocaleString(undefined, {maximumFractionDigits: 1, style: 'percent'}))"),
                  # says if row index = 0 or 1 then 'right' else 'left', === means type (numeric) must also match
                  labelPosition = htmlwidgets::JS("(d, i) => (i === 0 || i === 1 ? 'right' : 'left')"),
                  size = 3
               )
            )
         )
      )
   )
}


react_tab <- reactable(
      data = react_shared,
      # Remove inner borders from table
      borderless = TRUE,
      style = list(fontSize = "18px"),
      # compact = TRUE,
      # select the row
      onClick = "select",
      # num rows on each page, default 10
      defaultPageSize = 5,
      defaultSortOrder = "desc",
      # col that table is sorted by
      defaultSorted = "cases_100k",
      defaultColDef = colDef(
            align = "center",
            headerStyle = "align-self: flex-end; font-weight:normal;"
      ),
      rowStyle = list(
            alignItems = "center",
            # add back border here
            borderBottom = "1px solid lightgray"
      ),
      # highlight rows on hover
      highlight = TRUE,
      columns = list(
            cases_color = colDef(show = FALSE),
            pos_color = colDef(show = FALSE),
            cases_color_light = colDef(show = FALSE),
            pos_color_light = colDef(show = FALSE),
            msa = colDef(
                  name = "Metropolitan Statistical Area",
                  maxWidth = 300
            ),
            cases_100k = colDef(
                  header = with_tooltip("Cases per 100K", cases_100k_tooltip),
                  maxWidth = 200
            ),
            pos_rate = colDef(
                  header = with_tooltip("Positive Test Rate", posrate_tooltip),
                  maxWidth = 200,
                  na = "–",
                  format = colFormat(percent = TRUE, digits = 1)
            ),
            casesList = cases_spark(),
            posList = posrate_spark()
      )
) %>% 
      dui_add_reactable_dep()

htmlwidgets::saveWidget(react_tab, file = glue("{rprojroot::find_rstudio_root_file()}/images/dashboard/covidcast-msa-reacttab-{react_dates$cases_date[[1]]}.html"))


react_tab
```