Fractional Subclinical Transmsisson

Calculate serial intervals and estimate fractional preclinical transmsission

Clinical Onset

The find_clinical_onset() function identifies first occurrence of score > 0 then creates new “Event” column with 1 at this date, 0’s before this date, and a value 3 after that date.

Hide code

clin_start_df <- as.data.frame(
  find_clinical_onset(antem_df)
)

onsets_df <- clin_start_df %>% 
  filter(Event == 1)

Empiracal Incubation Period

Hide code

empirical_incub_periods <- clin_start_df %>%
  group_by(animal, group) %>%
  summarise(
    incubation_period = if (nrow(filter(pick(everything()), Event == 1)) == 0) {
      NA
    } else {
      as.numeric(
        filter(pick(everything()), Event == 1)$date - filter(pick(everything()), dpe == 0)$date
      )
    }
  ) %>%
  ungroup()

group_incu <- as.data.frame(
  empirical_incub_periods %>%
  group_by(group) %>%
  summarise(mean_incu = mean(incubation_period, na.rm=T),
            sd_incu = sd(incubation_period, na.rm=T)) %>%
    filter(group %in% c("Group 2", "Group 3", "Group 4"))
  ) 

emp_incub <- empirical_incub_periods %>%
  filter(is.na(incubation_period) == FALSE)

Empirical Serial Interval

Hide code

donors <- onsets_df[onsets_df$group == "donor", ]
secondary <- onsets_df[onsets_df$group != "donor", ]

serial_intervals <- list()
# loop over each donor
for (i in 1:nrow(donors)) {
  donor_date <- donors$date[i]
  donor_animal <- donors$animal[i]
  
  # serial intervals
  intervals <- secondary$date - donor_date
  
  serial_intervals[[donor_animal]] <- data.frame(
    donor = donor_animal,
    secondary = secondary$animal,
    group = secondary$group,
    serial_interval = as.numeric(intervals)
  )
}

serial_intervals_df <- do.call(rbind, serial_intervals)

range(serial_intervals_df$serial_interval)

[1] 1 3

Hide code

group_si <- as.data.frame(
  serial_intervals_df %>%
  group_by(group) %>%
  summarize(si_mean = mean(serial_interval),
            si_sd = sd(serial_interval)) %>%
    filter(group %in% c("Group 2", "Group 3", "Group 4"))
)

group_means <- left_join(group_incu, group_si, by = "group")

Bootstrap Preclinical Fraction

Hide code

boot_out <- bootstrap_preclinical_frac(group_means)

boot_out$plot