preparation_robustness.Rmd

---
title: "Preparation for alternative time windows"
---

# Preparation

## Data Loading
Features
```{r, message=F}
# 0-5am measurements
surv_morning_alt <- read_csv("../data/survival_morning_6.csv")
surv_morning_alt2 <- read_csv("../data/survival_morning_4.csv")

# 5min measurements
wave_features <- read_csv("../data/wave_features_5min.csv") %>%
  relocate(datetime, ID) %>%
  arrange(ID, datetime)
```

Patient information
```{r}
# negative SARS-CoV-2 result
exclude_negative <- c("wave-011")

# technical problems during the recording or nonadherence to the prescribed measurement regime
exclude_measurement <- c("wave-003", "wave-004", "wave-005", "wave-025")

# hospital discharge on the same day of hospitalization
exclude_short_stay <- c("wave-018")

exclude <- unique(c(exclude_negative, exclude_measurement, exclude_short_stay))

# patients eventually admitted to ICU
icu_patients <- c("wave-017", "wave-022", "wave-026", "wave-034", "wave-040", "wave-048", "wave-052")

# wave-020 switched hospitals, wave-037 dropped out
dropouts <- c("wave-020", "wave-037")
```

Metadata
```{r}
meta_data <- read_csv("../data/subjects-metadata.csv") %>%
  mutate(start_day = floor_date(start, unit = "day"), .before = start) %>%
  mutate(end_day = floor_date(end, unit = "day"), .before = end) %>%
  mutate(ID = tolower(new_subject_id), .after = new_subject_id)

# data quality assurance
meta_data %<>%
  mutate(start_day = case_when( # in the case of wave-028 and wave-038, wearable measurements started after midnight, so the automatically inferred admission date must be corrected
    new_subject_id == "WAVE-028" ~ as.POSIXct("2021-01-03", tz = "UTC"),
    new_subject_id == "WAVE-038" ~ as.POSIXct("2021-02-16", tz = "UTC"),
    T ~ start_day
  ))

meta_data %<>% mutate(
  total_days = as.integer(difftime(end_day, start_day, units = "days")),
  .after = new_subject_id
) %>%
  mutate(total_days = case_when( # wave-17 was only followed for 1 day
    new_subject_id == "WAVE-017" ~ 1L,
    T ~ total_days
  ))
```

Demographic data
```{r, message=F}
demographics <- read_csv("../data/patient_demographics.csv") %>%
  transmute(ID = str_to_lower(id), sex = factor(sex), age = as.integer(age), age60 = age >= 60)
```

## Data Transformation

