Visualização de casos COVID-19 em Arkansas

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br


[This article was first published on R – Nathan Chaney, and kindly contributed to R-bloggers]. (Você pode relatar problemas sobre o conteúdo desta página aqui)


Quer compartilhar seu conteúdo em R-bloggers? clique aqui se você tiver um blog, ou aqui se não tiver.

Durante a pandemia COVID-19, as principais fontes de informação para números de casos no estado de Arkansas foram as conferências de imprensa diárias do Governor’s Office (até recentemente, quando mudaram para o semanário) e o site arkansascovid.com. Não fiquei particularmente impressionado com as visualizações usadas por nenhuma das fontes. Hoje estou compartilhando alguns códigos que tenho usado durante a pandemia para acompanhar como o Arkansas está lidando com a pandemia.

Usaremos várias bibliotecas, cuja finalidade é indicada nos comentários:

library(tidyverse)
library(lubridate) # Date wrangling
library(gganimate) # GIF production
library(tidycensus) # Population estimates
library(transformr) # used by gganimate
library(ggthemes) # map themes
library(viridis) # Heatmap color palette
library(scales) # Pretty axis labels
library(zoo) # rollapply

knitr::opts_chunk$set(
  message = F,
  echo = T,
  include = T
)

options( scipen = 10 ) # print full numbers, not scientific notation

Usaremos o COVID-19 Data Repository do Center for Systems Science and Engineering (CSSE) da Johns Hopkins University, que é mantido no Github. Os dados podem ser lidos em uma única linha, embora iremos reorganizar as contagens de casos em um formato longo para facilitar a discussão. Aqui está um trecho da tabela:

covid_cases %
  mutate(date = lubridate::as_date(date, format = "%m/%d/%y")) %>%
  filter(Province_State == 'Arkansas') %>% 
  arrange(date, Combined_Key)

tail(covid_cases %>% select(Combined_Key, date, cases))

## # A tibble: 6 x 3
##   Combined_Key             date       cases
##                            
## 1 Union, Arkansas, US      2020-09-28   894
## 2 Van Buren, Arkansas, US  2020-09-28   174
## 3 Washington, Arkansas, US 2020-09-28  9457
## 4 White, Arkansas, US      2020-09-28   849
## 5 Woodruff, Arkansas, US   2020-09-28    53
## 6 Yell, Arkansas, US       2020-09-28  1256

Como faremos cálculos per capita, precisamos carregar as estimativas da população. Felizmente, o pacote tidycensus fornece um método conveniente de obter essas informações. Aqui está um instantâneo dos dados da população:

population % 
  mutate(GEOID = as.integer(GEOID)) %>%
  pivot_wider(
    names_from = variable,
    values_from = value
  ) %>%
  filter(grepl("Arkansas", NAME))

head(population)

## # A tibble: 6 x 4
##   NAME                      GEOID    POP DENSITY
##                             
## 1 Arkansas County, Arkansas  5001  17769    18.0
## 2 Ashley County, Arkansas    5003  20046    21.7
## 3 Baxter County, Arkansas    5005  41619    75.1
## 4 Benton County, Arkansas    5007 272608   322. 
## 5 Boone County, Arkansas     5009  37480    63.5
## 6 Bradley County, Arkansas   5011  10897    16.8

O Gabinete do Governador faz várias opções de design destinadas a girar as estatísticas de forma que pareça que Arkansas está fazendo um bom trabalho no gerenciamento da crise (no momento da redação deste post, as estatísticas sugerem o contrário). Por exemplo, o gráfico de barras de casos pendentes geralmente divide os casos de prisão e os casos de disseminação pela comunidade, de forma que a tendência geral é obscurecida. Além disso, o uso de gráficos de barras em vez de gráficos de linha também torna mais difícil visualizar a tendência de novos casos. Usaremos uma linha de tendência de casos gerais sem spin:

ark_covid_cases % 
  filter(`Province_State` == 'Arkansas')

