dorm_movein.Rmd

---
title: "Housing Move-In"
author: "`r paste('Brian Yandell,', format(Sys.time(), '%d %B %Y'))`"
output: word_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE,
                      fig.height = 4, fig.width = 7)
```

```{r}
library(tidyverse)
library(RcppRoll)
roll7 <- function(x) {
  x <- roll_mean(x, 7)
  c(rep(x[1], 6), x)
}
kprint <- function(x) {
  if(interactive()) {
    print(x)
  } else {
    knitr::kable(x)
  }
}
```

This document summarizes housing student test results through 1 September 2020. The R code file can be found in the [pandemic github repository](https://github.com/UW-Madison-DataScience/pandemic/blob/master/dorm_movein.Rmd).

### Testing for all Residents

```{r}
move_all <- read_csv("data/Housing Students Test Results_09012020.csv", 
                 col_types = cols(QuarantineNotes = col_character())) %>%
  rename(TracedDate = "Traced Date",
         NumberContacts = "Number of Contacts",
         ResidenceHall = "Residence Hall",
         AdmitType = "Admit Type") %>%
  mutate(ResultDate = as.POSIXct(ResultDate, format = "%m/%d/%y"),
         TracedDate = as.POSIXct(TracedDate, format = "%m/%d/%y"),
         SymptomaticDate = as.POSIXct(SymptomaticDate, format = "%m/%d/%y"),
         Result = ifelse(Result %in% c("Negative", "Positive"), Result, "Negative"))
nstud <- nrow(distinct(move_all, NEWID))
```

This includes testing before move-in week as well as testing during that period
between `r min(move_all$ResultDate)` and `r max(move_all$ResultDate)`.

There are `r nstud` students reported in housing with the following distribution of repeats:

```{r}
move_all %>%
  count(NEWID, name = "repeats") %>%
  count(repeats) %>%
  kprint()
```

```{r}
tmp <- move_all %>% 
  filter(Result == "Positive") %>%
  count(NEWID, name = "repeats") %>% 
  count(repeats, name = "Positive")
```

There were `r sum(tmp$Positive)` students (`r round(100 * sum(tmp$Positive) / nstud, 2)`%) who tested positive with the following frequency:

```{r}
tmp %>%
  kprint()
```

Here is the breakdown of repeats by number of positive results per student:

```{r}
(tmp <- move_all %>% 
  count(NEWID, ResidenceHall, Result) %>%
  pivot_wider(names_from = "Result", values_from = "n", values_fill = 0) %>%
  count(Negative, Positive) %>%
  rename(repeats = "Negative") %>%
  mutate(repeats = Positive + repeats,
         Positive = paste0(Positive, "_Positive")) %>%
  pivot_wider(names_from = "Positive", values_from = "n", values_fill = 0)) %>%
  kprint()
```

Thus, there were `r sum(tmp[-1,-1])` students (`r round(100* sum(tmp[-1,-1]) / sum(tmp[,-1]), 2)`%) who had repeat tests, with `r sum(tmp[-1, "0_Positive"])` of those (`r round(100* sum(tmp[-1,"0_Positive"]) / sum(tmp[,-1]), 2)`%) having no positive results. **With this small a percentage of repeats, they do not substantially affect results.**

### Testing only during Move-In Week

```{r}
move <- move_all %>%
  filter(ResultDate >= as.POSIXct("2020-08-25") & ResultDate <= as.POSIXct("2020-09-01"))
nstud_in <- nrow(distinct(move, NEWID))
```

Now we restrict attention to student tests during move-in week,
between `r min(move$ResultDate)` and `r max(move$ResultDate)`.

Of the `r nstud` students with records in residence halls, `r nstud_in` got tested during move-in (`r round(100 * nstud_in / nstud, 2)`%). They have the following distribution of repeats during move-in week:

```{r}
move %>%
  count(NEWID, name = "repeats") %>%
  count(repeats) %>%
  kprint()
```

```{r}
tmp <- move %>% 
  filter(Result == "Positive") %>%
  count(NEWID, name = "repeats") %>% 
  count(repeats, name = "Positive")
```

There were `r sum(tmp$Positive)` students (`r round(100 * sum(tmp$Positive) / nrow(distinct(move, NEWID)), 2)`%) who tested positive with the following frequency:

```{r}
tmp %>%
  kprint()
```

Here is the breakdown of repeats by number of positive results per student:

```{r}
(tmp <- move %>% 
  count(NEWID, ResidenceHall, Result) %>%
  pivot_wider(names_from = "Result", values_from = "n", values_fill = 0) %>%
  count(Negative, Positive) %>%
  rename(repeats = "Negative") %>%
  mutate(repeats = Positive + repeats,
         Positive = paste0(Positive, "_Positive")) %>%
  pivot_wider(names_from = "Positive", values_from = "n", values_fill = 0)) %>%
  kprint()
```

Thus, there were `r sum(tmp[-1,-1])` students (`r round(100* sum(tmp[-1,-1]) / sum(tmp[,-1]), 2)`%) who had repeat tests, with `r sum(tmp[-1, "0_Positive"])` of those (`r round(100* sum(tmp[-1,"0_Positive"]) / sum(tmp[,-1]), 2)`%) having no positive results. **With this small a percentage of repeats, they do not substantially affect results.**

The positive results during move-in week were recorded at these locations:

```{r}
move %>%
  filter(Result == "Positive") %>%
  count(LocationName, AdmitType) %>%
  pivot_wider(names_from = "AdmitType", values_from = "n") %>%
  kprint()