```{r}
covariates <- names(wave_features %>% select(-c(datetime, ID)) %>% select(!contains("sign_changes")))

surv_data_intervals_tw6 <- wave_features %>%
  inner_join(meta_data %>% transmute(ID = tolower(new_subject_id), total_days, start_day, end_day), by = "ID") %>%
  group_by(ID) %>%
  mutate(
    icu = ID %in% icu_patients,
    rel_day = (as.integer(difftime(floor_date(datetime, unit = "day"), start_day, units = "days"))),
    rem_sync_days = (as.integer(difftime(end_day, floor_date(datetime, unit = "day"), units = "days"))),
    time_of_day = as_hms(floor_date(datetime, unit = "5minutes")),
    .after = datetime
  ) %>%
  filter(time_of_day < as_hms("6:00:00")) %>%
  group_by(ID, icu, rel_day, rem_sync_days) %>%
  summarize(datetime = min(datetime, na.rm = T), across(all_of(covariates), mean, na.rm = T), .groups = "drop") %>%
  mutate(ID = as.factor(ID), rem_sync_days = as.integer(rem_sync_days)) %>%
  arrange(ID, desc(rem_sync_days)) %>%
  ungroup() %>%
  mutate(event = case_when(
    rem_sync_days > 0 ~ "stay",
    icu ~ "icu",
    T ~ "dismiss"
  ), .after = ID)

surv_data_intervals_tw4 <- wave_features %>%
  inner_join(meta_data %>% transmute(ID = tolower(new_subject_id), total_days, start_day, end_day), by = "ID") %>%
  group_by(ID) %>%
  mutate(
    icu = ID %in% icu_patients,
    rel_day = (as.integer(difftime(floor_date(datetime, unit = "day"), start_day, units = "days"))),
    rem_sync_days = (as.integer(difftime(end_day, floor_date(datetime, unit = "day"), units = "days"))),
    time_of_day = as_hms(floor_date(datetime, unit = "5minutes")),
    .after = datetime
  ) %>%
  filter(time_of_day < as_hms("4:00:00")) %>%
  group_by(ID, icu, rel_day, rem_sync_days) %>%
  summarize(datetime = min(datetime, na.rm = T), across(all_of(covariates), mean, na.rm = T), .groups = "drop") %>%
  mutate(ID = as.factor(ID), rem_sync_days = as.integer(rem_sync_days)) %>%
  arrange(ID, desc(rem_sync_days)) %>%
  ungroup() %>%
  mutate(event = case_when(
    rem_sync_days > 0 ~ "stay",
    icu ~ "icu",
    T ~ "dismiss"
  ), .after = ID)

surv_data_fullday <- wave_features %>%
  inner_join(meta_data %>% transmute(ID = tolower(new_subject_id), total_days, start_day, end_day), by = "ID") %>%
  group_by(ID) %>%
  mutate(
    icu = ID %in% icu_patients,
    datetime_shifted = datetime - hours(5),
    rel_day = (as.integer(difftime(floor_date(datetime_shifted, unit = "day"), start_day, units = "days"))) + 1L,
    rem_sync_days = (as.integer(difftime(end_day, floor_date(datetime_shifted, unit = "day"), units = "days"))) - 1L,
    .after = datetime
  ) %>%
  group_by(ID, icu, rel_day, rem_sync_days) %>%
  summarize(datetime = min(datetime, na.rm = T), across(all_of(covariates), mean, na.rm = T), .groups = "drop") %>%
  mutate(ID = as.factor(ID), rem_sync_days = as.integer(rem_sync_days)) %>%
  arrange(ID, desc(rem_sync_days)) %>%
  ungroup() %>%
  filter(rem_sync_days >= 0) %>%
  mutate(event = case_when(
    rem_sync_days > 0 ~ "stay",
    icu ~ "icu",
    T ~ "dismiss"
  ), .after = ID)


surv_data_intervals_tw6 %<>% inner_join(demographics, by = "ID")
surv_data_intervals_tw4 %<>% inner_join(demographics, by = "ID")
surv_data_fullday %<>% inner_join(demographics, by = "ID")

# overall statistics
surv_data_full_period_tw6 <- surv_morning_alt %>%
  mutate(
    ID = as.factor(ID),
    event = case_when(
      event == "stays" ~ "stay",
      event == "dismissed" ~ "dismiss",
      T ~ event
    )
  ) %>%
  inner_join(demographics, by = "ID")

surv_data_full_period_tw4 <- surv_morning_alt2 %>%
  mutate(
    ID = as.factor(ID),
    event = case_when(
      event == "stays" ~ "stay",
      event == "dismissed" ~ "dismiss",
      T ~ event
    )
  ) %>%
  inner_join(demographics, by = "ID")


# make dropouts right-censored
surv_data_intervals_tw6 %<>%
  mutate(event = ifelse((ID %in% dropouts), "stay", event))
surv_data_intervals_tw4 %<>%
  mutate(event = ifelse((ID %in% dropouts), "stay", event))
surv_data_fullday %<>%
  mutate(event = ifelse((ID %in% dropouts), "stay", event))

surv_data_full_period_tw6 %<>%
  mutate(event = ifelse((ID %in% dropouts), "stay", event))
surv_data_full_period_tw4 %<>%
  mutate(event = ifelse((ID %in% dropouts), "stay", event))

# make event a factor
surv_data_intervals_tw6 %<>% mutate(event = factor(event, ordered = T, levels = c("dismiss", "stay", "icu")))
surv_data_intervals_tw4 %<>% mutate(event = factor(event, ordered = T, levels = c("dismiss", "stay", "icu")))
surv_data_fullday %<>% mutate(event = factor(event, ordered = T, levels = c("dismiss", "stay", "icu")))

surv_data_full_period_tw6 %<>% mutate(event = factor(event, ordered = T, levels = c("dismiss", "stay", "icu")))
surv_data_full_period_tw4 %<>% mutate(event = factor(event, ordered = T, levels = c("dismiss", "stay", "icu")))
```

