wi_arrival_dorm.Rmd

---
title: "Arrival"
output: html_document
---

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

```{r}
library(tidyverse)
library(readxl)
kprint <- function(x) {
  if(interactive()) {
    print(x)
  } else {
    knitr::kable(x)
  }
}
```

### Wisconsin Historical Testing Data by County

This was an early attempt to gather useful deata. See instead `wi_bet_new_data.Rmd`.

The data are published daily at <https://data.dhsgis.wi.gov/datasets/covid-19-historical-data-table/data>.
There is manual download of CSV or automated API access. For now using manual download. For the whole state and each county, we get total positive and negative tests. For the state, we get the number of positives by 10-year age groups, but not the number of negative by age group.

```{r}
wiHist <- read_csv("data/COVID-19_Historical_Data_Table.csv") %>%
  filter(GEO == "State") %>%
  select(DATE, NEGATIVE, POSITIVE, POS_0_9:POS_90) %>%
  mutate(DATE = as.POSIXct(DATE)) %>%
  filter(max(DATE) - DATE < 7 * 86400) %>%
  select(-DATE) %>%
  summarize_all(function(x) diff(range(x)))
```

Negatives and positives for WI.

```{r}
wiHist[1:2] %>% 
  kprint()
```

Positive for WI by age group.

```{r}
(wiHistPos <- wiHist %>%
  pivot_longer(POS_0_9:POS_90, names_to = "age", values_to = "pos") %>%
  filter(!is.na(pos)) %>%
  mutate(age = str_remove(age, "POS_"))) %>%
  kprint
```

Negatives and positives by county in WI.

```{r}
(wiHistCo <- read_csv("data/COVID-19_Historical_Data_Table.csv") %>%
   filter(GEO == "County") %>%
   select(DATE, NAME, NEGATIVE, POSITIVE) %>%
   rename(county = "NAME") %>%
   mutate(DATE = as.POSIXct(DATE)) %>%
   filter(max(DATE) - DATE < 7 * 86400) %>%
   select(-DATE) %>%
   group_by(county) %>%
   summarize_all(function(x) diff(range(x))) %>% 
   ungroup %>%
   mutate(pct_pos = 100 * POSITIVE / (POSITIVE + NEGATIVE)) %>%
   arrange(desc(pct_pos))) %>%
   kprint()
```

### Census Data on age distribution

These data are from Census <https://www.census.gov/data/datasets/time-series/demo/popest/2010s-counties-detail.html>
using the ALLDATA set. These data have age distribution in the most recent year. FIPS for WI is 55.

```{r}
# AGEGRP 0=total, 1:18 in 5-year intervals 
ccest <- read_csv("data/cc-est2019-alldata-55.csv") %>%
  filter(YEAR == max(YEAR)) %>% # most recent year
  select(CTYNAME, AGEGRP, TOT_POP) %>%
  rename(county = "CTYNAME",
         age = "AGEGRP",
         pop = "TOT_POP") %>%
  mutate(county = str_remove(county, " County"))
ccest_tot <- ccest %>%
  filter(age == 0)
(ccest <- left_join(
  ccest %>% 
    filter(age > 0) %>%
    mutate(age = unique(wiHistPos$age)[ceiling(age / 2)]),
  ccest_tot %>% select(-age) %>% rename(tot = "pop"),
  by = c("county")) %>%
  mutate(pct = 100 * pop / tot) %>%
  group_by(county, age, tot) %>%
  summarize_all(sum) %>%
  ungroup) %>%
  filter(age == "20_29") %>%
  arrange(desc(pop)) %>%
  kprint()
```

```{r}
ggplot(ccest %>% filter(age == "20_29")) +
  aes(tot, pct) +
  geom_point() +
  scale_x_log10() +
  xlab("County Population") +
  ylab("Percent aged 20-29")
```

```{r}
co_data <- full_join(
  ccest %>%
    filter(age == "20_29"),
  wiHistCo,
  by = "county")
```

```{r}
ggplot(co_data) +
  aes(pct, pct_pos) +
  geom_point() +
  ylab("Percent Postive COVID-19") +
  xlab("Percent aged 20-29")
```

### WI Dormitory arrival

This file (in Box as [COVID-19/Aggregated Data/Fall 2020 Housing State County Country.xlsx](https://uwmadison.box.com/s/bx0qyaabylhjpy062qzzhy2punlywrug)) contains records with county level information from across the country. Only looking here at WI counties.

```{r}
wiDorm <- read_excel("data/Fall 2020 Housing State County Country.xlsx") %>%
  rename(state = "HOME_ADDRESS_STATE",
         county = "HOME_COUNTY_DESCR") %>%
  mutate(state = ifelse(HOME_COUNTRY_CODE != "USA", "international", state),
         state = ifelse(state == "AE", "international", state)) %>%
  count(state, county) %>%
  rename(students = "n") %>%
  arrange(state, county) %>%
  filter(state == "WI")
```

```{r}
wiDorm_test <- full_join(
  co_data,
  wiDorm,
  by = "county")
```

```{r}
ggplot(wiDorm_test) +
  aes(students, pct_pos) +
  geom_point() +
  scale_x_log10() +
  ylab("Percent Postive COVID-19") +
  xlab("Number of Students in Dorm")
```

There are three counties accounting for most of the dorm students. Question is, can we get better age-group estimates of the percent positive on diagnostic test?

```{r}
wiDorm_test %>%
  filter(students > 400) %>%
  kprint()
```


```{r}
ggplot(wiDorm_test) +
  aes(students, students * pct_pos / 100) +
  geom_point() +
  scale_x_log10() +
  scale_y_log10() +
  ylab("Expected Postive COVID-19 based on County") +
  xlab("Number of Students in Dorm")
```

```{r}
(wiDorm_pos <- wiDorm_test %>%
  mutate(students_pos = students * pct_pos / 100) %>%
  select(county, students, pct_pos, students_pos) %>%
  arrange(desc(students_pos))) %>%
  kprint()
```

Expected number of students positive: `r round(sum(wiDorm_pos$students_pos))`.


### Combine data and save as CSV

```{r}
write_csv(wiDorm_test, "wi_dorm_test.csv")
```