case_hospitalisation_rate.R

library(rvest)
library(dplyr)
library(lubridate)
library(stringr)
library(readr)
library(ggplot2)
library(ggthemes)
library(RcppRoll)

sixcol <- colorblind_pal()(6)
# saving reports from the website as html into a folder
# called news_item_html
Demographs <- list.files("../case_demografics_html_asof", pattern=".*html$")

extract_age_hos <- function(x) {
  file_w._path <- paste0("../case_demografics_html_asof/",x)
  report_date <- ymd(x)
  tbls <- file_w._path %>%
    read_html() %>%
    html_nodes("table") %>%
    html_table(header=TRUE)
  newHos <- as.data.frame(tbls[[3]])
  newHos$asOf <- report_date
  return(newHos)
}

list_of_reports <- lapply(Demographs, extract_age_hos)

df_reports <- bind_rows(list_of_reports)

no_reports <- seq(from=min(df_reports$asOf),
                  to=max(df_reports$asOf),
                  by="day")[!seq(from=min(df_reports$asOf),
                                   to=max(df_reports$asOf),
                                   by="day") %in% unique(df_reports$asOf)]
# 2022-02-13 so easiest to go from 14th
# test for change in format
if(length(unique(df_reports$`Prioritised ethnicity*`[df_reports$asOf == ymd("2022-02-14")]) %in% unique(df_reports$`Prioritised ethnicity*`[df_reports$asOf == max(df_reports$asOf)])) != 10){stop()}

age_chr <- df_reports %>%
  arrange(`Prioritised ethnicity*`,asOf) %>%
  group_by(`Prioritised ethnicity*`) %>%
  mutate(daily_change_case = `Total cases` - lag(`Total cases`),
         daily_change_hos = `Cases who have been hospitalised` - lag(`Cases who have been hospitalised`),
         rolling7case = roll_meanr(daily_change_case,7),
         rolling7hos = roll_meanr(daily_change_hos,7),
         previous6case = lag(rolling7case,6)) %>%
  ungroup() %>% 
  filter(asOf > ymd("2022-02_22"),
         !`Prioritised ethnicity*` %in% c("Total", "Unknown")) %>%
  mutate(CHR1K = 1000 * rolling7hos / previous6case) %>%
  select(asOf, `Prioritised ethnicity*`, CHR1K) %>%
  mutate(`Prioritised ethnicity*` = ifelse(`Prioritised ethnicity*` == "Middle Eastern, Latin American and African (MELAA)",
                                           "Middle Eastern,\nLatin American and African\n(MELAA)",`Prioritised ethnicity*`),
         `Prioritised ethnicity*` = factor(`Prioritised ethnicity*`,
                                           levels=c("Māori", "Pacific peoples", "Asian",
                                                    "Middle Eastern,\nLatin American and African\n(MELAA)",
                                                    "European or Other")))

graf <- ggplot(age_chr, aes(x=asOf, y=CHR1K)) +
  geom_segment(aes(xend=asOf - days(7), yend=CHR1K)) +
  facet_wrap(~`Prioritised ethnicity*`, ncol=3) + 
  labs(title="Rolling 7 day hospitalisation rate per 1000 new cases 6 days earlier\nby Prioritised Ethnicity",
       y="\nHospitalisations per 1000 cases\n", x="\nDate", 
       caption="@thoughtfulnz      source: MoH case demographics pages") +
  theme_minimal() + 
  theme(panel.grid = element_blank(),
        axis.line.y = element_line(size=0.1),
        axis.ticks.y = element_line(size=0.2),
        axis.ticks.x = element_line(size=0.2),
        panel.background = element_rect(fill = "#FFFFFF", colour = "#FFFFFF"),
        plot.background = element_rect(fill = "#FBFBFB"),
        plot.caption = element_text(margin=margin(t = 5, r = 5, b = 5, l = 5, unit = "pt"),
                                    size=11, hjust=1),
        plot.caption.position = "plot",
        legend.position = "right",
        panel.grid.major.y = element_line(color ="#BBBBBB", size = 0.1,linetype = 1))
graf
ggsave(filename="~/Desktop/hos_eth.png",plot=graf,dpi=72, 
       units="in", bg="white", height = 5.556 * 1.6, 
       width=9.877* 1.6)