Exclude invalid patients
```{r}
surv_data_intervals_tw6 %<>% filter(!(ID %in% exclude))
surv_data_intervals_tw4 %<>% filter(!(ID %in% exclude))
surv_data_fullday %<>% filter(!(ID %in% exclude))
surv_data_full_period_tw6 %<>% filter(!(ID %in% exclude))
surv_data_full_period_tw4 %<>% filter(!(ID %in% exclude))
```

Apply data quality improvements
```{r}
quality <- function(df) {
  df %>%
    filter(!(ID == "wave-021" & rel_day == 6)) %>% # night 6 has not enough data
    filter(!(ID == "wave-028" & rel_day == 1)) %>% # night 1 has not enough data
    filter(!(ID == "wave-049" & rel_day == 4)) # night 4 has not enough data
}

surv_data_intervals_tw6 %<>% quality()
surv_data_intervals_tw4 %<>% quality()
surv_data_fullday %<>% quality()
surv_data_full_period_tw6 %<>% quality()
surv_data_full_period_tw4 %<>% quality()
```

Relocate variables
```{r}
surv_data_intervals_tw6 %<>% relocate(ID, rel_day, rem_sync_days, event, icu, age, age60, sex) %>%
  arrange(ID, rel_day)
surv_data_intervals_tw4 %<>% relocate(ID, rel_day, rem_sync_days, event, icu, age, age60, sex) %>%
  arrange(ID, rel_day)

surv_data_fullday %<>% relocate(ID, rel_day, rem_sync_days, event, icu, age, age60, sex) %>%
  arrange(ID, rel_day)

surv_data_full_period_tw6 %<>% relocate(ID, datetime, rel_day, event, age, age60, sex) %>%
  arrange(ID, rel_day)
surv_data_full_period_tw4 %<>% relocate(ID, datetime, rel_day, event, age, age60, sex) %>%
  arrange(ID, rel_day)
```

Scale
```{r}
covariates <- names(wave_features %>% select(-c(datetime, ID)) %>% select(!contains("sign_changes")))

surv_data_intervals_tw6 %<>% mutate(age = scale(age), across(all_of(covariates), scale))
surv_data_intervals_tw4 %<>% mutate(age = scale(age), across(all_of(covariates), scale))

surv_data_fullday %<>% mutate(age = scale(age), across(all_of(covariates), scale))


covariates <- names(surv_data_full_period_tw6 %>% select(-(ID:sex)) %>% select(!contains("sign_changes")))

surv_data_full_period_tw6 %<>% mutate(age = scale(age), across(all_of(covariates), scale))
surv_data_full_period_tw4 %<>% mutate(age = scale(age), across(all_of(covariates), scale))
```

Sanity check: are all observations matched?
```{r}
surv_data_intervals_tw6 %>%
  select(ID, rel_day, event) %>%
  full_join(surv_data_full_period_tw6 %>% select(ID, rel_day, event, datetime), by = c("ID", "rel_day")) %>%
  filter(event.x != event.y | is.na(event.y) | is.na(event.y))

surv_data_intervals_tw4 %>%
  select(ID, rel_day, event) %>%
  full_join(surv_data_full_period_tw4 %>% select(ID, rel_day, event, datetime), by = c("ID", "rel_day")) %>%
  filter(event.x != event.y | is.na(event.y) | is.na(event.y))
```

Use mean of 5min values for hrv features, and full data for all other features
```{r}
surv_data_tw6 <- surv_data_full_period_tw6 %>%
  select(-starts_with("hrv_")) %>%
  full_join(surv_data_intervals_tw6 %>% select(ID:rel_day, starts_with("hrv_")), by = c("ID", "rel_day"))
nrow(surv_data_tw6) == nrow(surv_data_full_period_tw6) & nrow(surv_data_tw6) == nrow(surv_data_intervals_tw6)

surv_data_tw4 <- surv_data_full_period_tw4 %>%
  select(-starts_with("hrv_")) %>%
  full_join(surv_data_intervals_tw4 %>% select(ID:rel_day, starts_with("hrv_")), by = c("ID", "rel_day"))
nrow(surv_data_tw4) == nrow(surv_data_full_period_tw4) & nrow(surv_data_tw4) == nrow(surv_data_intervals_tw4)
```