Merge pull request #16 from salauer/master

updates to COVID-19 data and shiny app

R/data-ebola_gamma_pstr.R

@@ -71,13 +71,13 @@ NULL
 
 
 #'
-#' Bootstrapped parameter estimates of 2019-nCoV incubation period
+#' Bootstrapped parameter estimates of COVID-19 incubation period
 #'
 #' A dataset containing samples from an estimated bootstrap distribution of the
-#' incubation period of 2019-nCoV was estimated from data
+#' incubation period of COVID-19 was estimated from data
 #' collected and stored at https://github.com/HopkinsIDD/ncov_incubation.
 #'
-#' @format A data frame with 1,000 rows and 2 variables:
+#' @format A data frame with 1,000 rows and 5 variables:
 #' \itemize{
 #'   \item \code{meanlog} meanlog parameter of log-normal distribution
 #'   \item \code{sdlog} sdlog parameter of log-normal distribution
@@ -88,10 +88,10 @@ NULL
 #' @docType data
 #' @references
 #' \itemize{
-#'   \item Lauer, S. A., Grantz, K. H., Bi, Q., Jones, F. K., Zheng, Q., Meredith, H., Azman, A. S., Reich, N. G., & Lessler, J. The incubation period of 2019-nCoV from publicly reported confirmed cases: estimation and application. medRxiv (2020).
+#'   \item Lauer, S. A., Grantz, K. H., Bi, Q., Jones, F. K., Zheng, Q., Meredith, H. R., Azman, A. S., Reich, N. G., & Lessler, J. The incubation period of 2019-nCoV from publicly reported confirmed cases: estimation and application. medRxiv (2020).
 #' }
-#' @name boot_lnorm_params_ncov
-#' @usage data(boot_lnorm_params_ncov)
+#' @name boot_lnorm_params_covid
+#' @usage data(boot_lnorm_params_covid)
 NULL
 
 
@@ -103,6 +103,6 @@ NULL
 #' @name kde_smallpox
 #' @name kde_ebola
 #' @name kde_mers
-#' @name kde_ncov
+#' @name kde_covid
 #' @usage data(kde_ebola)
 NULL

inst/analysis-code/fit-incper-distr-covid.R

@@ -0,0 +1,15 @@
+## fit gamma incubation period distribution to COVID-19 data
+## Nicholas Reich and Stephen A Lauer
+## started: February 2020
+
+source('inst/analysis-code/inc-per-mcmc.R')
+library(dplyr)
+data(boot_lnorm_params_covid)
+
+## calculate bandwidths for plotting
+hscv_covid_p50 <- get_robust_bandwidths(boot_lnorm_params_covid,
+                                        cols=c("median", "p95"))
+
+## calculate KDE for confidence region
+kde_covid <- fit_kde(boot_lnorm_params_covid, H=hscv_covid_p50, max_size=1000)
+save(kde_covid, file='data/kde_covid.rda')

inst/shiny/active-monitoring/global.R

@@ -19,11 +19,11 @@ theme_set(theme_bw(base_size = 18))
 data(pstr_gamma_params_ebola)
 data(pstr_gamma_params_mers)
 data(pstr_gamma_params_smallpox)
-data(boot_lnorm_params_ncov)
+data(boot_lnorm_params_covid)
 data(kde_smallpox)
 data(kde_ebola)
 data(kde_mers)
