Обтекание второй оси Y по фасету с линией и гистограммой (Tidyverse) - PullRequest
Новая
       26

Обтекание второй оси Y по фасету с линией и гистограммой (Tidyverse)

0 голосов
/ 14 апреля 2020

Попытка построить общее количество случаев covid19 на уровне страны с гистограммой ежедневных новых случаев, чтобы показать устойчивое падение новых случаев, приводит к «сглаживанию кривой» (при условии, что это так). 

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

...