knitr::opts_chunk$set( collapse = TRUE, comment = "#>", fig.width=7, fig.height=5, fig.path="figs-overview/")
Load environment:
library(dplyr) library(epitrix) library(distcrete) library(followup)
Set up the incubation period distribution:
incubation_days <- 0:3 incubation_frequency <- c(1,3,2,1) incubation_frequency <- incubation_frequency/sum(incubation_frequency) plot(incubation_days, incubation_frequency, type = "h")
Make a list of example contacts each having just one exposure date in dates_exposure
.
contact_list <- data.frame( id_contact = c("a", "b", "c", "d"), type_exposure = c("hospital", "funeral", "family", "restaurant"), dates_exposure = as.Date(c("2021-01-15", "2021-01-14", "2021-01-10", "2021-01-16")) ) contact_list
date_analysis <- as.Date("2021-01-16") res <- purrr::map(contact_list$dates_exposure, function(x) integrate_incubation(incubation_frequency, date_low = x, date_high = date_analysis)) res <- unlist(res) res
We can compute the results by hand and compare:
expected <- c(4/7, 6/7, 1, 1/7) testthat::expect_equal(res, expected)
Should get exactly the same result using the function including a followup when 1) last follow-up is NA 2) last follow-up is in before exposure
testthat::expect_equal( expected, integrate_incubation_followup(incubation_frequency, date_exposure = contact_list$dates_exposure, date_analysis = date_analysis, date_last_followup = NA) ) testthat::expect_equal( expected, integrate_incubation_followup(incubation_frequency, date_exposure = contact_list$dates_exposure, date_analysis = date_analysis, date_last_followup = as.Date("2021-01-01")) )
Now add a date of last follow-up for each contact:
contact_list$dates_last_followup <- as.Date(c("2021-01-15", "2021-01-15", "2021-01-12", "2021-01-16")) contact_list
res <- integrate_incubation_followup(incubation_frequency, date_exposure = contact_list$dates_exposure, date_analysis = date_analysis, date_last_followup = contact_list$dates_last_followup)
expected <- c((3/7) / (1-1/7), (2/7) / (1-1/7-3/7), 1, 0) testthat::expect_equal(res, expected)
there is a few more special cases here that should be illustrated here, see code
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.