---
title: "COVID-19 Epidemic Situation Report"
subtitle: "Fulton County"
author: "Ian"
date: "21 June 2021"
output:
  word_document: default
  html_document: default
params:
  data_date:
    label: "Date of data:"
    value: "2021-06-21"
    input: date
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo    = FALSE,
                      error   = TRUE,
                      warning = FALSE,
                      message = FALSE)
```

```{r}
# Load packages -----------------------------------------------------------

pacman::p_load(
  rio,        # importing data  
  here,       # relative file pathways 
  skimr,      # review data
  janitor,    # data cleaning and tables
  lubridate,  # working with dates
  epikit,     # age_categories() function
  tidyverse,  # data management and visualization
  flextable,  # converting tables to pretty images
  scales,     # define color schemes for flextables 
  gtsummary,  # summary statistics, tests and regressions 
  apyramid    # age pyramids 
)


# Import df ---------------------------------------------------------------

covid_raw <- import(here("learning_materials", "covid_case_study", "covid_example_data.xlsx"))

city_pops <- import(here("learning_materials", "covid_case_study", "city_pops.xlsx"))

# Clean df ----------------------------------------------------------------

covid_clean <- covid_raw %>% 
  
  # automatically clean column names
  clean_names() %>% 
  
  # manually clean column names
  rename(
    # NEWname      = OLDname
    sex            = case_gender,
    race           = case_race,
    ethnicity      = case_eth,
    age            = case_age,
    zip            = case_zip,
    date_report    = report_dt,
    date_onset     = sym_startdt,
    date_resolved  = sym_resolveddt,
    date_admit     = hosp_admidt,
    date_discharge = hosp_dischdt,
    date_died      = died_dt,
    date_sample    = pos_sampledt) %>%
  
  # convert date columns to class date
  mutate(
    date_report    = ymd(date_report),
    date_onset     = ymd(date_onset),
    date_resolved  = ymd(date_resolved),
    date_admit     = ymd(date_admit),
    date_discharge = ymd(date_discharge),
    date_died      = ymd(date_died),
    date_sample    = ymd(date_sample)) %>%
  
  # reorder columns
  select(pid, age, sex, race, ethnicity, city, zip, latitude_jitt, longitude_jitt,
         date_onset, date_sample, date_report, date_admit, date_discharge, 
          date_resolved, date_died, starts_with("sym"), everything()) %>% 
  
  # remove 100% duplicate rows
  distinct() %>% 
  
  # change Unknown in variables to NA
  # opposite to na_if() is replace_na() which replaces NA with specified value
  mutate(sex       = na_if(sex, "Unknown"),
         ethnicity = na_if(ethnicity, "NOT SPECIFIED"),
         sym_fever = na_if(sym_fever, "Unk"),
         sym_subjfever = na_if(sym_subjfever, "Unk"),
         sym_myalgia = na_if(sym_myalgia, "Unk"),
         sym_losstastesmell = na_if(sym_losstastesmell, "Unk"),
         sym_sorethroat = na_if(sym_sorethroat, "Unk"),
         sym_cough = na_if(sym_cough, "Unk"),
         sym_headache = na_if(sym_headache, "Unk")) %>% 

  # replace miscoded YES to Yes in sym_myalgia
  mutate(sym_myalgia = recode(sym_myalgia, "YES" = "Yes")) %>%
  
  # change the race values to title case 
  mutate(race = str_to_title(race)) %>% 
  
  # filter cases reported after the data_date
  filter(date_report <= ymd(params$data_date)) %>% 
  
  # filter to confirmed cases only
  filter(confirmed_case == "Yes") %>% 
  
  # create age group variable
  mutate(
    age_group = age_categories(age,
                               lower = 0,
                               upper = 70,
                               by    = 10))
