Statistical Modelling for Infectious Disease Management - Contagious period

Question

A person begins to show symptoms of COVID-19 on 28.12.2021. When has the person been infectious?

Generating a data frame with dates and infectiousness probability using get_infectiousness_density

If the person shows symptoms, the function get_infectiousness_density() can be used to answer the question. The function get_infectiousness_density() creates a dataframe containing the infectiousness at a particular date/time.

Inputs

The following input arguments are needed for the function get_infectiousness_density():

The symptom_begin_date is the date when the person started to have symptoms.

Then, the max_infectious_days is needed, which defines the interval length of the distribution output.

The other three inputs infectiousness_shift, shape_infectiousness_gamma and rate_infectiousness_gamma are the parameters of the gamma distribution for the infectiousness profile.

symptom_begin_date <- as.Date("2021-12-28")
infectiousness_shift <- 12.272481
max_infectious_days <- 24
shape_infectiousness_gamma <- 20.516508
rate_infectiousness_gamma <- 1.592124

infectious_df <- get_infectiousness_density(symptom_begin_date,
                                            infectiousness_shift,
                                            max_infectious_days,
                                            shape_infectiousness_gamma,
                                            rate_infectiousness_gamma)

Methodology

The default values of the gamma distribution are taken from the paper He et al [1]. In this paper an analysis of COVID-19 viral shedding and transmissibility was conducted and a gamma distribution for the infectious period of cases was estimated based on their symptom onset dates.

Output

The function call returns the following data frame:

values 100 to 109 of resulting data frame
dates distribution
100 2021-12-19 21:27:37 0.0000353
101 2021-12-19 22:27:37 0.0000402
102 2021-12-19 23:27:37 0.0000457
103 2021-12-20 00:27:37 0.0000519
104 2021-12-20 01:27:37 0.0000587
105 2021-12-20 02:27:37 0.0000663
106 2021-12-20 03:27:37 0.0000748
107 2021-12-20 04:27:37 0.0000843
108 2021-12-20 05:27:37 0.0000947
109 2021-12-20 06:27:37 0.0001063

The function get_infectiousness_density() creates an interval of length max_infectious_days and the resulting data frame shows the resulting density of the gamma distribution for each hour of the period. This density can be used for calculating the most probable period to infect other people.

Visualization example of the data frame of get_infectiousness_density

The following code generates a plot with the gamma distribution of the infectiousness profile and the 80% and 95% high density intervals.

Source 
.calculate_qstart_qend <- function(probability, df) {
    hdr_df <- hdr(den = data.frame(x = 1:length(df$distribution), y = df$distribution), p = probability * 100)$hdr
    qstart <- (hdr_df[1, 1] - 1) / 24
    qend   <- (hdr_df[1, 2] - 1) / 24
  return(list("qstart" = qstart, "qend" = qend))
}

period_80 <- .calculate_qstart_qend(0.8, infectious_df) 
period_95 <- .calculate_qstart_qend(0.95, infectious_df)
Source 
.shade_curve <- function(df, qstart, qend, fill = "red", alpha = 0.4) {
  subset_df <- df[floor(qstart * 24):ceiling(qend * 24), ]
  geom_area(data = subset_df,
            aes(x = x, y = y), 
            fill = fill, 
            color = NA, 
            alpha = alpha)
}
Source 
  symptom_begin_date <- as.Date("2021-12-28")

  df <- infectious_df
  
  symp_date_posixct_start <- as.POSIXct(format(as.POSIXct(symptom_begin_date, tz = "CET"), "%Y-%m-%d"))
  symp_date_posixct_end <- as.POSIXct(format(as.POSIXct(symptom_begin_date + 1, tz = "CET"), "%Y-%m-%d"))
  symp_date_posixct_mid <- symp_date_posixct_start - as.numeric(difftime(symp_date_posixct_start,
                           symp_date_posixct_end, units = "hours")) / 2 * 3600
Source 
  g <- ggplot() +

    scale_x_datetime(breaks = scales::date_breaks("1 days"), labels = scales::date_format("%d-%m-%Y")) +
    theme(axis.text.x = element_text(angle = 90)) +
    # scale_x_continuous(breaks = x_tick,
    #                    labels = x_label) +
    # theme(axis.ticks.x = element_line(color = c(rbind(rep("black", length(x_label)/2), rep(NA, length(x_label)/2))), linetype = 2, size = 1))+
    geom_path(aes(x = df$dates, y = df$distribution, color = "red")) +
    .shade_curve(df = data.frame(x = df$dates, y = df$distribution),
                 period_80$qstart,
                 period_80$qend) +
    .shade_curve(df = data.frame(x = df$dates, y = df$distribution),
                 period_95$qstart,
                 period_95$qend,
                 alpha = 0.2) +
    geom_rect(data = data.frame(xmin = symp_date_posixct_start,
                                xmax = symp_date_posixct_end,
                                ymin = -Inf,
                                ymax = Inf),
              aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax),
              fill = "brown", alpha = 0.3) +
    geom_label(aes(x = symp_date_posixct_mid, y = 0.9*max(df$distribution), label = "symptom\nonset"),
              colour = "brown", fill = "white", size = 5, label.size = NA) +
    ylab("probability") +
    xlab("timeline") +
    labs(color = 'Verteilung') +
    # ggtitle("Visualization of get_infection_density") +
    theme(legend.position = "none", text = element_text(size = 16*5/5)) +
    theme(axis.text.x = element_text(colour = "black", face = "bold", angle = 30, hjust = 1)) +
    theme(axis.title.x = element_text(colour = "black", face = "bold")) +
    theme(axis.text.y = element_text(colour = "gray50")) +
    theme(axis.title.y = element_text(colour = "gray50"))

  g

Literature

[1] He X, Lau EHY, Wu P, Deng X, Wang J, Hao X, Lao YC, Wong JY, Guan Y, Tan X, Mo X, Chen Y, Liao B, Chen W, Hu F, Zhang Q, Zhong M, Wi Y, Zhao L, Zhang F, Cowling BJ, Li F, Leung GM. Temporal dynamics in viral shedding and transmissibility of COVID-19. Nature Medicine. 2020; 26: 672–675.