-data(kde_ncov)
+data(kde_covid)
 
 plot1_side_text <- conditionalPanel(
   condition="input.tabs == 'cost.plot'",

inst/shiny/active-monitoring/server.R

@@ -16,12 +16,12 @@ shinyServer(function(input, output, session) {
         cost_mat <- rbind(cost_m, cost_trt, cost_exp, cost_falsepos)
 
         pstr_params <- switch(input$plot1_disease,
-                              nCoV = boot_lnorm_params_ncov,
+                              COVID = boot_lnorm_params_covid,
                               Ebola = pstr_gamma_params_ebola,
                               Mers = pstr_gamma_params_mers,
                               Smallpox = pstr_gamma_params_smallpox)
 
-        if(input$plot1_disease=="nCoV"){
+        if(input$plot1_disease=="COVID"){
             inc_dist <- "lnorm"
             gamma_params <- c(median = mean(pstr_params$median),
                               meanlog = mean(pstr_params$meanlog),
@@ -93,11 +93,11 @@ shinyServer(function(input, output, session) {
         plot_modified_credible_regions(list(pstr_gamma_params_ebola,
                                             pstr_gamma_params_mers,
                                             pstr_gamma_params_smallpox,
-                                            boot_lnorm_params_ncov),
+                                            boot_lnorm_params_covid),
                                        kdes=list(kde_ebola,
                                                  kde_mers,
                                                  kde_smallpox,
-                                                 kde_ncov),
+                                                 kde_covid),
                                        label_txt=c("Ebola", "MERS-CoV", "Smallpox", "COVID-19"),
                                        colors=colors, show.legend=TRUE, base.size=18)
     })
@@ -107,15 +107,15 @@ shinyServer(function(input, output, session) {
     output$plot_risk_uncertainty <-renderPlot({
         # browser()
         pstr_params <- switch(input$plot3_disease,
-                              nCoV = boot_lnorm_params_ncov,
+                              COVID = boot_lnorm_params_covid,
                               Ebola = pstr_gamma_params_ebola,
                               Mers = pstr_gamma_params_mers,
                               Smallpox = pstr_gamma_params_smallpox)
 
         durs <- input$plot3_duration[1]:input$plot3_duration[2]
         phis <- as.numeric(input$plot3_prob_symptoms)
 
-        if(input$plot3_disease=="nCoV"){
+        if(input$plot3_disease=="COVID"){
             p <- plot_risk_uncertainty(pstr_data = pstr_params,
                                        dist = "lnorm",
                                        u=runif(1000, input$plot3_u[1],
@@ -153,36 +153,54 @@ shinyServer(function(input, output, session) {
             coord_cartesian(ylim=c(p_min, p_max)) +
             theme(axis.text=element_text(color="black"),
                   strip.background=element_rect(fill="white"))
-        # ggplot(costs, aes(x=dur_median,
-        #                   color=phi_lab, fill=phi_lab)) +
-        #     geom_ribbon(aes(ymin=mincost, ymax=maxcost), alpha=.7) +
-        #     scale_y_log10(labels=dollar,
-        #                   name='Cost range of monitoring 100 individuals') +
-        #     scale_x_continuous(name='Duration of active monitoring (in days)', expand=c(0,0)) +
-        #     coord_cartesian(xlim=c(5, 43)) +
-        #     scale_fill_brewer(palette="Dark2") +
-        #     scale_color_brewer(palette="Dark2") +
-        #     ## horizontal dashed line segments
-        #     geom_segment(data=min_costs,
-        #                  aes(x=3, xend=min_cost_dur_days,
-        #                      y=min_cost, yend=min_cost, color=phi_lab),
-        #                  linetype=2) +
-        #     ## vertical dashed line segments
-        #     geom_segment(data=min_costs,
-        #                  aes(x=min_cost_dur_days, xend=min_cost_dur_days,
-        #                      y=0, yend=min_cost, color=phi_lab),
-        #                  linetype=2) +
-        #     ## labels for line segments
-        #     geom_text(data=min_costs, nudge_x = 1,
-        #               aes(x=min_cost_dur_days, y=1000,
-        #                   label=paste(round(min_cost_dur_days),"d"))) +
-        #     theme(legend.title=element_blank(), legend.position=c(1, 1), legend.justification=c(1, 1)) +
-        #     ggtitle("Model-based cost range for monitoring 100 individuals") +
-        #     annotate("text", x=12, y=2000,
-        #              label="dashed lines indicate an optimal \n duration of active monitoring")
 
     })
 
+    ## create table of undetected infections data
+    output$tbl_risk_uncertainty <- renderDataTable({
+        # browser()
+        pstr_params <- switch(input$plot3_disease,
+                              COVID = boot_lnorm_params_covid,
+                              Ebola = pstr_gamma_params_ebola,
+                              Mers = pstr_gamma_params_mers,
+                              Smallpox = pstr_gamma_params_smallpox)
+
+        durs <- input$plot3_duration[1]:input$plot3_duration[2]
+        phis <- as.numeric(input$plot3_prob_symptoms)
+
+        if(input$plot3_disease=="COVID"){
+            p <- plot_risk_uncertainty(pstr_data = pstr_params,
+                                       dist = "lnorm",
+                                       u=runif(1000, input$plot3_u[1],
+                                               input$plot3_u[2]),
+                                       durations = durs,
+                                       phi = phis,
+                                       ci_width = input$plot3_ci,
+                                       output_plot = FALSE,
+                                       return_data=T,
+                                       return_plot=T)
+        } else{
+            p <- plot_risk_uncertainty(pstr_data = pstr_params,
+                                       u=runif(1000, input$plot3_u[1],
+                                               input$plot3_u[2]),
+                                       durations = durs,
+                                       phi = phis,
+                                       ci_width = input$plot3_ci,
+                                       output_plot = FALSE,
+                                       return_data=T,
+                                       return_plot=T)
+        }
+    p$data %>%
+        # filter(d %in% c(min(durs), round(median(durs)), max(durs))) %>%
+        transmute(`Duration, in days` = d,
+                  `Lower bound` = round(1e4*ltp,2),
+                  `Median` = round(1e4*p50,2),
+                  `Upper bound` = round(1e4*utp,2))
+
+    }, options=list(searching=F, paginate=F,info=F,
+                    pageLength=input$plot3_duration[2],
+                    scroller=T, scrollY=300))
+
 
 })