0

Trying to plot total cases of covid19 at the country level with a histogram of daily new cases to show a sustained drop in new cases leads to a 'flattening of the curve' (assuming that is the case).

library(tidyverse)

#clean raw data source
c19 = read_csv("https://raw.githubusercontent.com/datasets/covid-19/master/data/time-series-19-covid-combined.csv") %>% 
  mutate(Cases = Confirmed) %>% 
  mutate(Country = `Country/Region`) %>%
  select(Date, Country, Cases, Deaths) %>%
  group_by(Date, Country) %>%
  summarise(Cases = sum(Cases),
            Deaths = sum(Deaths)) %>%
  ungroup() %>%
  group_by(Country) %>%
  mutate(Lagged_Cases = ifelse(is.na(lag(Cases)), 0, lag(Cases))) %>%
  mutate(NewCases = Cases - Lagged_Cases) %>%
  mutate(IndexDate = ifelse(Lagged_Cases == 0 & Cases > 0, 1, ifelse(Lagged_Cases > 0, 2, 0))) %>%
  filter(IndexDate > 0) %>%
  mutate(Index = row_number()) %>%
  ungroup() %>%
  select(-IndexDate) %>%
  filter(Country %in% c("US","Korea, South","Sweden")) %>%
  inner_join(data.frame(Country = c("US","Korea, South","Sweden"),
                        Pop = c(328000000,51245707,10230000)))

c19 %>%
  ggplot() +
  geom_line(aes(x=Index, y=Cases/1000, color=Country), size=2) +
  geom_histogram(aes(x=Index, y=NewCases/75, group=Country), stat="identity", alpha=.4) + 
  #scale_y_continuous(sec.axis = sec_axis(~./data$Cases)) +
  facet_wrap(vars(Country), scales="free_y") +
  ggtitle("Flattening The Curve?") +
  xlab("Days Since First Case") +
  ylab("Total Cases (thousands) - Daily New Cases (not to scale)")

enter image description here

Steve Olson
  • 183
  • 2
  • 12
  • Possible duplicate: https://stackoverflow.com/questions/26917689/how-to-use-facets-with-a-dual-y-axis-ggplot – MrFlick Apr 14 '20 at 00:16
  • 1
    Make sure to include data in a [reproducible format](https://stackoverflow.com/questions/5963269/how-to-make-a-great-r-reproducible-example) (not as images) so data can be easily copied/pasted for testing. – MrFlick Apr 14 '20 at 00:17
  • 'Possible duplicate' - interesting but more of an overlay than a facet wrap – Steve Olson Apr 14 '20 at 01:02
  • Code has been added for data duplication – Steve Olson Apr 14 '20 at 01:02

0 Answers0