decessi-prop.R

  library(readr)
  library(tidyverse)
  library(zoo)
  library(tidyquant)
  library(ggtext)
  
  gotosaturday <- function(date){
    offset = 1 - lubridate::wday(date, week_start = 7)
    return(date + offset)
  }
  
       #Sys.setlocale("LC_ALL", "English")
  url <- "https://raw.githubusercontent.com/lvegro/cfr-epicentro/main/cfr-epicentro.csv"
  cfr <-
    readr::read_csv(url)
  cfr <- cfr %>% mutate(id = vctrs::vec_group_id(cfr),
                        date = as.Date(data, format="%d %B %Y")) %>% select(-c( id, data))
  cfr2 <- gather(cfr, key = "key", value = "value", -c(date)) %>% 
    mutate(week = as.Date(cut(date, breaks = "week"))) %>% 
    mutate(week2 = gotosaturday(date)) %>% 
    # delta
    distinct() %>% 
    filter(substr(key, 1,1) == "d") %>% 
    arrange(key, date) %>%
    separate(key, c("type", "start_age", "end_age"), sep = "_") %>%
    mutate(age_range = factor(paste0(start_age, " - ", end_age))) %>% 
    mutate(lag_deaths = ifelse(value - lag(value)>0, yes = value - lag(value), 0)) %>% 
    arrange(date) %>% 
    group_by(week2, age_range ) %>% 
    summarise( total_deaths = sum(lag_deaths))
  
  txt <- cfr2 %>%
     filter(week2 >= as.Date("2021-01-01")) %>%
    mutate(over80 = if_else(age_range %in% c("80 - 89", "90 - NA"), "80+", "<80")) %>%
    mutate(over90 = if_else(age_range == "90 - NA" , "90+", "<90")) %>% 
    group_by(week2, over80) %>%
    summarise(total_deaths = sum(total_deaths)) %>% 
   spread(c(over80), total_deaths) %>% 
     mutate(position = `80+`/(`<80` + `80+`),
            text = as.character(round(position*100, 1)))
  
  
  pl_dec_rel <- cfr2 %>%
    filter(week2 >= as.Date("2021-01-01")) %>% 
  #  filter(week >= as.Date("2020-09-30")) %>% 
    #filter(week <= as.Date("2021-04-20")) %>% 
    mutate(age_range =case_when(
      age_range %in% 
        c("0 - 9", "10 - 19", "20 - 29", "30 - 39", "40 - 49") ~ "< 50",
      age_range == "50 - 59" ~ "50 - 59",
      age_range == "60 - 69" ~ "60 - 69",
      age_range == "70 - 79" ~ "70 - 79",
      age_range == "80 - 89" ~ "80 - 89",
      age_range == "90 - NA" ~ "90+"
      )) %>% 
    ggplot(mapping = aes(x = week2, y = total_deaths, fill=age_range))  +
    geom_col(position = "fill") + scale_fill_brewer(palette= "YlGnBu") +
    ggthemes::theme_few() + 
    ggtitle("Distribuzione decessi per fascia d'età\n e settimana di notifica")+
    xlab("Settimana") +
    ylab("% decessi")+
    labs(fill = "Fascia d'età") +
    scale_y_continuous(labels = scales::percent) +
    geom_text(inherit.aes = FALSE,data = txt,
              mapping = aes(x = week2, y = position + 0.03,
                                        label = text),
              size =4.1, 
              col="white"); pl_dec_rel;
  
  pl_dec_ass <- cfr2 %>%
   filter(week2 >= as.Date("2021-01-01")) %>% 
    mutate(age_range =case_when(
      age_range %in% 
        c("0 - 9", "10 - 19", "20 - 29", "30 - 39", "40 - 49") ~ "< 50",
      age_range == "50 - 59" ~ "50 - 59",
      age_range == "60 - 69" ~ "60 - 69",
      age_range == "70 - 79" ~ "70 - 79",
      age_range == "80 - 89" ~ "80 - 89",
      age_range == "90 - NA" ~ "90+"
    )) %>% 
    ggplot(mapping = aes(x = week2, y = total_deaths, fill=age_range))  +
    geom_bar(stat="identity") + scale_fill_brewer(palette= "YlGnBu") +
    ggthemes::theme_few() + 
    ggtitle("Distribuzione assoluta decessi per fascia \n d'età e settimana di notifica")+
    xlab("Settimana") +
    ylab("N. decessi") +
    labs(fill = "Fascia d'età"); pl_dec_ass;
    
  casi <- gather(cfr, key = "key", value = "value", -c(date)) %>% 
    mutate(week = as.Date(cut(date, "week"))) %>% 
    # delta
    distinct() %>% 
    filter(substr(key, 1,1) == "c") %>% 
    arrange(key, date) %>%
    separate(key, c("type", "start_age", "end_age"), sep = "_") %>%
    mutate(age_range = factor(paste0(start_age, " - ", end_age))) %>% 
    mutate(lag_cases = ifelse(value - lag(value)>0, yes = value - lag(value), 0)) %>% 
    arrange(date) %>% 
    group_by(week, age_range ) %>% 
    summarise( total_cases = sum(lag_cases))
  
  
  casi %>%
    filter((week2)>=as.Date("2021-01-15")) %>% 
    mutate(age_range =case_when(
      age_range %in% 
        c("0 - 9", "10 - 19", "20 - 29", "30 - 39", "40 - 49") ~ "< 50",
      age_range == "50 - 59" ~ "50 - 59",
      age_range == "60 - 69" ~ "60 - 69",
      age_range == "70 - 79" ~ "70 - 79",
      age_range == "80 - 89" ~ "80 - 89",
      age_range == "90 - NA" ~ "90+"
    )) %>% 
    ggplot(mapping = aes(x = as.Date(week), y = total_cases, fill=age_range))  +
    geom_col(position = "fill") + scale_fill_brewer(palette= "YlGnBu") +
    ggthemes::theme_few() + 
    ggtitle("Distribuzione casi per fascia d'età e settimana di notifica")+
    xlab("Settimana") +
    ylab("% casi")+
    labs(fill = "Fascia d'età")+
    scale_y_continuous(labels = scales::percent)
  
  
  cfr2 <- gather(cfr, key = "key", value = "value", -c(date)) %>% 
    mutate(week = gotosaturday(as.Date(date))) %>% 
    # delta
    distinct() %>% 
    filter(substr(key, 1,1) == "d") %>% 
    arrange(key, date) %>%
    separate(key, c("type", "start_age", "end_age"), sep = "_") %>%
    mutate(age_range = factor(paste0(start_age, " - ", end_age))) %>% 
    mutate(age = ifelse(age_range %in% c("80 - 89", "90 - NA"), "80+", "< 80"))%>% 
    mutate(lag_deaths = ifelse(value - lag(value)>0, yes = value - lag(value), 0)) %>% 
    arrange(date)
  
  weekly <- cfr2 %>% 
    group_by(week, age ) %>% 
    summarise( total_deaths = sum(lag_deaths))
  
  max_death <- weekly %>% 
    group_by(age) %>% 
    summarise(max = max(total_deaths, na.rm = T))
  
  cfr3 <- weekly %>% 
    left_join(max_death) %>% 
    mutate(deaths = total_deaths/max) %>% 
    mutate(week = as.Date(week)) %>% 
    filter(week >= as.Date("2020-11-25"))
  
  txt <- cfr3 %>% 
    select(week, age, deaths)
  
  pl3 <- cfr3 %>% 
    ggplot(mapping = aes(x = week, y = deaths, group=age,  col = age)) + 
    geom_line(lwd = 1.5, n = 7, lty=1, alpha = c(0.6)) +
    scale_y_continuous("Decessi rispetto al valore di picco", labels = scales::percent) +
    scale_color_manual(values = c("#7FCDBB", "#2C7FB8")) +
    ggthemes::theme_few() + 
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("Settimana") + 
    labs(title = "Decessi settimanali rispetto al valore di picco per <span style='color: #7FCDBB; font-style:bold'>< 80</span> e
         <span style='color: #2C7FB8; font-style:bold'> 80+</span> anni", col = "Fascia d'età") +
    theme(plot.title = element_markdown(), legend.position = "none") # +
    
  #  liscio  span = 14 (2weeks) 
  w <- 21
  liscio <- cfr2 %>% 
    ungroup() %>% 
    group_by(age, date) %>% 
    summarise(deaths = sum(lag_deaths)) %>% 
    arrange(age, date) %>% 
    mutate(
      rolling = rollapplyr(
      deaths,
      width = w,
      FUN = mean,
      align = "right",
      fill = NA,
      na.rm = TRUE
    ))
  
  maxes <- liscio %>% group_by(age) %>% summarise(massimo = max(rolling, na.rm = T))
  
  liscio2 <- liscio %>% left_join(maxes)
  x <- liscio2$date[which.max(liscio2$rolling)]
  
  
  
  #pl4 <- 
  
  title_txt <-paste0("Decessi settimanali rispetto al valore di picco per <span style='color: #7FCDBB; font-style:bold'>< 80</span> e
         <span style='color: #2C7FB8; font-style:bold'> 80+</span> anni") 
  pl4 <- liscio2 %>% 
    filter(date >= x) %>% 
    ggplot(mapping = aes(x = date, y = rolling/massimo, group=age,  col = age)) + 
    geom_line(lwd =2, lty=1, alpha = c(0.6)) +
    scale_y_continuous("Decessi rispetto al valore di picco", labels = scales::percent) +
    scale_color_manual(values = c("#7FCDBB", "#2C7FB8")) +
    ggthemes::theme_few() + 
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("Settimana") + 
    labs(title = title_txt, subtitle = paste0("Media mobile ", w, " giorni"), col = "Fascia d'età") +
    theme(plot.title = element_markdown(), legend.position = "none"); pl4
  
  
  
  
  spappa <- gather(cfr, key = "key", value = "value", -c(date)) %>% 
    mutate(week = cut(date, "week")) %>% 
    # delta
    distinct() %>% 
    filter(substr(key, 1,1) == "d") %>% 
    arrange(key, date) %>%
    separate(key, c("type", "start_age", "end_age"), sep = "_") %>%
    mutate(age_range = factor(paste0(start_age, " - ", end_age))) %>% 
    mutate(age = case_when(age_range %in% c("90 - NA") ~ "90+",
                           age_range %in% c("80 - 89") ~ "80 - 89",
                           age_range %in% c("0 - 9", "10 - 19", "20 - 29", "30 - 39", "40 - 49") ~ "< 50",
                           age_range %in% c("50 - 59", "60 - 69" ~ "50 - 69") ~ "50 - 69",
                           age_range %in% c("70 - 79") ~ "70 - 79",
                           TRUE ~ "ERROR"))%>% 
    mutate(lag_deaths = ifelse(value - lag(value)>0, yes = value - lag(value), 0)) %>% 
    arrange(date)
  
  weeklys <- spappa %>% 
    group_by(week, age ) %>% 
    summarise( total_deaths = sum(lag_deaths))
  
  max_death <- weeklys %>% 
    group_by(age) %>% 
    summarise(max = max(total_deaths, na.rm = T))
  
  cfr3s <- weeklys %>% 
    left_join(max_death) %>% 
    mutate(deaths = total_deaths/max) %>% 
    mutate(week = as.Date(week)) %>% 
    filter(week >= as.Date("2020-11-25"))
  
  txt <- cfr3s %>% 
    select(week, age, deaths)
  
   cfr3s %>%  
    ggplot(mapping = aes(x = week, y = deaths, group=age,  col = age)) + 
    geom_line(lwd = 1.5, alpha = c(1)) +
    scale_y_continuous("Decessi rispetto al valore di picco", labels = scales::percent) +
    #scale_color_manual(values = c("#00FFAA", "#00AAFF")) +
    ggthemes::theme_few() + 
    theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
    xlab("Settimana") + 
    #labs(title = "Decessi settimanali rispetto al valore di picco per <span style='color: #00FFAA; font-style:bold'>< 90</span> e
    #    <span style='color: #00AAFF; font-style:bold'> 90+</span> anni", col = "Fascia d'età") +
    theme(plot.title = element_markdown(), legend.position = "right")  +
    geom_text(data = txt,
            mapping = aes(x = week, 
                          y = deaths + 0.2,
                          label = paste0(round(deaths*100, 1),"%"))); pl3s