```

# Summary

- As of `r format(ymd(params$data_date), format = "%B %d, %Y")`, Fulton County has recorded `r nrow(covid_clean)` confirmed cases of COVID-19, with `r fmt_count(covid_clean, hospitalized == "Yes")` requiring hospitalization and `r fmt_count(covid_clean, died == "Yes")` deaths.

# Demographics

- The median age of COVID-19 cases in Fulton County is `r median(covid_clean$age, na.rm = T)` (range `r min(covid_clean$age, na.rm = T)` to `r max(covid_clean$age, na.rm = T)`).
- There are `r fmt_count(covid_clean, sex == "Female")` female cases.

```{r}
age_pyramid(
  data = covid_clean,
  age_group = "age_group",
  split_by = "sex",
  proportional = T,
  show_midpoint = F) +
  theme_minimal() +
  labs(title = "Age and gender of COVID-19 cases in Fulton County",
       x = "Age group",
       y = "Percent of total",
       caption = "Fake dataset for course exercise.",
       fill = "Gender")
  
```

\pagebreak

# Weekly epidemic curve by city
-Cases in Fulton County peaked in July 2020 and January 2021 

<br/>
```{r}
# Epi curve ---------------------------------------------------------------

# define a series of weekly break values that start the Monday prior to the
# first case, and end the Monday after the last case.

weekly_breaks <- seq.Date(
  # monday before the first case
  from = floor_date(min(covid_clean$date_report, na.rm = T), "week", week_start = 1),
  # monday after the last case
  to   = ceiling_date(max(covid_clean$date_report, na.rm = T), "week", week_start = 1),
  # 7-day interval bins
  by   = "week")
  
# plot a histogram

ggplot(
  data = covid_clean,
  mapping = aes(
    x = date_report,
    fill = fct_lump_n(city, 5))) +       # use fct_lump to show only top 5 cities
  
  geom_histogram(breaks = weekly_breaks, # use breaks defined above
                 closed = "left") +      # count cases from the start of a breakpoint
  
  scale_y_continuous(
    # make the y axis start at the origin
    expand = c(0, 0)) +
  
  scale_x_date(
    expand            = c(0,0),            # remove excess x-axis space before and after case bars
    date_breaks       = "2 months",        # date labels and major vertical gridlines appear every 4 Monday weeks
    #date_minor_breaks = "week",           # minor vertical lines appear every Monday week
    labels = scales::label_date_short()) +
  
  scale_fill_brewer(type = "qual") +
  
  labs(title = "COVID-19 Epidemic, Fulton County, GA",
       subtitle = "Weekly reported cases among top five cities", 
       x = "Date of report",
       y = "Number of cases",
       fill = "City",
       caption = str_glue("Fake data for course exercise.
                          \n{nrow(covid_clean)} cases shown by city of residence.
                          \nCases reported from {min(covid_clean$date_report)} to {max(covid_clean$date_report)} by Monday week.")) + 
  
  theme_minimal()+
  
  theme(legend.position = "right")
```

\pagebreak

# Table of race and hospitalization
- There is a significant difference among the proportion hospitalized by race.

<br/>
```{r}
covid_clean %>% 
     select(race, hospitalized) %>% 
     tbl_summary(by = hospitalized, percent = "row") %>% 
     add_p()
```

\pagebreak

# Cumulative case incidence by city, per 10,000 population

```{r}
city_table <- covid_clean %>% 
  
  group_by(city) %>% 
  
  # create new summary columns 
  summarise(
    total_cases  = n(),
    recent_cases = sum(date_report > ymd(params$data_date) - 14)) %>% 

  # join with zip code populations data frame
  left_join(city_pops, by = c("city")) %>% 
   
  # add cumulative case incidence  
  mutate(inc_per_10k = round((total_cases / population)* 10000, digits = 1)) %>% 

  # remove extra column
  select(-population) %>% 

  # sort on incidence per 10,000 population
  arrange(desc(inc_per_10k)) 
```

- College Park has the highest cumulative incidence rate at `r max(city_table$inc_per_10k)`
per 10,000 population.

<br/>
```{r}
# make flextable  
city_table %>% 
  qflextable %>%  
  set_header_labels(         
      city = "City", 
      total_cases = "Total cases",                  
      recent_cases = "Cases in last 14 days",
      inc_per_10k = "Cumulative incidence per 10,000") 
```