p %
  filter(cases > 0) %>%
  group_by(Province_State, date) %>%
  mutate(cases = sum(cases)) %>%
  ggplot(aes(x = date, y = cases)) +
  geom_line() + 
  scale_x_date(breaks = scales::pretty_breaks()) +
  scale_y_continuous(labels = unit_format(unit = "k", sep = "", big.mark = ",", scale = 1/1000)) +
  labs(
    title = "Total COVID-19 cases in Arkansas",
    x = "", y = "",
    caption = paste0("Image generated: ", Sys.time(), "n", "Data source: https://github.com/CSSEGISandData/COVID-19", "n", "COVID-19 Data Repository by CSSE at Johns Hopkins University")
  )

ggsave(filename = "images/ark_covid_total_cases.png", plot = p, height = 3, width = 5.25)
p

Esta linha de tendência não mostra sinais reais de estabilização. Como veremos mais adiante, o número de novos casos não está diminuindo.

Leia Também  Data manipulation in r using data frames – an extensive article of basics

Tanto o Gabinete do Governador quanto o site arkansascovid.com usam métricas populacionais selecionadas arbitrariamente para descrever casos per capita (normalmente 10.000 residentes). Usaremos uma métrica per capita diferente que seja razoavelmente próxima ao tamanho médio do condado no estado. Assim, para muitos condados, o número per capita será razoavelmente próximo à população real do condado. Esse número pode ser calculado a partir das métricas populacionais do estado:

per_capita % 
  filter(grepl("Arkansas", NAME)) %>% 
  summarize(median = median(POP)) %>% # Get median county population
  unlist()

per_capita

## median 
##  18188

Em vez de usar a mediana real, vamos arredondá-la para os 5.000 residentes mais próximos:

per_capita 

Now that we have the population figure we want to use for the per-capita calculations, we will perform those using the lag function to calculate the new cases per day, and then using the rollapply function to smooth the number of daily cases over a sliding 1-week (7-day) window. The results look like this:

cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br
roll_ark_cases % 
  arrange(date) %>%
  group_by(UID) %>%
  mutate(prev_count = lag(cases)) %>%
  mutate(prev_count = ifelse(is.na(prev_count), 0, prev_count)) %>%
  mutate(new_cases = cases - prev_count) %>%
  mutate(roll_cases = round(zoo::rollapply(new_cases, 7, mean, fill = 0, align = "right", na.rm = T)))%>%
  ungroup() %>%
  select(-prev_count) %>%
  left_join(
    population %>% select(-NAME),
    by = c("FIPS" = "GEOID")
  ) %>%
  mutate(
    cases_capita = round(cases / POP * per_capita), # cases per per_capita residents
    new_capita = round(new_cases / POP * per_capita), # cases per per_capita residents
    roll_capita = round(roll_cases / POP * per_capita) # rolling new cases per per_capita residents
  )

tail(roll_ark_cases %>% select(date, Admin2, POP, cases, new_cases, roll_cases, roll_capita))

## # A tibble: 6 x 7
##   date       Admin2        POP cases new_cases roll_cases roll_capita
##                                  
## 1 2020-09-28 Union       39126   894         2          8           4
## 2 2020-09-28 Van Buren   16603   174         0          1           1
## 3 2020-09-28 Washington 236961  9457        42         64           5
## 4 2020-09-28 White       78727   849         8         17           4
## 5 2020-09-28 Woodruff     6490    53         0          1           3
## 6 2020-09-28 Yell        21535  1256         2          3           3

Podemos resumir esses resultados para obter um número total de casos contínuos para todo o estado, que se parece com isto:

roll_agg_ark_cases %
  group_by(date) %>%
  summarize(roll_cases = sum(roll_cases))

tail(roll_agg_ark_cases)

## # A tibble: 6 x 2
##   date       roll_cases
##             
## 1 2020-09-23        820
## 2 2020-09-24        835
## 3 2020-09-25        839
## 4 2020-09-26        797
## 5 2020-09-27        786
## 6 2020-09-28        812

Podemos então representar graficamente o número agregado de casos rotativos ao longo do tempo. Mostraremos alguns momentos diferentes relevantes para a disseminação do coronavírus, incluindo a máscara do governador / mandato de distanciamento social e a reabertura de escolas públicas:

p %
  ggplot(aes(date, roll_cases)) + 
    geom_line() +
    geom_vline(xintercept = as.Date("2020-08-24"), color = "gray10", linetype = "longdash") +
    annotate(geom ="text", label = "Schoolnstarts", x = as.Date("2020-08-05"), y = 200, color = "gray10") +
    annotate(geom = "segment", y = 290, yend = 400, x = as.Date("2020-08-05"), xend = as.Date("2020-08-24")) +
    geom_vline(xintercept = as.Date("2020-07-16"), color = "gray10", linetype = "longdash") +
    annotate(geom ="text", label = "Masknmandate", x = as.Date("2020-06-21"), y = 100, color = "gray10") +
    annotate(geom = "segment", y = 190, yend = 300, x = as.Date("2020-06-21"), xend = as.Date("2020-07-16")) +
    geom_smooth(span = 1/5) +
    labs(
      title = "7-Day Rolling Average of New COVID-19 Cases in Arkansas",
      x = "", y = "",
      caption = paste0("Image generated: ", Sys.time(), "n", "Data source: https://github.com/CSSEGISandData/COVID-19", "n", "COVID-19 Data Repository by CSSE at Johns Hopkins University")
    ) +
  theme(
    title = element_text(size = 10)
  )

ggsave(filename = "images/ark_covid_rolling_cases.png", plot = p, height = 3, width = 5.25)
p

A partir desse gráfico, parece que o mandato da máscara pode ter tido um efeito positivo no nivelamento do número de novos casos COVID-19. Por outro lado, parece que a reabertura de escolas pode ter levado a um rápido aumento no número de novos casos. Claro, a taxa de transmissão do vírus tem uma infinidade de causas, e a correlação aqui não implica necessariamente em causa.

O site arkansascovid.com contém visualizações melhores do que as que o Governor's Office usa, mas o esquema de cores padrão do Tableau não mostra um bom trabalho de exibição de pontos de acesso. Municípios com um número maior de casos são representados em azul escuro (uma cor associada ao frio), enquanto os condados com menos casos são mostrados em verde claro (uma cor sem associação de calor). Além disso, não existem visualizações que mostram mudanças no nível do condado ao longo do tempo. Portanto, usaremos uma visualização em nível de condado que mostra o número de novos casos ocorridos ao longo do tempo com um esquema de cores que mostra intuitivamente os pontos críticos:

# Start when 7-day rolling cases in state > 0 
first_date %
    group_by(date) %>%
    summarize(roll_cases = sum(roll_cases)) %>%
    ungroup() %>%
    filter(roll_cases > 0) %>%
    select(date)
}$date)

temp %
  filter(date >= first_date) %>%
  mutate(roll_capita = ifelse(roll_capita % # log10 scale plot
  mutate(roll_cases = ifelse(roll_cases %
  mutate(GEOID = as.numeric(GEOID)) %>%
  inner_join(temp %>% select(FIPS, roll_cases, roll_capita, date), by = c("GEOID" = "FIPS")) %>%
  select(GEOID, roll_cases, roll_capita, date, geometry)

# tidycensus projection is skewed for state map
# data("county_laea")
# data("state_laea")
# temp_sf %
#   mutate(GEOID = as.numeric(GEOID)) %>%
#   inner_join(temp, by = c("GEOID" = "FIPS"))

days 

There are a couple of design choices here that are worth explaining. First, we’re animating the graphic over time, which shows where hotspots occur during the course of the pandemic.

Second, we’re using the plasma color palette from the viridis package. This palette goes from indigo on the low end to a hot yellow on the high end, so it intuitively shows hotspots.

Third, we’re using a log scale for the number of new cases – the idea here is that jumps of an order of magnitude or so are depicted in different colors (i.e., indigo, purple, red, orange, yellow) along the plasma palette. If we use a standard numerical scale for the number of new cases, jumps from 1-20 or so get washed out due to the large size of the worst outbreaks.

I hope you found my alternate visualizations for COVID-19 in Arkansas useful. The charts are set to update nightly, so these data should be current throughout the pandemic. If you have suggestions for improvements or notice that the figures aren’t updating, please comment! Thanks for reading.



cupom com desconto - o melhor site de cupom de desconto cupomcomdesconto.com.br