```

### Contacts and Residence Halls

Here we return to all students tested between `r min(move_all$ResultDate)` and `r max(move_all$ResultDate)`.
The following table shows how many students provided a given number of contacts, separated by result status:

```{r}
move_all %>%
  group_by(NEWID) %>%
  summarize(NumberContacts = sum(NumberContacts),
            Positive = c("All_Negative", "Positive")[1 + any(Result == "Positive")]) %>%
  ungroup() %>%
  count(Positive, NumberContacts) %>%
  filter(NumberContacts > 0) %>%
  pivot_wider(names_from = "Positive", values_from = "n", values_fill = 0) %>%
  arrange(NumberContacts) %>%
  kprint()
```

The following cases had symptoms identified:

```{r}
move_all %>%
  filter(!is.na(HasSymptoms) & HasSymptoms) %>%
  select(Result, ResidenceHall, QuarantineStatus, SymptomaticDate) %>%
  kprint()
```

While the dorm may not seem relevant to disease status yet, here is the breakdown:

```{r}
(dorm_all <- move_all %>%
  group_by(NEWID, ResidenceHall) %>%
  summarize(Positive = c("All_Negative", "Positive")[1 + any(Result == "Positive")]) %>%
  ungroup() %>%
  count(ResidenceHall, Positive) %>%
  pivot_wider(names_from = "Positive", values_from = "n", values_fill = 0) %>%
  arrange(desc(Positive), desc(All_Negative)) %>%
  mutate(Pct_Pos_Dorm = round(100 * Positive / (Positive + All_Negative), 2))) %>%
  kprint()
```

### Graphs

```{r}
move_pos <- move_all %>%
  filter(Result == "Positive") %>%
  mutate(PosID = rank(jitter(as.numeric(ResultDate)))) %>%
  select(NEWID, PosID)
```


```{r}
ggplot(
  full_join(move_pos,
            move_all %>% filter(NEWID %in% move_pos$NEWID),
            by = "NEWID")) +
  aes(ResultDate, PosID, col = Result, group = NEWID) +
  geom_point() +
  geom_path() +
  ggtitle("Dorm Students with a Positive Test") +
  ylab("")
```

```{r}
move_neg1 <- move_all %>% 
  filter(!(NEWID %in% move_pos$NEWID)) %>%
  group_by(NEWID) %>%
  summarize(repeats = n(),
            minDate = min(ResultDate),
            maxDate = max(ResultDate)) %>%
  ungroup()
move_neg <- move_neg1 %>%
  filter(repeats > 1) %>%
  arrange(repeats, minDate, maxDate) %>%
  mutate(many = c("2 tests", "more tests")[1 + (repeats > 2)],
         repeats = factor(repeats)) %>%
  group_by(many) %>%
  mutate(row = row_number()) %>%
  ungroup()
move_neg1 <- move_neg1 %>%
  filter(repeats == 1)
```

```{r}
ggplot(
  left_join(
    move_all %>% 
      filter(NEWID %in% move_neg$NEWID),
    move_neg1,
    by = "NEWID") %>%
    mutate(movein = (ResultDate >= as.POSIXct("2020-08-25")))) +
  aes(ResultDate, col = movein) +
  geom_density(size = 2) +
  theme(axis.text.y=element_blank(),
        legend.position = "none") +
  ggtitle("Dorm Students with 1 Positive and 0 Negative Test") +
  ylab("")
```

```{r}
move_neg %>%
  count(repeats, name = "frequency") %>%
  kprint()
```

```{r}
ggplot(
  left_join(
    move_all %>% 
      filter(NEWID %in% move_neg$NEWID),
    move_neg,
    by = "NEWID")) +
  aes(ResultDate, row, col = repeats, group = NEWID) +
  geom_point() +
  geom_path()+
  ggtitle("Dorm Students with no Positive and multiple Negative Tests") +
  ylab("") +
  facet_wrap(~ many, scale = "free")
```

Look at cross-section

```{r}
dorm_none <- (
  dorm_all %>%
    filter(Positive == 0))$ResidenceHall
dorm_date <- move_all %>%
  filter(!(ResidenceHall %in% dorm_none)) %>%
  group_by(ResultDate, ResidenceHall) %>%
  summarize(Positive = sum(Result == "Positive"),
            Total = Positive + sum(Result == "Negative")) %>%
  ungroup %>%
  mutate(PercentPos = 100 * roll7(Positive) / roll7(Total)) %>%
  group_by(ResidenceHall) %>%
  mutate(Positive = cumsum(Positive),
         Total = cumsum(Total)) %>%
  ungroup
tmp <- move_all %>%
  filter(!(ResidenceHall %in% dorm_none)) %>%
  group_by(ResultDate) %>%
  summarize(Positive = sum(Result == "Positive"),
            Total = Positive + sum(Result == "Negative")) %>%
  ungroup %>%
  mutate(PercentPos = 100 * roll7(Positive) / roll7(Total),
         Positive = cumsum(Positive),
         Total = cumsum(Total)) %>%
  mutate(ResidenceHall = "Overall")
dorm_date <-
  bind_rows(
    dorm_date,
    tmp) %>%
  mutate(Overall = c("By Residence Hall", "Overall")[1 + (ResidenceHall == "Overall")])
```

```{r}
ggplot(dorm_date) +
  aes(ResultDate, Positive, col = ResidenceHall) +
  geom_line(size = 2) +
  facet_wrap(~ Overall, scale = "free_y") +
  ggtitle("Number Positive Dorm Students on Campus")
```

```{r}
ggplot(dorm_date) +
  aes(ResultDate, PercentPos, col = ResidenceHall) +
  geom_line(size = 2) +
  facet_wrap(~ Overall, scale = "free_y") +
  ggtitle("Percent Positive Students on Campus (7-day rolling mean)")
```