From e920b3e514e717fc05ed524267d3b53e272fec51 Mon Sep 17 00:00:00 2001 From: Naeem Model Date: Mon, 6 Jan 2025 23:55:43 +0000 Subject: Update web app entry point - Rename 'app' -> 'web' - Return shiny app object in entry point function --- inst/app/app.R | 13 - inst/app/index.html | 19 -- inst/app/scripts/data.R | 253 ---------------- inst/app/scripts/estimators.R | 327 --------------------- inst/app/templates/content.html | 14 - inst/app/templates/content/about.html | 28 -- inst/app/templates/content/data.html | 12 - inst/app/templates/content/data/enter-data.html | 9 - .../content/data/enter-data/load-samples.html | 19 -- .../content/data/enter-data/manual-entry.html | 11 - .../content/data/enter-data/required-format.html | 25 -- .../content/data/enter-data/upload-data.html | 12 - inst/app/templates/content/data/view-data.html | 3 - .../content/data/view-data/data-plots.html | 7 - .../content/data/view-data/data-table.html | 18 -- inst/app/templates/content/estimation.html | 13 - .../content/estimation/about-estimators.html | 31 -- .../content/estimation/about-estimators/id.html | 3 - .../content/estimation/about-estimators/idea.html | 4 - .../content/estimation/about-estimators/panel.html | 14 - .../estimation/about-estimators/seq_bayes.html | 9 - .../content/estimation/about-estimators/wp.html | 6 - .../templates/content/estimation/estimates.html | 3 - .../estimation/estimates/add-estimators.html | 16 - .../estimation/estimates/add-estimators/id.html | 1 - .../estimation/estimates/add-estimators/idea.html | 1 - .../estimation/estimates/add-estimators/mu.html | 22 -- .../estimates/add-estimators/parameters.html | 7 - .../estimates/add-estimators/seq_bayes.html | 22 -- .../estimation/estimates/add-estimators/wp.html | 39 --- .../estimation/estimates/estimates-table.html | 19 -- inst/app/templates/content/help.html | 8 - inst/app/templates/content/help/panel.html | 12 - .../templates/content/help/serial-interval.html | 9 - inst/app/templates/footer.html | 7 - inst/app/templates/navbar.html | 27 -- inst/app/templates/tabs.html | 14 - inst/app/www/script.js | 21 -- inst/app/www/styles.css | 23 -- inst/web/app.R | 13 + inst/web/index.html | 19 ++ inst/web/scripts/data.R | 253 ++++++++++++++++ inst/web/scripts/estimators.R | 327 +++++++++++++++++++++ inst/web/templates/content.html | 14 + inst/web/templates/content/about.html | 28 ++ inst/web/templates/content/data.html | 12 + inst/web/templates/content/data/enter-data.html | 9 + .../content/data/enter-data/load-samples.html | 19 ++ .../content/data/enter-data/manual-entry.html | 11 + .../content/data/enter-data/required-format.html | 25 ++ .../content/data/enter-data/upload-data.html | 12 + inst/web/templates/content/data/view-data.html | 3 + .../content/data/view-data/data-plots.html | 7 + .../content/data/view-data/data-table.html | 18 ++ inst/web/templates/content/estimation.html | 13 + .../content/estimation/about-estimators.html | 31 ++ .../content/estimation/about-estimators/id.html | 3 + .../content/estimation/about-estimators/idea.html | 4 + .../content/estimation/about-estimators/panel.html | 14 + .../estimation/about-estimators/seq_bayes.html | 9 + .../content/estimation/about-estimators/wp.html | 6 + .../templates/content/estimation/estimates.html | 3 + .../estimation/estimates/add-estimators.html | 16 + .../estimation/estimates/add-estimators/id.html | 1 + .../estimation/estimates/add-estimators/idea.html | 1 + .../estimation/estimates/add-estimators/mu.html | 22 ++ .../estimates/add-estimators/parameters.html | 7 + .../estimates/add-estimators/seq_bayes.html | 22 ++ .../estimation/estimates/add-estimators/wp.html | 39 +++ .../estimation/estimates/estimates-table.html | 19 ++ inst/web/templates/content/help.html | 8 + inst/web/templates/content/help/panel.html | 12 + .../templates/content/help/serial-interval.html | 9 + inst/web/templates/footer.html | 7 + inst/web/templates/navbar.html | 27 ++ inst/web/templates/tabs.html | 14 + inst/web/www/script.js | 21 ++ inst/web/www/styles.css | 23 ++ 78 files changed, 1101 insertions(+), 1101 deletions(-) delete mode 100644 inst/app/app.R delete mode 100644 inst/app/index.html delete mode 100644 inst/app/scripts/data.R delete mode 100644 inst/app/scripts/estimators.R delete mode 100644 inst/app/templates/content.html delete mode 100644 inst/app/templates/content/about.html delete mode 100644 inst/app/templates/content/data.html delete mode 100644 inst/app/templates/content/data/enter-data.html delete mode 100644 inst/app/templates/content/data/enter-data/load-samples.html delete mode 100644 inst/app/templates/content/data/enter-data/manual-entry.html delete mode 100644 inst/app/templates/content/data/enter-data/required-format.html delete mode 100644 inst/app/templates/content/data/enter-data/upload-data.html delete mode 100644 inst/app/templates/content/data/view-data.html delete mode 100644 inst/app/templates/content/data/view-data/data-plots.html delete mode 100644 inst/app/templates/content/data/view-data/data-table.html delete mode 100644 inst/app/templates/content/estimation.html delete mode 100644 inst/app/templates/content/estimation/about-estimators.html delete mode 100644 inst/app/templates/content/estimation/about-estimators/id.html delete mode 100644 inst/app/templates/content/estimation/about-estimators/idea.html delete mode 100644 inst/app/templates/content/estimation/about-estimators/panel.html delete mode 100644 inst/app/templates/content/estimation/about-estimators/seq_bayes.html delete mode 100644 inst/app/templates/content/estimation/about-estimators/wp.html delete mode 100644 inst/app/templates/content/estimation/estimates.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/id.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/idea.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/mu.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/parameters.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/seq_bayes.html delete mode 100644 inst/app/templates/content/estimation/estimates/add-estimators/wp.html delete mode 100644 inst/app/templates/content/estimation/estimates/estimates-table.html delete mode 100644 inst/app/templates/content/help.html delete mode 100644 inst/app/templates/content/help/panel.html delete mode 100644 inst/app/templates/content/help/serial-interval.html delete mode 100644 inst/app/templates/footer.html delete mode 100644 inst/app/templates/navbar.html delete mode 100644 inst/app/templates/tabs.html delete mode 100644 inst/app/www/script.js delete mode 100644 inst/app/www/styles.css create mode 100644 inst/web/app.R create mode 100644 inst/web/index.html create mode 100644 inst/web/scripts/data.R create mode 100644 inst/web/scripts/estimators.R create mode 100644 inst/web/templates/content.html create mode 100644 inst/web/templates/content/about.html create mode 100644 inst/web/templates/content/data.html create mode 100644 inst/web/templates/content/data/enter-data.html create mode 100644 inst/web/templates/content/data/enter-data/load-samples.html create mode 100644 inst/web/templates/content/data/enter-data/manual-entry.html create mode 100644 inst/web/templates/content/data/enter-data/required-format.html create mode 100644 inst/web/templates/content/data/enter-data/upload-data.html create mode 100644 inst/web/templates/content/data/view-data.html create mode 100644 inst/web/templates/content/data/view-data/data-plots.html create mode 100644 inst/web/templates/content/data/view-data/data-table.html create mode 100644 inst/web/templates/content/estimation.html create mode 100644 inst/web/templates/content/estimation/about-estimators.html create mode 100644 inst/web/templates/content/estimation/about-estimators/id.html create mode 100644 inst/web/templates/content/estimation/about-estimators/idea.html create mode 100644 inst/web/templates/content/estimation/about-estimators/panel.html create mode 100644 inst/web/templates/content/estimation/about-estimators/seq_bayes.html create mode 100644 inst/web/templates/content/estimation/about-estimators/wp.html create mode 100644 inst/web/templates/content/estimation/estimates.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/id.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/idea.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/mu.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/parameters.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/seq_bayes.html create mode 100644 inst/web/templates/content/estimation/estimates/add-estimators/wp.html create mode 100644 inst/web/templates/content/estimation/estimates/estimates-table.html create mode 100644 inst/web/templates/content/help.html create mode 100644 inst/web/templates/content/help/panel.html create mode 100644 inst/web/templates/content/help/serial-interval.html create mode 100644 inst/web/templates/footer.html create mode 100644 inst/web/templates/navbar.html create mode 100644 inst/web/templates/tabs.html create mode 100644 inst/web/www/script.js create mode 100644 inst/web/www/styles.css (limited to 'inst') diff --git a/inst/app/app.R b/inst/app/app.R deleted file mode 100644 index 639dc87..0000000 --- a/inst/app/app.R +++ /dev/null @@ -1,13 +0,0 @@ -ui <- htmlTemplate("index.html") - -server <- function(input, output) { - source("scripts/data.R", local = TRUE) - source("scripts/estimators.R", local = TRUE) - - react_values <- reactiveValues() - - data_logic(input, output, react_values) - estimators_logic(input, output, react_values) -} - -shinyApp(ui, server) diff --git a/inst/app/index.html b/inst/app/index.html deleted file mode 100644 index 504918d..0000000 --- a/inst/app/index.html +++ /dev/null @@ -1,19 +0,0 @@ - - - - {{ bootstrapLib(theme = bslib::bs_theme(primary = "black")) }} - {{ headContent() }} - Rnaught Web - - - - - - {{ htmlTemplate("templates/navbar.html") }} - {{ htmlTemplate("templates/tabs.html") }} - {{ htmlTemplate("templates/content.html") }} - {{ htmlTemplate("templates/footer.html") }} - - diff --git a/inst/app/scripts/data.R b/inst/app/scripts/data.R deleted file mode 100644 index 8f8694c..0000000 --- a/inst/app/scripts/data.R +++ /dev/null @@ -1,253 +0,0 @@ -# Main logic block for data-related interactions. -data_logic <- function(input, output, react_values) { - # Initialize a data frame to hold the datasets. - react_values$data_table <- data.frame( - Name = character(0), - `Time units` = character(0), - `Case counts` = character(0), - check.names = FALSE - ) - - manual_entry(input, output, react_values) - upload_data(input, output, react_values) - load_samples(input, output, react_values) - render_data_table(output, react_values) - render_plot(input, output, react_values, "Days") - render_plot(input, output, react_values, "Weeks") - delete_data(input, react_values) - export_data(output, react_values) -} - -# Convert the input case counts string to an integer vector. -tokenize_counts <- function(counts_str) { - suppressWarnings(as.integer(unlist(strsplit(trimws(counts_str), ",")))) -} - -# Render the plots for daily and weekly data when the data table is updated. -render_plot <- function(input, output, react_values, time_units) { - observe({ - datasets <- react_values$data_table[ - which(react_values$data_table[["Time units"]] == time_units), - ] - - data_plot <- plotly::plot_ly(type = "scatter", mode = "lines") - if (nrow(datasets) > 0) { - for (i in seq_len(nrow(datasets))) { - counts <- tokenize_counts(datasets[i, 3]) - data_plot <- plotly::add_trace(data_plot, - x = seq_along(counts) - 1, y = counts, name = datasets[i, 1] - ) - } - } - - plot_title <- paste( - if (time_units == "Days") "Daily" else "Weekly", "case counts" - ) - - data_plot <- plotly::layout(data_plot, title = plot_title, - xaxis = list(title = time_units), yaxis = list(title = "Cases") - ) - - data_plot <- plotly::config(data_plot, displaylogo = FALSE, - toImageButtonOptions = list( - filename = paste0("Rnaught_data_", tolower(time_units), "_plot") - ) - ) - - output[[paste0("data_plot_", tolower(time_units))]] <- - plotly::renderPlotly(data_plot) - }) -} - -# Validate and add manually-entered datasets. -manual_entry <- function(input, output, react_values) { - observeEvent(input$data_bulk, { - validate_data(input, output, react_values, "data_area") - }) -} - -# Validate and add datasets from a CSV file. -upload_data <- function(input, output, react_values) { - observeEvent(input$data_upload, { - validate_data(input, output, react_values, "data_upload") - }) -} - -# Validate datasets and update the data table. -validate_data <- function(input, output, react_values, data_source) { - tryCatch( - { - if (data_source == "data_area") { - datasets <- read.csv(text = input$data_area, header = FALSE, sep = ",") - } else if (data_source == "data_upload") { - datasets <- read.csv( - file = input$data_upload$datapath, header = FALSE, sep = "," - ) - } - - names <- trimws(datasets[, 1]) - units <- trimws(datasets[, 2]) - counts <- apply(data.frame(datasets[, 3:ncol(datasets)]), 1, - function(row) { - row <- suppressWarnings(as.integer(row)) - toString(row[!is.na(row) & row >= 0]) - } - ) - - warning_text <- "" - - # Ensure the dataset names are neither blank nor duplicates. - if (anyNA(names) || any(names == "")) { - warning_text <- paste0(warning_text, - "Each row must begin with a non-blank dataset name.
" - ) - } else { - if (length(unique(names)) != length(names)) { - warning_text <- paste0(warning_text, - "The rows contain duplicate dataset names.
" - ) - } - if (any(names %in% react_values$data_table[, 1])) { - warning_text <- paste0(warning_text, - "The rows contain dataset names which already exist.
" - ) - } - } - - # Ensure the second entry in each row is a time unit equal to - # "Days" or "Weeks". - if (!all(units %in% c("Days", "Weeks"))) { - warning_text <- paste0(warning_text, - "The second entry in each row must be either 'Days' or 'Weeks'.
" - ) - } - - # Ensure the counts in each row have at least one non-negative integer. - if (any(counts == "")) { - warning_text <- paste0(warning_text, - "Each row must contain at least one non-negative integer.
" - ) - } - - output[[paste0(data_source, "_warn")]] <- renderUI(HTML(warning_text)) - - if (warning_text == "") { - # Add the new datasets to the data table. - new_rows <- data.frame(names, units, counts) - colnames(new_rows) <- c("Name", "Time units", "Case counts") - react_values$data_table <- rbind(react_values$data_table, new_rows) - - # Evaluate all existing estimators on the new datasets and update the - # corresponding columns in the estimates table. - update_estimates_cols(new_rows, react_values) - - showNotification("Datasets added successfully.", duration = 3) - } - }, - error = function(e) { - output[[paste0(data_source, "_warn")]] <- renderText( - "The input does not match the required format." - ) - } - ) -} - -# Load sample datasets. -load_samples <- function(input, output, react_values) { - observeEvent(input$data_samples, { - names <- c() - units <- c() - counts <- c() - - # COVID-19 Canada, March 2020 (weekly). - if (input$covid_canada) { - names <- c(names, "COVID-19 Canada 2020/03/03 - 2020/03/31") - units <- c(units, "Weeks") - counts <- c(counts, toString(Rnaught::COVIDCanada[seq(41, 69, 7), 2])) - } - # COVID-19 Ontario, March 2020 (weekly). - if (input$covid_ontario) { - names <- c(names, "COVID-19 Ontario 2020/03/03 - 2020/03/31") - units <- c(units, "Weeks") - counts <- c(counts, - toString(Rnaught::COVIDCanadaPT[seq(10176, 10204, 7), 3]) - ) - } - - if (length(names) == 0) { - output$data_samples_warn <- renderText( - "At least one sample dataset must be selected." - ) - } else if (any(names %in% react_values$data_table[, 1])) { - output$data_samples_warn <- renderText( - "At least one of the selected dataset names already exist." - ) - } else { - output$data_samples_warn <- renderText("") - - new_rows <- data.frame(names, units, counts) - colnames(new_rows) <- c("Name", "Time units", "Case counts") - react_values$data_table <- rbind(react_values$data_table, new_rows) - - # Evaluate all existing estimators on the sample datasets and update the - # corresponding columns in the estimates table. - update_estimates_cols(new_rows, react_values) - - showNotification("Datasets added successfully.", duration = 3) - } - }) -} - -# Render the data table when new datasets are added. -render_data_table <- function(output, react_values) { - observe({ - output$data_table <- DT::renderDataTable( - react_values$data_table, rownames = FALSE - ) - }) -} - -# Delete rows in the data table and the corresponding columns in the estimates -# table. -delete_data <- function(input, react_values) { - observeEvent(input$data_delete, { - rows_selected <- input$data_table_rows_selected - react_values$data_table <- react_values$data_table[-rows_selected, ] - react_values$estimates_table <- - react_values$estimates_table[, -(rows_selected + 2)] - }) -} - -# Export data table as a CSV file. -export_data <- function(output, react_values) { - output$data_export <- downloadHandler( - filename = function() { - paste0("Rnaught_data_", format(Sys.time(), "%y-%m-%d_%H-%M-%S"), ".csv") - }, - content = function(file) { - write.csv(react_values$data_table, file, row.names = FALSE) - } - ) -} - -# When new datasets are added, evaluate all existing estimators on them and -# add new columns to the estimates table. -update_estimates_cols <- function(datasets, react_values) { - new_cols <- data.frame( - matrix(nrow = nrow(react_values$estimates_table), ncol = nrow(datasets)) - ) - colnames(new_cols) <- datasets[, 1] - - if (nrow(new_cols) > 0) { - for (row in seq_len(nrow(new_cols))) { - estimator <- react_values$estimators[[row]] - for (col in seq_len(ncol(new_cols))) { - new_cols[row, col] <- eval_estimator(estimator, datasets[col, ]) - } - } - } - - react_values$estimates_table <- cbind( - react_values$estimates_table, new_cols - ) -} diff --git a/inst/app/scripts/estimators.R b/inst/app/scripts/estimators.R deleted file mode 100644 index 7c457ea..0000000 --- a/inst/app/scripts/estimators.R +++ /dev/null @@ -1,327 +0,0 @@ -# Main logic block for estimator-related interactions. -estimators_logic <- function(input, output, react_values) { - # Initialize a data frame to hold estimates. - react_values$estimates_table <- data.frame( - Estimator = character(0), - `Serial interval` = character(0), - check.names = FALSE - - ) - # Initialize a list to hold added estimators. - react_values$estimators <- list() - - add_id(input, output, react_values) - add_idea(input, output, react_values) - add_seq_bayes(input, output, react_values) - add_wp(input, output, react_values) - - render_estimates(output, react_values) - delete_estimators(input, react_values) - export_estimates(output, react_values) -} - -# If an estimator is added, ensure it is not a duplicate and add it to the list -# of estimators. This function should be called at the end of each -# estimator-specific 'add' function, after validating their parameters. -add_estimator <- function(method, new_estimator, output, react_values) { - num_estimators <- length(react_values$estimators) - - # Check whether the new estimator is a duplicate, and warn if so. - for (i in seq_len(num_estimators)) { - if (identical(new_estimator, react_values$estimators[[i]])) { - showNotification( - "Error: This estimator has already been added.", duration = 3 - ) - return() - } - } - - # Add the new estimator to the list of estimators. - react_values$estimators[[num_estimators + 1]] <- new_estimator - - showNotification("Estimator added successfully.", duration = 3) - - # Evaluate the new estimator on all existing datasets and create a new row in - # the estimates table. - update_estimates_row(new_estimator, react_values) -} - -# Ensure serial intervals are specified as positive numbers. -validate_mu <- function(method, input, output) { - mu <- suppressWarnings(as.numeric(trimws(input[[paste0("mu_", method)]]))) - if (is.na(mu) || mu <= 0) { - output[[paste0("mu_", method, "_warn")]] <- renderText( - "The serial interval must be a positive number." - ) - return(NULL) - } - output[[paste0("mu_", method, "_warn")]] <- renderText("") - mu -} - -# Incidence Decay (ID). -add_id <- function(input, output, react_values) { - observeEvent(input$add_id, { - mu <- validate_mu("id", input, output) - if (!is.null(mu)) { - new_estimator <- list( - method = "id", mu = mu, mu_units = input$mu_id_units - ) - add_estimator("id", new_estimator, output, react_values) - } - }) -} - -# Incidence Decay and Exponential Adjustment (IDEA). -add_idea <- function(input, output, react_values) { - observeEvent(input$add_idea, { - mu <- validate_mu("idea", input, output) - if (!is.null(mu)) { - new_estimator <- list( - method = "idea", mu = mu, mu_units = input$mu_idea_units - ) - add_estimator("idea", new_estimator, output, react_values) - } - }) -} - -# Sequential Bayes (seqB). -add_seq_bayes <- function(input, output, react_values) { - observeEvent(input$add_seq_bayes, { - mu <- validate_mu("seq_bayes", input, output) - - kappa <- trimws(input$kappa) - kappa <- if (kappa == "") 20 else suppressWarnings(as.numeric(kappa)) - - if (is.na(kappa) || kappa < 1) { - output$kappa_warn <- renderText( - "The maximum prior must be a number greater than or equal to 1." - ) - } else if (!is.null(mu)) { - output$kappa_warn <- renderText("") - new_estimator <- list( - method = "seq_bayes", mu = mu, - mu_units = input$mu_seq_bayes_units, kappa = kappa - ) - add_estimator("seq_bayes", new_estimator, output, react_values) - } - }) -} - -# White and Pagano (WP). -add_wp <- function(input, output, react_values) { - observeEvent(input$add_wp, { - if (input$wp_mu_known == "Yes") { - mu <- validate_mu("wp", input, output) - if (!is.null(mu)) { - new_estimator <- list(method = "wp", - mu = mu, mu_units = input$mu_wp_units - ) - add_estimator("wp", new_estimator, output, react_values) - } - } else { - grid_length <- trimws(input$grid_length) - max_shape <- trimws(input$max_shape) - max_scale <- trimws(input$max_scale) - - suppressWarnings({ - grid_length <- if (grid_length == "") 100 else as.numeric(grid_length) - max_shape <- if (max_shape == "") 10 else as.numeric(max_shape) - max_scale <- if (max_scale == "") 10 else as.numeric(max_scale) - }) - - valid <- TRUE - - if (is.na(grid_length) || grid_length <= 0) { - output$grid_length_warn <- renderText( - "The grid length must be a positive integer." - ) - valid <- FALSE - } else { - output$grid_length_warn <- renderText("") - } - - if (is.na(max_shape) || max_shape <= 0) { - output$max_shape_warn <- renderText( - "The maximum shape must be a positive number." - ) - valid <- FALSE - } else { - output$max_shape_warn <- renderText("") - } - - if (is.na(max_scale) || max_scale <= 0) { - output$max_scale_warn <- renderText( - "The maximum scale must be a positive number." - ) - valid <- FALSE - } else { - output$max_scale_warn <- renderText("") - } - - if (valid) { - new_estimator <- list(method = "wp", mu = NA, grid_length = grid_length, - max_shape = max_shape, max_scale = max_scale - ) - add_estimator("wp", new_estimator, output, react_values) - } - } - }) -} - -# Convert an estimator's specified serial interval to match the time units of -# the given dataset. -convert_mu_units <- function(data_units, estimator_units, mu) { - if (data_units == "Days" && estimator_units == "Weeks") { - return(mu * 7) - } else if (data_units == "Weeks" && estimator_units == "Days") { - return(mu / 7) - } - mu -} - -# Add a row to the estimates table when a new estimator is added. -update_estimates_row <- function(estimator, react_values) { - dataset_rows <- seq_len(nrow(react_values$data_table)) - estimates <- c() - - if (nrow(react_values$data_table) > 0) { - estimates <- dataset_rows - for (row in dataset_rows) { - estimate <- eval_estimator(estimator, react_values$data_table[row, ]) - estimates[row] <- estimate - } - } - - new_row <- data.frame( - t(c(estimator_name(estimator), estimator_mu_text(estimator), estimates)) - ) - colnames(new_row) <- colnames(react_values$estimates_table) - - react_values$estimates_table <- rbind( - react_values$estimates_table, new_row - ) -} - -# Evaluate the specified estimator on the given dataset. -eval_estimator <- function(estimator, dataset) { - cases <- as.integer(unlist(strsplit(dataset[, 3], ","))) - - tryCatch( - { - if (estimator$method == "id") { - mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) - estimate <- round(Rnaught::id(cases, mu), 2) - } else if (estimator$method == "idea") { - mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) - estimate <- round(Rnaught::idea(cases, mu), 2) - } else if (estimator$method == "seq_bayes") { - mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) - estimate <- round(Rnaught::seq_bayes(cases, mu, estimator$kappa), 2) - } else if (estimator$method == "wp") { - if (is.na(estimator$mu)) { - estimate <- Rnaught::wp(cases, serial = TRUE, - grid_length = estimator$grid_length, - max_shape = estimator$max_shape, max_scale = estimator$max_scale - ) - estimated_mu <- round(sum(estimate$supp * estimate$pmf), 2) - mu_units <- if (dataset[, 2] == "Days") "day(s)" else "week(s)" - estimate <- paste0( - round(estimate$r0, 2), " (SI = ", estimated_mu, " ", mu_units, ")" - ) - } else { - mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) - estimate <- round(Rnaught::wp(cases, mu), 2) - } - } - - return(estimate) - }, error = function(e) { - showNotification( - paste0(toString(e), - " [Estimator: ", sub(" .*", "", estimator_name(estimator)), - ", Dataset: ", dataset[, 1], "]" - ), duration = 6 - ) - return("—") - } - ) -} - -# Create the name of an estimator to be added to the first column of the -# estimates table. -estimator_name <- function(estimator) { - if (estimator$method == "id") { - return("ID") - } else if (estimator$method == "idea") { - return("IDEA") - } else if (estimator$method == "seq_bayes") { - return(paste0("seqB", " (κ = ", estimator$kappa, ")")) - } else if (estimator$method == "wp") { - if (is.na(estimator$mu)) { - return(paste0("WP (", estimator$grid_length, ", ", - round(estimator$max_shape, 3), ", ", round(estimator$max_scale, 3), ")" - )) - } else { - return("WP") - } - } -} - -# Create the text to be displayed for the serial interval in the second column -# of the estimates table. -estimator_mu_text <- function(estimator) { - if (is.na(estimator$mu)) { - return("—") - } - mu_units <- if (estimator$mu_units == "Days") "day(s)" else "week(s)" - paste(estimator$mu, mu_units) -} - -# Render the estimates table whenever it is updated. -render_estimates <- function(output, react_values) { - observe({ - output$estimates_table <- DT::renderDataTable(react_values$estimates_table, - escape = FALSE, rownames = FALSE, - options = list( - columnDefs = list(list(className = "dt-left", targets = "_all")) - ), - ) - }) -} - -# Delete rows from the estimates table and the corresponding estimators. -delete_estimators <- function(input, react_values) { - observeEvent(input$estimators_delete, { - rows_selected <- input$estimates_table_rows_selected - react_values$estimators <- react_values$estimators[-rows_selected] - react_values$estimates_table <- - react_values$estimates_table[-rows_selected, ] - }) -} - -# Export estimates table as a CSV file. -export_estimates <- function(output, react_values) { - output$estimates_export <- downloadHandler( - filename = function() { - paste0( - "Rnaught_estimates_", format(Sys.time(), "%y-%m-%d_%H-%M-%S"), ".csv" - ) - }, - content = function(file) { - output_table <- data.frame( - lapply(react_values$estimates_table, sub_entity) - ) - colnames(output_table) <- sub_entity( - colnames(react_values$estimates_table) - ) - write.csv(output_table, file, row.names = FALSE) - } - ) -} - -# Substitute HTML entity codes with natural names. -sub_entity <- function(obj) { - obj <- gsub("κ", "kappa", obj) - obj -} diff --git a/inst/app/templates/content.html b/inst/app/templates/content.html deleted file mode 100644 index da69f08..0000000 --- a/inst/app/templates/content.html +++ /dev/null @@ -1,14 +0,0 @@ -
-
- {{ htmlTemplate("templates/content/about.html") }} -
-
- {{ htmlTemplate("templates/content/data.html") }} -
-
- {{ htmlTemplate("templates/content/estimation.html") }} -
-
- {{ htmlTemplate("templates/content/help.html") }} -
-
diff --git a/inst/app/templates/content/about.html b/inst/app/templates/content/about.html deleted file mode 100644 index 73b75ea..0000000 --- a/inst/app/templates/content/about.html +++ /dev/null @@ -1,28 +0,0 @@ -

Welcome to the Rnaught web application

-

- Rnaught is an R package and web application for estimating the - basic reproduction number - of infectious diseases. For information about using this application, view the - Help tab. - To learn more about the package, visit the online - documentation or - GitHub repository. - Technical details about the estimators featured in this project can be found in the reference - article. -

-

What is the basic reproduction number?

-

- The basic reproduction number, denoted R0, is defined as the expected number of infections caused - by a single infectious individual when introduced into a totally susceptible population. It assumes that all - individuals in a given population are susceptible to the disease, and that no preventive measures (such as lockdowns - or vaccinations) have been enforced. It is a useful indicator of the transmissibility of an infectious disease during - the early stages of its spread and detection. -

-

- If R0 < 1, the disease will eventually die out. On the other hand, if - R0 > 1, the disease will spread (the higher the R0, the faster this will - happen). Due to uncertainty of known data about the disease, it is difficult to determine R0 - precisely. Therefore, many estimation methods exist, each based on different assumptions and yielding different - estimates. It is the responsibility of users to employ the most appropriate estimator (or suite of estimators) given - the situation at hand. -

diff --git a/inst/app/templates/content/data.html b/inst/app/templates/content/data.html deleted file mode 100644 index 574f003..0000000 --- a/inst/app/templates/content/data.html +++ /dev/null @@ -1,12 +0,0 @@ - -
-
- {{ htmlTemplate("templates/content/data/enter-data.html") }} -
-
- {{ htmlTemplate("templates/content/data/view-data.html") }} -
-
diff --git a/inst/app/templates/content/data/enter-data.html b/inst/app/templates/content/data/enter-data.html deleted file mode 100644 index 254f1d7..0000000 --- a/inst/app/templates/content/data/enter-data.html +++ /dev/null @@ -1,9 +0,0 @@ -
- {{ htmlTemplate("templates/content/data/enter-data/required-format.html") }} - {{ htmlTemplate("templates/content/data/enter-data/manual-entry.html") }} - {{ htmlTemplate("templates/content/data/enter-data/upload-data.html") }} -
-
-
- {{ htmlTemplate("templates/content/data/enter-data/load-samples.html") }} -
diff --git a/inst/app/templates/content/data/enter-data/load-samples.html b/inst/app/templates/content/data/enter-data/load-samples.html deleted file mode 100644 index 2a4f013..0000000 --- a/inst/app/templates/content/data/enter-data/load-samples.html +++ /dev/null @@ -1,19 +0,0 @@ -

Load samples

- -{{ - checkboxInput(inputId = "covid_canada", label = "COVID-19 Canada, 2020/03/03 - 2020/03/31 (Weekly)", - value = FALSE, width = "100%" - ) -}} -{{ - checkboxInput(inputId = "covid_ontario", label = "COVID-19 Ontario, 2020/03/03 - 2020/03/31 (Weekly)", - value = FALSE, width = "100%" - ) -}} - -
- -
- diff --git a/inst/app/templates/content/data/enter-data/manual-entry.html b/inst/app/templates/content/data/enter-data/manual-entry.html deleted file mode 100644 index a6319d9..0000000 --- a/inst/app/templates/content/data/enter-data/manual-entry.html +++ /dev/null @@ -1,11 +0,0 @@ - -
- - -
- -
- -
diff --git a/inst/app/templates/content/data/enter-data/required-format.html b/inst/app/templates/content/data/enter-data/required-format.html deleted file mode 100644 index 724dd83..0000000 --- a/inst/app/templates/content/data/enter-data/required-format.html +++ /dev/null @@ -1,25 +0,0 @@ - - - -
-
-

Manually enter rows or upload a CSV file in the following format:

-

- Dataset name,Time units,Case counts -

-

- Time units must be one of - Days or - Weeks, and - Case counts - must be a comma-separated list of one or more non-negative integers. -

-

Example:

-

- Disease A,Days,1,2,3,4,5,6,7,8,9
- Disease B,Weeks,3,1,4,1,5,2,9
- Disease C,Days,2,3,5,7,11,13,17,19 -

-
-
diff --git a/inst/app/templates/content/data/enter-data/upload-data.html b/inst/app/templates/content/data/enter-data/upload-data.html deleted file mode 100644 index 740047b..0000000 --- a/inst/app/templates/content/data/enter-data/upload-data.html +++ /dev/null @@ -1,12 +0,0 @@ - - - - -
- - -
- - diff --git a/inst/app/templates/content/data/view-data.html b/inst/app/templates/content/data/view-data.html deleted file mode 100644 index 880cf7f..0000000 --- a/inst/app/templates/content/data/view-data.html +++ /dev/null @@ -1,3 +0,0 @@ -{{ htmlTemplate("templates/content/data/view-data/data-table.html") }} -
-{{ htmlTemplate("templates/content/data/view-data/data-plots.html") }} diff --git a/inst/app/templates/content/data/view-data/data-plots.html b/inst/app/templates/content/data/view-data/data-plots.html deleted file mode 100644 index 5019088..0000000 --- a/inst/app/templates/content/data/view-data/data-plots.html +++ /dev/null @@ -1,7 +0,0 @@ -

Data plots

-
- {{ plotly::plotlyOutput(outputId = "data_plot_days") }} -
-
- {{ plotly::plotlyOutput(outputId = "data_plot_weeks") }} -
diff --git a/inst/app/templates/content/data/view-data/data-table.html b/inst/app/templates/content/data/view-data/data-table.html deleted file mode 100644 index 590a5b9..0000000 --- a/inst/app/templates/content/data/view-data/data-table.html +++ /dev/null @@ -1,18 +0,0 @@ -

Data table

-
- {{ DT::dataTableOutput(outputId = "data_table") }} -
- - - - - - - Export table - diff --git a/inst/app/templates/content/estimation.html b/inst/app/templates/content/estimation.html deleted file mode 100644 index 5764057..0000000 --- a/inst/app/templates/content/estimation.html +++ /dev/null @@ -1,13 +0,0 @@ - - -
-
- {{ htmlTemplate("templates/content/estimation/about-estimators.html") }} -
-
- {{ htmlTemplate("templates/content/estimation/estimates.html") }} -
-
diff --git a/inst/app/templates/content/estimation/about-estimators.html b/inst/app/templates/content/estimation/about-estimators.html deleted file mode 100644 index db2898b..0000000 --- a/inst/app/templates/content/estimation/about-estimators.html +++ /dev/null @@ -1,31 +0,0 @@ -
- {{ - htmlTemplate("templates/content/estimation/about-estimators/panel.html", - id = "id", - header = "Incidence Decay (ID)", - reference_label = "Fisman et al. (PloS One, 2013)", - reference_url = "https://doi.org/10.1371/journal.pone.0083622" - ) - }} - {{ - htmlTemplate("templates/content/estimation/about-estimators/panel.html", - id = "idea", header = "Incidence Decay and Exponential Adjustment (IDEA)", - reference_label = "Fisman et al. (PloS One, 2013)", - reference_url = "https://doi.org/10.1371/journal.pone.0083622" - ) - }} - {{ - htmlTemplate("templates/content/estimation/about-estimators/panel.html", - id = "seq_bayes", header = "Sequential Bayes (seqB)", - reference_label = "Bettencourt and Riberio (PloS One, 2008)", - reference_url = "https://doi.org/10.1371/journal.pone.0002185" - ) - }} - {{ - htmlTemplate("templates/content/estimation/about-estimators/panel.html", - id = "wp", header = "White and Pagano (WP)", - reference_label = "White and Pagano (Statistics in Medicine, 2008)", - reference_url = "https://doi.org/10.1002/sim.3136" - ) - }} -
diff --git a/inst/app/templates/content/estimation/about-estimators/id.html b/inst/app/templates/content/estimation/about-estimators/id.html deleted file mode 100644 index fc70b1c..0000000 --- a/inst/app/templates/content/estimation/about-estimators/id.html +++ /dev/null @@ -1,3 +0,0 @@ -The Incidence Decay (ID) estimator uses the method of least squares to estimate R0. -This method assumes the serial interval is known, and is built under the SIR assumption. -We note that the use of this method might result in the underestimation of R0. diff --git a/inst/app/templates/content/estimation/about-estimators/idea.html b/inst/app/templates/content/estimation/about-estimators/idea.html deleted file mode 100644 index 67548f8..0000000 --- a/inst/app/templates/content/estimation/about-estimators/idea.html +++ /dev/null @@ -1,4 +0,0 @@ -The Incidence Decay and Exponential Adjustment (ID) estimator is an alternative formulation of the Incidence Decay (ID) model which includes a decay factor to reflect the often observed outbreak decline. -This addresses the potential underestimation of the R0 estimate when using the ID method. -The method of least squares is used to estimate R0, and similar to the ID model, the serial interval is assumed to be known and this method is developed assuming the SIR model. -We note that, since we need to obtain a minimizer of the decay factor to solve the optimization problem, we require that the number of cases in the dataset be at least 2. diff --git a/inst/app/templates/content/estimation/about-estimators/panel.html b/inst/app/templates/content/estimation/about-estimators/panel.html deleted file mode 100644 index 98fe155..0000000 --- a/inst/app/templates/content/estimation/about-estimators/panel.html +++ /dev/null @@ -1,14 +0,0 @@ -
-

- -

-
-
-

Reference: {{ reference_label }}

-

{{ htmlTemplate(paste0("templates/content/estimation/about-estimators/", id, ".html")) }}

-
-
-
diff --git a/inst/app/templates/content/estimation/about-estimators/seq_bayes.html b/inst/app/templates/content/estimation/about-estimators/seq_bayes.html deleted file mode 100644 index 8f66ab4..0000000 --- a/inst/app/templates/content/estimation/about-estimators/seq_bayes.html +++ /dev/null @@ -1,9 +0,0 @@ -The sequential Bayes (seqB) estimator uses a Bayesian approach to estimate R0 which updates the reproductive number estimate as data accumulates over time. -This approach is based on the SIR model, and assumes that the mean of the serial distribution (ie. the serial interval (SI)) is known. -It is assumed that infectious counts are observed at periodic times (ie. daily, weekly). -This method cannot handle datasets where there are no new infections observed in a time interval, thus, to remedy this, -some manipulation may be necessary to make the times at which infectious counts are observed sufficiently course (ie. weeks instead of days). -Further, this method is also inappropriate in situations where long intervals between cases are observed in the initial stages of the epidemic. -Finally, the R0 approximation behaves similarly to a branching process, which means that throughout, the population size “available” to be infected remains constant. -We note that this assumption does not hold for the SIR/SEIR/SEAIR compartmental models. -As such, seqB estimates should only really be considered early on in an epidemic, ie. before the inflection point of an epidemic, if the dataset being used follows these models. diff --git a/inst/app/templates/content/estimation/about-estimators/wp.html b/inst/app/templates/content/estimation/about-estimators/wp.html deleted file mode 100644 index c6f4580..0000000 --- a/inst/app/templates/content/estimation/about-estimators/wp.html +++ /dev/null @@ -1,6 +0,0 @@ -The White and Pagano (WP) estimator uses maximum likelihood estimation to estimate R0. -In this method, the serial interval (SI) is either known, or can be estimated along with R0. -It is assumed that the number of infectious individuals are observable at discrete time points (ie. daily or weekly). -Further, this method also assumes an underlying branching process, which means that throughout, the population size “available” to be infected remains constant. -We note that this assumption does not hold for the SIR/SEIR/SEAIR compartmental models. -As such, WP estimates should only really be considered early on in an epidemic, ie. before the inflection point of an epidemic, if the dataset being used follows these models. diff --git a/inst/app/templates/content/estimation/estimates.html b/inst/app/templates/content/estimation/estimates.html deleted file mode 100644 index bc9124e..0000000 --- a/inst/app/templates/content/estimation/estimates.html +++ /dev/null @@ -1,3 +0,0 @@ -{{ htmlTemplate("templates/content/estimation/estimates/estimates-table.html") }} -
-{{ htmlTemplate("templates/content/estimation/estimates/add-estimators.html") }} diff --git a/inst/app/templates/content/estimation/estimates/add-estimators.html b/inst/app/templates/content/estimation/estimates/add-estimators.html deleted file mode 100644 index 60111c7..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators.html +++ /dev/null @@ -1,16 +0,0 @@ -

Add estimators

-
- - - - - {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "id") }} - {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "idea") }} - {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "seq_bayes") }} - {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "wp") }} -
diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/id.html b/inst/app/templates/content/estimation/estimates/add-estimators/id.html deleted file mode 100644 index 7c35e55..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/id.html +++ /dev/null @@ -1 +0,0 @@ -{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "id") }} diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/idea.html b/inst/app/templates/content/estimation/estimates/add-estimators/idea.html deleted file mode 100644 index 781349f..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/idea.html +++ /dev/null @@ -1 +0,0 @@ -{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "idea") }} diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/mu.html b/inst/app/templates/content/estimation/estimates/add-estimators/mu.html deleted file mode 100644 index 8781574..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/mu.html +++ /dev/null @@ -1,22 +0,0 @@ - - -
- - - - -
- -
- -
diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/parameters.html b/inst/app/templates/content/estimation/estimates/add-estimators/parameters.html deleted file mode 100644 index 5250e31..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/parameters.html +++ /dev/null @@ -1,7 +0,0 @@ -
-
Parameters
- {{ htmlTemplate(paste0("templates/content/estimation/estimates/add-estimators/", id, ".html")) }} - -
diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/seq_bayes.html b/inst/app/templates/content/estimation/estimates/add-estimators/seq_bayes.html deleted file mode 100644 index 028fabc..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/seq_bayes.html +++ /dev/null @@ -1,22 +0,0 @@ -
- -
- {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "seq_bayes") }} -
- -
- - - - - - -
-
diff --git a/inst/app/templates/content/estimation/estimates/add-estimators/wp.html b/inst/app/templates/content/estimation/estimates/add-estimators/wp.html deleted file mode 100644 index 511170f..0000000 --- a/inst/app/templates/content/estimation/estimates/add-estimators/wp.html +++ /dev/null @@ -1,39 +0,0 @@ - - -
-
- -
-
- -
-
- -
- {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "wp") }} -
- -
- -
- - - -
- -
- - - -
- -
- - - -
-
diff --git a/inst/app/templates/content/estimation/estimates/estimates-table.html b/inst/app/templates/content/estimation/estimates/estimates-table.html deleted file mode 100644 index 4704d03..0000000 --- a/inst/app/templates/content/estimation/estimates/estimates-table.html +++ /dev/null @@ -1,19 +0,0 @@ -

Estimates table

- -
- {{ DT::dataTableOutput(outputId = "estimates_table") }} -
- - - - - - - Export table - diff --git a/inst/app/templates/content/help.html b/inst/app/templates/content/help.html deleted file mode 100644 index df4e887..0000000 --- a/inst/app/templates/content/help.html +++ /dev/null @@ -1,8 +0,0 @@ -
- {{ - htmlTemplate("templates/content/help/panel.html", - id = "serial-interval", - header = "What is the serial interval?" - ) - }} -
diff --git a/inst/app/templates/content/help/panel.html b/inst/app/templates/content/help/panel.html deleted file mode 100644 index 9eb6e2e..0000000 --- a/inst/app/templates/content/help/panel.html +++ /dev/null @@ -1,12 +0,0 @@ -
-

- -

-
-
- {{ htmlTemplate(paste0("templates/content/help/", id, ".html")) }} -
-
-
diff --git a/inst/app/templates/content/help/serial-interval.html b/inst/app/templates/content/help/serial-interval.html deleted file mode 100644 index e061115..0000000 --- a/inst/app/templates/content/help/serial-interval.html +++ /dev/null @@ -1,9 +0,0 @@ -

Reference: Wikipedia -

- The serial interval (SI) is not one of the estimators. It is a parameter required by most of the estimators, and can - also be estimated by some of them (if not specified). -

-

- The SI is defined as the average time between successive infections in a chain of transmission (i.e., the time between - the infection of an infected individual and their subsequent transmissions). -

diff --git a/inst/app/templates/footer.html b/inst/app/templates/footer.html deleted file mode 100644 index 19d4b0c..0000000 --- a/inst/app/templates/footer.html +++ /dev/null @@ -1,7 +0,0 @@ - diff --git a/inst/app/templates/navbar.html b/inst/app/templates/navbar.html deleted file mode 100644 index d447fba..0000000 --- a/inst/app/templates/navbar.html +++ /dev/null @@ -1,27 +0,0 @@ - diff --git a/inst/app/templates/tabs.html b/inst/app/templates/tabs.html deleted file mode 100644 index 351b480..0000000 --- a/inst/app/templates/tabs.html +++ /dev/null @@ -1,14 +0,0 @@ - diff --git a/inst/app/www/script.js b/inst/app/www/script.js deleted file mode 100644 index 30066d1..0000000 --- a/inst/app/www/script.js +++ /dev/null @@ -1,21 +0,0 @@ -$(document).ready(() => { - // Enable tooltips. - $('[data-bs-toggle="tooltip"]').tooltip(); - - // Toggle the text in the bulk data help button. - $('#data-format-toggle').on('click', event => { - btn = $(event.target); - show_format = 'Show required format'; - btn.text(btn.text() === show_format ? 'Hide required format' : show_format); - }); - - // Trigger the file selector via a custom button. - $('#data-upload-select').on('click', () => { - $('#data_upload').trigger('click'); - }); - - // Display the name of the uploaded file. - $('#data_upload').on('change', event => { - $('#data-upload-name').attr('placeholder', event.target.files[0].name); - }); -}); diff --git a/inst/app/www/styles.css b/inst/app/www/styles.css deleted file mode 100644 index a6fc3cd..0000000 --- a/inst/app/www/styles.css +++ /dev/null @@ -1,23 +0,0 @@ -body { - min-height: 100vh; - height: 100%; - width: 100%; -} - -noscript { - text-align: center; -} - -.shiny-notification { - background-color: black; - color: white; -} - -.plotly-notifier .notifier-note { - background-color: black !important; - color: white !important; -} - -#data_upload { - display: none; -} diff --git a/inst/web/app.R b/inst/web/app.R new file mode 100644 index 0000000..639dc87 --- /dev/null +++ b/inst/web/app.R @@ -0,0 +1,13 @@ +ui <- htmlTemplate("index.html") + +server <- function(input, output) { + source("scripts/data.R", local = TRUE) + source("scripts/estimators.R", local = TRUE) + + react_values <- reactiveValues() + + data_logic(input, output, react_values) + estimators_logic(input, output, react_values) +} + +shinyApp(ui, server) diff --git a/inst/web/index.html b/inst/web/index.html new file mode 100644 index 0000000..504918d --- /dev/null +++ b/inst/web/index.html @@ -0,0 +1,19 @@ + + + + {{ bootstrapLib(theme = bslib::bs_theme(primary = "black")) }} + {{ headContent() }} + Rnaught Web + + + + + + {{ htmlTemplate("templates/navbar.html") }} + {{ htmlTemplate("templates/tabs.html") }} + {{ htmlTemplate("templates/content.html") }} + {{ htmlTemplate("templates/footer.html") }} + + diff --git a/inst/web/scripts/data.R b/inst/web/scripts/data.R new file mode 100644 index 0000000..8f8694c --- /dev/null +++ b/inst/web/scripts/data.R @@ -0,0 +1,253 @@ +# Main logic block for data-related interactions. +data_logic <- function(input, output, react_values) { + # Initialize a data frame to hold the datasets. + react_values$data_table <- data.frame( + Name = character(0), + `Time units` = character(0), + `Case counts` = character(0), + check.names = FALSE + ) + + manual_entry(input, output, react_values) + upload_data(input, output, react_values) + load_samples(input, output, react_values) + render_data_table(output, react_values) + render_plot(input, output, react_values, "Days") + render_plot(input, output, react_values, "Weeks") + delete_data(input, react_values) + export_data(output, react_values) +} + +# Convert the input case counts string to an integer vector. +tokenize_counts <- function(counts_str) { + suppressWarnings(as.integer(unlist(strsplit(trimws(counts_str), ",")))) +} + +# Render the plots for daily and weekly data when the data table is updated. +render_plot <- function(input, output, react_values, time_units) { + observe({ + datasets <- react_values$data_table[ + which(react_values$data_table[["Time units"]] == time_units), + ] + + data_plot <- plotly::plot_ly(type = "scatter", mode = "lines") + if (nrow(datasets) > 0) { + for (i in seq_len(nrow(datasets))) { + counts <- tokenize_counts(datasets[i, 3]) + data_plot <- plotly::add_trace(data_plot, + x = seq_along(counts) - 1, y = counts, name = datasets[i, 1] + ) + } + } + + plot_title <- paste( + if (time_units == "Days") "Daily" else "Weekly", "case counts" + ) + + data_plot <- plotly::layout(data_plot, title = plot_title, + xaxis = list(title = time_units), yaxis = list(title = "Cases") + ) + + data_plot <- plotly::config(data_plot, displaylogo = FALSE, + toImageButtonOptions = list( + filename = paste0("Rnaught_data_", tolower(time_units), "_plot") + ) + ) + + output[[paste0("data_plot_", tolower(time_units))]] <- + plotly::renderPlotly(data_plot) + }) +} + +# Validate and add manually-entered datasets. +manual_entry <- function(input, output, react_values) { + observeEvent(input$data_bulk, { + validate_data(input, output, react_values, "data_area") + }) +} + +# Validate and add datasets from a CSV file. +upload_data <- function(input, output, react_values) { + observeEvent(input$data_upload, { + validate_data(input, output, react_values, "data_upload") + }) +} + +# Validate datasets and update the data table. +validate_data <- function(input, output, react_values, data_source) { + tryCatch( + { + if (data_source == "data_area") { + datasets <- read.csv(text = input$data_area, header = FALSE, sep = ",") + } else if (data_source == "data_upload") { + datasets <- read.csv( + file = input$data_upload$datapath, header = FALSE, sep = "," + ) + } + + names <- trimws(datasets[, 1]) + units <- trimws(datasets[, 2]) + counts <- apply(data.frame(datasets[, 3:ncol(datasets)]), 1, + function(row) { + row <- suppressWarnings(as.integer(row)) + toString(row[!is.na(row) & row >= 0]) + } + ) + + warning_text <- "" + + # Ensure the dataset names are neither blank nor duplicates. + if (anyNA(names) || any(names == "")) { + warning_text <- paste0(warning_text, + "Each row must begin with a non-blank dataset name.
" + ) + } else { + if (length(unique(names)) != length(names)) { + warning_text <- paste0(warning_text, + "The rows contain duplicate dataset names.
" + ) + } + if (any(names %in% react_values$data_table[, 1])) { + warning_text <- paste0(warning_text, + "The rows contain dataset names which already exist.
" + ) + } + } + + # Ensure the second entry in each row is a time unit equal to + # "Days" or "Weeks". + if (!all(units %in% c("Days", "Weeks"))) { + warning_text <- paste0(warning_text, + "The second entry in each row must be either 'Days' or 'Weeks'.
" + ) + } + + # Ensure the counts in each row have at least one non-negative integer. + if (any(counts == "")) { + warning_text <- paste0(warning_text, + "Each row must contain at least one non-negative integer.
" + ) + } + + output[[paste0(data_source, "_warn")]] <- renderUI(HTML(warning_text)) + + if (warning_text == "") { + # Add the new datasets to the data table. + new_rows <- data.frame(names, units, counts) + colnames(new_rows) <- c("Name", "Time units", "Case counts") + react_values$data_table <- rbind(react_values$data_table, new_rows) + + # Evaluate all existing estimators on the new datasets and update the + # corresponding columns in the estimates table. + update_estimates_cols(new_rows, react_values) + + showNotification("Datasets added successfully.", duration = 3) + } + }, + error = function(e) { + output[[paste0(data_source, "_warn")]] <- renderText( + "The input does not match the required format." + ) + } + ) +} + +# Load sample datasets. +load_samples <- function(input, output, react_values) { + observeEvent(input$data_samples, { + names <- c() + units <- c() + counts <- c() + + # COVID-19 Canada, March 2020 (weekly). + if (input$covid_canada) { + names <- c(names, "COVID-19 Canada 2020/03/03 - 2020/03/31") + units <- c(units, "Weeks") + counts <- c(counts, toString(Rnaught::COVIDCanada[seq(41, 69, 7), 2])) + } + # COVID-19 Ontario, March 2020 (weekly). + if (input$covid_ontario) { + names <- c(names, "COVID-19 Ontario 2020/03/03 - 2020/03/31") + units <- c(units, "Weeks") + counts <- c(counts, + toString(Rnaught::COVIDCanadaPT[seq(10176, 10204, 7), 3]) + ) + } + + if (length(names) == 0) { + output$data_samples_warn <- renderText( + "At least one sample dataset must be selected." + ) + } else if (any(names %in% react_values$data_table[, 1])) { + output$data_samples_warn <- renderText( + "At least one of the selected dataset names already exist." + ) + } else { + output$data_samples_warn <- renderText("") + + new_rows <- data.frame(names, units, counts) + colnames(new_rows) <- c("Name", "Time units", "Case counts") + react_values$data_table <- rbind(react_values$data_table, new_rows) + + # Evaluate all existing estimators on the sample datasets and update the + # corresponding columns in the estimates table. + update_estimates_cols(new_rows, react_values) + + showNotification("Datasets added successfully.", duration = 3) + } + }) +} + +# Render the data table when new datasets are added. +render_data_table <- function(output, react_values) { + observe({ + output$data_table <- DT::renderDataTable( + react_values$data_table, rownames = FALSE + ) + }) +} + +# Delete rows in the data table and the corresponding columns in the estimates +# table. +delete_data <- function(input, react_values) { + observeEvent(input$data_delete, { + rows_selected <- input$data_table_rows_selected + react_values$data_table <- react_values$data_table[-rows_selected, ] + react_values$estimates_table <- + react_values$estimates_table[, -(rows_selected + 2)] + }) +} + +# Export data table as a CSV file. +export_data <- function(output, react_values) { + output$data_export <- downloadHandler( + filename = function() { + paste0("Rnaught_data_", format(Sys.time(), "%y-%m-%d_%H-%M-%S"), ".csv") + }, + content = function(file) { + write.csv(react_values$data_table, file, row.names = FALSE) + } + ) +} + +# When new datasets are added, evaluate all existing estimators on them and +# add new columns to the estimates table. +update_estimates_cols <- function(datasets, react_values) { + new_cols <- data.frame( + matrix(nrow = nrow(react_values$estimates_table), ncol = nrow(datasets)) + ) + colnames(new_cols) <- datasets[, 1] + + if (nrow(new_cols) > 0) { + for (row in seq_len(nrow(new_cols))) { + estimator <- react_values$estimators[[row]] + for (col in seq_len(ncol(new_cols))) { + new_cols[row, col] <- eval_estimator(estimator, datasets[col, ]) + } + } + } + + react_values$estimates_table <- cbind( + react_values$estimates_table, new_cols + ) +} diff --git a/inst/web/scripts/estimators.R b/inst/web/scripts/estimators.R new file mode 100644 index 0000000..7c457ea --- /dev/null +++ b/inst/web/scripts/estimators.R @@ -0,0 +1,327 @@ +# Main logic block for estimator-related interactions. +estimators_logic <- function(input, output, react_values) { + # Initialize a data frame to hold estimates. + react_values$estimates_table <- data.frame( + Estimator = character(0), + `Serial interval` = character(0), + check.names = FALSE + + ) + # Initialize a list to hold added estimators. + react_values$estimators <- list() + + add_id(input, output, react_values) + add_idea(input, output, react_values) + add_seq_bayes(input, output, react_values) + add_wp(input, output, react_values) + + render_estimates(output, react_values) + delete_estimators(input, react_values) + export_estimates(output, react_values) +} + +# If an estimator is added, ensure it is not a duplicate and add it to the list +# of estimators. This function should be called at the end of each +# estimator-specific 'add' function, after validating their parameters. +add_estimator <- function(method, new_estimator, output, react_values) { + num_estimators <- length(react_values$estimators) + + # Check whether the new estimator is a duplicate, and warn if so. + for (i in seq_len(num_estimators)) { + if (identical(new_estimator, react_values$estimators[[i]])) { + showNotification( + "Error: This estimator has already been added.", duration = 3 + ) + return() + } + } + + # Add the new estimator to the list of estimators. + react_values$estimators[[num_estimators + 1]] <- new_estimator + + showNotification("Estimator added successfully.", duration = 3) + + # Evaluate the new estimator on all existing datasets and create a new row in + # the estimates table. + update_estimates_row(new_estimator, react_values) +} + +# Ensure serial intervals are specified as positive numbers. +validate_mu <- function(method, input, output) { + mu <- suppressWarnings(as.numeric(trimws(input[[paste0("mu_", method)]]))) + if (is.na(mu) || mu <= 0) { + output[[paste0("mu_", method, "_warn")]] <- renderText( + "The serial interval must be a positive number." + ) + return(NULL) + } + output[[paste0("mu_", method, "_warn")]] <- renderText("") + mu +} + +# Incidence Decay (ID). +add_id <- function(input, output, react_values) { + observeEvent(input$add_id, { + mu <- validate_mu("id", input, output) + if (!is.null(mu)) { + new_estimator <- list( + method = "id", mu = mu, mu_units = input$mu_id_units + ) + add_estimator("id", new_estimator, output, react_values) + } + }) +} + +# Incidence Decay and Exponential Adjustment (IDEA). +add_idea <- function(input, output, react_values) { + observeEvent(input$add_idea, { + mu <- validate_mu("idea", input, output) + if (!is.null(mu)) { + new_estimator <- list( + method = "idea", mu = mu, mu_units = input$mu_idea_units + ) + add_estimator("idea", new_estimator, output, react_values) + } + }) +} + +# Sequential Bayes (seqB). +add_seq_bayes <- function(input, output, react_values) { + observeEvent(input$add_seq_bayes, { + mu <- validate_mu("seq_bayes", input, output) + + kappa <- trimws(input$kappa) + kappa <- if (kappa == "") 20 else suppressWarnings(as.numeric(kappa)) + + if (is.na(kappa) || kappa < 1) { + output$kappa_warn <- renderText( + "The maximum prior must be a number greater than or equal to 1." + ) + } else if (!is.null(mu)) { + output$kappa_warn <- renderText("") + new_estimator <- list( + method = "seq_bayes", mu = mu, + mu_units = input$mu_seq_bayes_units, kappa = kappa + ) + add_estimator("seq_bayes", new_estimator, output, react_values) + } + }) +} + +# White and Pagano (WP). +add_wp <- function(input, output, react_values) { + observeEvent(input$add_wp, { + if (input$wp_mu_known == "Yes") { + mu <- validate_mu("wp", input, output) + if (!is.null(mu)) { + new_estimator <- list(method = "wp", + mu = mu, mu_units = input$mu_wp_units + ) + add_estimator("wp", new_estimator, output, react_values) + } + } else { + grid_length <- trimws(input$grid_length) + max_shape <- trimws(input$max_shape) + max_scale <- trimws(input$max_scale) + + suppressWarnings({ + grid_length <- if (grid_length == "") 100 else as.numeric(grid_length) + max_shape <- if (max_shape == "") 10 else as.numeric(max_shape) + max_scale <- if (max_scale == "") 10 else as.numeric(max_scale) + }) + + valid <- TRUE + + if (is.na(grid_length) || grid_length <= 0) { + output$grid_length_warn <- renderText( + "The grid length must be a positive integer." + ) + valid <- FALSE + } else { + output$grid_length_warn <- renderText("") + } + + if (is.na(max_shape) || max_shape <= 0) { + output$max_shape_warn <- renderText( + "The maximum shape must be a positive number." + ) + valid <- FALSE + } else { + output$max_shape_warn <- renderText("") + } + + if (is.na(max_scale) || max_scale <= 0) { + output$max_scale_warn <- renderText( + "The maximum scale must be a positive number." + ) + valid <- FALSE + } else { + output$max_scale_warn <- renderText("") + } + + if (valid) { + new_estimator <- list(method = "wp", mu = NA, grid_length = grid_length, + max_shape = max_shape, max_scale = max_scale + ) + add_estimator("wp", new_estimator, output, react_values) + } + } + }) +} + +# Convert an estimator's specified serial interval to match the time units of +# the given dataset. +convert_mu_units <- function(data_units, estimator_units, mu) { + if (data_units == "Days" && estimator_units == "Weeks") { + return(mu * 7) + } else if (data_units == "Weeks" && estimator_units == "Days") { + return(mu / 7) + } + mu +} + +# Add a row to the estimates table when a new estimator is added. +update_estimates_row <- function(estimator, react_values) { + dataset_rows <- seq_len(nrow(react_values$data_table)) + estimates <- c() + + if (nrow(react_values$data_table) > 0) { + estimates <- dataset_rows + for (row in dataset_rows) { + estimate <- eval_estimator(estimator, react_values$data_table[row, ]) + estimates[row] <- estimate + } + } + + new_row <- data.frame( + t(c(estimator_name(estimator), estimator_mu_text(estimator), estimates)) + ) + colnames(new_row) <- colnames(react_values$estimates_table) + + react_values$estimates_table <- rbind( + react_values$estimates_table, new_row + ) +} + +# Evaluate the specified estimator on the given dataset. +eval_estimator <- function(estimator, dataset) { + cases <- as.integer(unlist(strsplit(dataset[, 3], ","))) + + tryCatch( + { + if (estimator$method == "id") { + mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) + estimate <- round(Rnaught::id(cases, mu), 2) + } else if (estimator$method == "idea") { + mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) + estimate <- round(Rnaught::idea(cases, mu), 2) + } else if (estimator$method == "seq_bayes") { + mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) + estimate <- round(Rnaught::seq_bayes(cases, mu, estimator$kappa), 2) + } else if (estimator$method == "wp") { + if (is.na(estimator$mu)) { + estimate <- Rnaught::wp(cases, serial = TRUE, + grid_length = estimator$grid_length, + max_shape = estimator$max_shape, max_scale = estimator$max_scale + ) + estimated_mu <- round(sum(estimate$supp * estimate$pmf), 2) + mu_units <- if (dataset[, 2] == "Days") "day(s)" else "week(s)" + estimate <- paste0( + round(estimate$r0, 2), " (SI = ", estimated_mu, " ", mu_units, ")" + ) + } else { + mu <- convert_mu_units(dataset[, 2], estimator$mu_units, estimator$mu) + estimate <- round(Rnaught::wp(cases, mu), 2) + } + } + + return(estimate) + }, error = function(e) { + showNotification( + paste0(toString(e), + " [Estimator: ", sub(" .*", "", estimator_name(estimator)), + ", Dataset: ", dataset[, 1], "]" + ), duration = 6 + ) + return("—") + } + ) +} + +# Create the name of an estimator to be added to the first column of the +# estimates table. +estimator_name <- function(estimator) { + if (estimator$method == "id") { + return("ID") + } else if (estimator$method == "idea") { + return("IDEA") + } else if (estimator$method == "seq_bayes") { + return(paste0("seqB", " (κ = ", estimator$kappa, ")")) + } else if (estimator$method == "wp") { + if (is.na(estimator$mu)) { + return(paste0("WP (", estimator$grid_length, ", ", + round(estimator$max_shape, 3), ", ", round(estimator$max_scale, 3), ")" + )) + } else { + return("WP") + } + } +} + +# Create the text to be displayed for the serial interval in the second column +# of the estimates table. +estimator_mu_text <- function(estimator) { + if (is.na(estimator$mu)) { + return("—") + } + mu_units <- if (estimator$mu_units == "Days") "day(s)" else "week(s)" + paste(estimator$mu, mu_units) +} + +# Render the estimates table whenever it is updated. +render_estimates <- function(output, react_values) { + observe({ + output$estimates_table <- DT::renderDataTable(react_values$estimates_table, + escape = FALSE, rownames = FALSE, + options = list( + columnDefs = list(list(className = "dt-left", targets = "_all")) + ), + ) + }) +} + +# Delete rows from the estimates table and the corresponding estimators. +delete_estimators <- function(input, react_values) { + observeEvent(input$estimators_delete, { + rows_selected <- input$estimates_table_rows_selected + react_values$estimators <- react_values$estimators[-rows_selected] + react_values$estimates_table <- + react_values$estimates_table[-rows_selected, ] + }) +} + +# Export estimates table as a CSV file. +export_estimates <- function(output, react_values) { + output$estimates_export <- downloadHandler( + filename = function() { + paste0( + "Rnaught_estimates_", format(Sys.time(), "%y-%m-%d_%H-%M-%S"), ".csv" + ) + }, + content = function(file) { + output_table <- data.frame( + lapply(react_values$estimates_table, sub_entity) + ) + colnames(output_table) <- sub_entity( + colnames(react_values$estimates_table) + ) + write.csv(output_table, file, row.names = FALSE) + } + ) +} + +# Substitute HTML entity codes with natural names. +sub_entity <- function(obj) { + obj <- gsub("κ", "kappa", obj) + obj +} diff --git a/inst/web/templates/content.html b/inst/web/templates/content.html new file mode 100644 index 0000000..da69f08 --- /dev/null +++ b/inst/web/templates/content.html @@ -0,0 +1,14 @@ +
+
+ {{ htmlTemplate("templates/content/about.html") }} +
+
+ {{ htmlTemplate("templates/content/data.html") }} +
+
+ {{ htmlTemplate("templates/content/estimation.html") }} +
+
+ {{ htmlTemplate("templates/content/help.html") }} +
+
diff --git a/inst/web/templates/content/about.html b/inst/web/templates/content/about.html new file mode 100644 index 0000000..73b75ea --- /dev/null +++ b/inst/web/templates/content/about.html @@ -0,0 +1,28 @@ +

Welcome to the Rnaught web application

+

+ Rnaught is an R package and web application for estimating the + basic reproduction number + of infectious diseases. For information about using this application, view the + Help tab. + To learn more about the package, visit the online + documentation or + GitHub repository. + Technical details about the estimators featured in this project can be found in the reference + article. +

+

What is the basic reproduction number?

+

+ The basic reproduction number, denoted R0, is defined as the expected number of infections caused + by a single infectious individual when introduced into a totally susceptible population. It assumes that all + individuals in a given population are susceptible to the disease, and that no preventive measures (such as lockdowns + or vaccinations) have been enforced. It is a useful indicator of the transmissibility of an infectious disease during + the early stages of its spread and detection. +

+

+ If R0 < 1, the disease will eventually die out. On the other hand, if + R0 > 1, the disease will spread (the higher the R0, the faster this will + happen). Due to uncertainty of known data about the disease, it is difficult to determine R0 + precisely. Therefore, many estimation methods exist, each based on different assumptions and yielding different + estimates. It is the responsibility of users to employ the most appropriate estimator (or suite of estimators) given + the situation at hand. +

diff --git a/inst/web/templates/content/data.html b/inst/web/templates/content/data.html new file mode 100644 index 0000000..574f003 --- /dev/null +++ b/inst/web/templates/content/data.html @@ -0,0 +1,12 @@ + +
+
+ {{ htmlTemplate("templates/content/data/enter-data.html") }} +
+
+ {{ htmlTemplate("templates/content/data/view-data.html") }} +
+
diff --git a/inst/web/templates/content/data/enter-data.html b/inst/web/templates/content/data/enter-data.html new file mode 100644 index 0000000..254f1d7 --- /dev/null +++ b/inst/web/templates/content/data/enter-data.html @@ -0,0 +1,9 @@ +
+ {{ htmlTemplate("templates/content/data/enter-data/required-format.html") }} + {{ htmlTemplate("templates/content/data/enter-data/manual-entry.html") }} + {{ htmlTemplate("templates/content/data/enter-data/upload-data.html") }} +
+
+
+ {{ htmlTemplate("templates/content/data/enter-data/load-samples.html") }} +
diff --git a/inst/web/templates/content/data/enter-data/load-samples.html b/inst/web/templates/content/data/enter-data/load-samples.html new file mode 100644 index 0000000..2a4f013 --- /dev/null +++ b/inst/web/templates/content/data/enter-data/load-samples.html @@ -0,0 +1,19 @@ +

Load samples

+ +{{ + checkboxInput(inputId = "covid_canada", label = "COVID-19 Canada, 2020/03/03 - 2020/03/31 (Weekly)", + value = FALSE, width = "100%" + ) +}} +{{ + checkboxInput(inputId = "covid_ontario", label = "COVID-19 Ontario, 2020/03/03 - 2020/03/31 (Weekly)", + value = FALSE, width = "100%" + ) +}} + +
+ +
+ diff --git a/inst/web/templates/content/data/enter-data/manual-entry.html b/inst/web/templates/content/data/enter-data/manual-entry.html new file mode 100644 index 0000000..a6319d9 --- /dev/null +++ b/inst/web/templates/content/data/enter-data/manual-entry.html @@ -0,0 +1,11 @@ + +
+ + +
+ +
+ +
diff --git a/inst/web/templates/content/data/enter-data/required-format.html b/inst/web/templates/content/data/enter-data/required-format.html new file mode 100644 index 0000000..724dd83 --- /dev/null +++ b/inst/web/templates/content/data/enter-data/required-format.html @@ -0,0 +1,25 @@ + + + +
+
+

Manually enter rows or upload a CSV file in the following format:

+

+ Dataset name,Time units,Case counts +

+

+ Time units must be one of + Days or + Weeks, and + Case counts + must be a comma-separated list of one or more non-negative integers. +

+

Example:

+

+ Disease A,Days,1,2,3,4,5,6,7,8,9
+ Disease B,Weeks,3,1,4,1,5,2,9
+ Disease C,Days,2,3,5,7,11,13,17,19 +

+
+
diff --git a/inst/web/templates/content/data/enter-data/upload-data.html b/inst/web/templates/content/data/enter-data/upload-data.html new file mode 100644 index 0000000..740047b --- /dev/null +++ b/inst/web/templates/content/data/enter-data/upload-data.html @@ -0,0 +1,12 @@ + + + + +
+ + +
+ + diff --git a/inst/web/templates/content/data/view-data.html b/inst/web/templates/content/data/view-data.html new file mode 100644 index 0000000..880cf7f --- /dev/null +++ b/inst/web/templates/content/data/view-data.html @@ -0,0 +1,3 @@ +{{ htmlTemplate("templates/content/data/view-data/data-table.html") }} +
+{{ htmlTemplate("templates/content/data/view-data/data-plots.html") }} diff --git a/inst/web/templates/content/data/view-data/data-plots.html b/inst/web/templates/content/data/view-data/data-plots.html new file mode 100644 index 0000000..5019088 --- /dev/null +++ b/inst/web/templates/content/data/view-data/data-plots.html @@ -0,0 +1,7 @@ +

Data plots

+
+ {{ plotly::plotlyOutput(outputId = "data_plot_days") }} +
+
+ {{ plotly::plotlyOutput(outputId = "data_plot_weeks") }} +
diff --git a/inst/web/templates/content/data/view-data/data-table.html b/inst/web/templates/content/data/view-data/data-table.html new file mode 100644 index 0000000..590a5b9 --- /dev/null +++ b/inst/web/templates/content/data/view-data/data-table.html @@ -0,0 +1,18 @@ +

Data table

+
+ {{ DT::dataTableOutput(outputId = "data_table") }} +
+ + + + + + + Export table + diff --git a/inst/web/templates/content/estimation.html b/inst/web/templates/content/estimation.html new file mode 100644 index 0000000..5764057 --- /dev/null +++ b/inst/web/templates/content/estimation.html @@ -0,0 +1,13 @@ + + +
+
+ {{ htmlTemplate("templates/content/estimation/about-estimators.html") }} +
+
+ {{ htmlTemplate("templates/content/estimation/estimates.html") }} +
+
diff --git a/inst/web/templates/content/estimation/about-estimators.html b/inst/web/templates/content/estimation/about-estimators.html new file mode 100644 index 0000000..db2898b --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators.html @@ -0,0 +1,31 @@ +
+ {{ + htmlTemplate("templates/content/estimation/about-estimators/panel.html", + id = "id", + header = "Incidence Decay (ID)", + reference_label = "Fisman et al. (PloS One, 2013)", + reference_url = "https://doi.org/10.1371/journal.pone.0083622" + ) + }} + {{ + htmlTemplate("templates/content/estimation/about-estimators/panel.html", + id = "idea", header = "Incidence Decay and Exponential Adjustment (IDEA)", + reference_label = "Fisman et al. (PloS One, 2013)", + reference_url = "https://doi.org/10.1371/journal.pone.0083622" + ) + }} + {{ + htmlTemplate("templates/content/estimation/about-estimators/panel.html", + id = "seq_bayes", header = "Sequential Bayes (seqB)", + reference_label = "Bettencourt and Riberio (PloS One, 2008)", + reference_url = "https://doi.org/10.1371/journal.pone.0002185" + ) + }} + {{ + htmlTemplate("templates/content/estimation/about-estimators/panel.html", + id = "wp", header = "White and Pagano (WP)", + reference_label = "White and Pagano (Statistics in Medicine, 2008)", + reference_url = "https://doi.org/10.1002/sim.3136" + ) + }} +
diff --git a/inst/web/templates/content/estimation/about-estimators/id.html b/inst/web/templates/content/estimation/about-estimators/id.html new file mode 100644 index 0000000..fc70b1c --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators/id.html @@ -0,0 +1,3 @@ +The Incidence Decay (ID) estimator uses the method of least squares to estimate R0. +This method assumes the serial interval is known, and is built under the SIR assumption. +We note that the use of this method might result in the underestimation of R0. diff --git a/inst/web/templates/content/estimation/about-estimators/idea.html b/inst/web/templates/content/estimation/about-estimators/idea.html new file mode 100644 index 0000000..67548f8 --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators/idea.html @@ -0,0 +1,4 @@ +The Incidence Decay and Exponential Adjustment (ID) estimator is an alternative formulation of the Incidence Decay (ID) model which includes a decay factor to reflect the often observed outbreak decline. +This addresses the potential underestimation of the R0 estimate when using the ID method. +The method of least squares is used to estimate R0, and similar to the ID model, the serial interval is assumed to be known and this method is developed assuming the SIR model. +We note that, since we need to obtain a minimizer of the decay factor to solve the optimization problem, we require that the number of cases in the dataset be at least 2. diff --git a/inst/web/templates/content/estimation/about-estimators/panel.html b/inst/web/templates/content/estimation/about-estimators/panel.html new file mode 100644 index 0000000..98fe155 --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators/panel.html @@ -0,0 +1,14 @@ +
+

+ +

+
+
+

Reference: {{ reference_label }}

+

{{ htmlTemplate(paste0("templates/content/estimation/about-estimators/", id, ".html")) }}

+
+
+
diff --git a/inst/web/templates/content/estimation/about-estimators/seq_bayes.html b/inst/web/templates/content/estimation/about-estimators/seq_bayes.html new file mode 100644 index 0000000..8f66ab4 --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators/seq_bayes.html @@ -0,0 +1,9 @@ +The sequential Bayes (seqB) estimator uses a Bayesian approach to estimate R0 which updates the reproductive number estimate as data accumulates over time. +This approach is based on the SIR model, and assumes that the mean of the serial distribution (ie. the serial interval (SI)) is known. +It is assumed that infectious counts are observed at periodic times (ie. daily, weekly). +This method cannot handle datasets where there are no new infections observed in a time interval, thus, to remedy this, +some manipulation may be necessary to make the times at which infectious counts are observed sufficiently course (ie. weeks instead of days). +Further, this method is also inappropriate in situations where long intervals between cases are observed in the initial stages of the epidemic. +Finally, the R0 approximation behaves similarly to a branching process, which means that throughout, the population size “available” to be infected remains constant. +We note that this assumption does not hold for the SIR/SEIR/SEAIR compartmental models. +As such, seqB estimates should only really be considered early on in an epidemic, ie. before the inflection point of an epidemic, if the dataset being used follows these models. diff --git a/inst/web/templates/content/estimation/about-estimators/wp.html b/inst/web/templates/content/estimation/about-estimators/wp.html new file mode 100644 index 0000000..c6f4580 --- /dev/null +++ b/inst/web/templates/content/estimation/about-estimators/wp.html @@ -0,0 +1,6 @@ +The White and Pagano (WP) estimator uses maximum likelihood estimation to estimate R0. +In this method, the serial interval (SI) is either known, or can be estimated along with R0. +It is assumed that the number of infectious individuals are observable at discrete time points (ie. daily or weekly). +Further, this method also assumes an underlying branching process, which means that throughout, the population size “available” to be infected remains constant. +We note that this assumption does not hold for the SIR/SEIR/SEAIR compartmental models. +As such, WP estimates should only really be considered early on in an epidemic, ie. before the inflection point of an epidemic, if the dataset being used follows these models. diff --git a/inst/web/templates/content/estimation/estimates.html b/inst/web/templates/content/estimation/estimates.html new file mode 100644 index 0000000..bc9124e --- /dev/null +++ b/inst/web/templates/content/estimation/estimates.html @@ -0,0 +1,3 @@ +{{ htmlTemplate("templates/content/estimation/estimates/estimates-table.html") }} +
+{{ htmlTemplate("templates/content/estimation/estimates/add-estimators.html") }} diff --git a/inst/web/templates/content/estimation/estimates/add-estimators.html b/inst/web/templates/content/estimation/estimates/add-estimators.html new file mode 100644 index 0000000..60111c7 --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators.html @@ -0,0 +1,16 @@ +

Add estimators

+
+ + + + + {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "id") }} + {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "idea") }} + {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "seq_bayes") }} + {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/parameters.html", id = "wp") }} +
diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/id.html b/inst/web/templates/content/estimation/estimates/add-estimators/id.html new file mode 100644 index 0000000..7c35e55 --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/id.html @@ -0,0 +1 @@ +{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "id") }} diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/idea.html b/inst/web/templates/content/estimation/estimates/add-estimators/idea.html new file mode 100644 index 0000000..781349f --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/idea.html @@ -0,0 +1 @@ +{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "idea") }} diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/mu.html b/inst/web/templates/content/estimation/estimates/add-estimators/mu.html new file mode 100644 index 0000000..8781574 --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/mu.html @@ -0,0 +1,22 @@ + + +
+ + + + +
+ +
+ +
diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/parameters.html b/inst/web/templates/content/estimation/estimates/add-estimators/parameters.html new file mode 100644 index 0000000..5250e31 --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/parameters.html @@ -0,0 +1,7 @@ +
+
Parameters
+ {{ htmlTemplate(paste0("templates/content/estimation/estimates/add-estimators/", id, ".html")) }} + +
diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/seq_bayes.html b/inst/web/templates/content/estimation/estimates/add-estimators/seq_bayes.html new file mode 100644 index 0000000..028fabc --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/seq_bayes.html @@ -0,0 +1,22 @@ +
+ +
+ {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "seq_bayes") }} +
+ +
+ + + + + + +
+
diff --git a/inst/web/templates/content/estimation/estimates/add-estimators/wp.html b/inst/web/templates/content/estimation/estimates/add-estimators/wp.html new file mode 100644 index 0000000..511170f --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/add-estimators/wp.html @@ -0,0 +1,39 @@ + + +
+
+ +
+
+ +
+
+ +
+ {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "wp") }} +
+ +
+ +
+ + + +
+ +
+ + + +
+ +
+ + + +
+
diff --git a/inst/web/templates/content/estimation/estimates/estimates-table.html b/inst/web/templates/content/estimation/estimates/estimates-table.html new file mode 100644 index 0000000..4704d03 --- /dev/null +++ b/inst/web/templates/content/estimation/estimates/estimates-table.html @@ -0,0 +1,19 @@ +

Estimates table

+ +
+ {{ DT::dataTableOutput(outputId = "estimates_table") }} +
+ + + + + + + Export table + diff --git a/inst/web/templates/content/help.html b/inst/web/templates/content/help.html new file mode 100644 index 0000000..df4e887 --- /dev/null +++ b/inst/web/templates/content/help.html @@ -0,0 +1,8 @@ +
+ {{ + htmlTemplate("templates/content/help/panel.html", + id = "serial-interval", + header = "What is the serial interval?" + ) + }} +
diff --git a/inst/web/templates/content/help/panel.html b/inst/web/templates/content/help/panel.html new file mode 100644 index 0000000..9eb6e2e --- /dev/null +++ b/inst/web/templates/content/help/panel.html @@ -0,0 +1,12 @@ +
+

+ +

+
+
+ {{ htmlTemplate(paste0("templates/content/help/", id, ".html")) }} +
+
+
diff --git a/inst/web/templates/content/help/serial-interval.html b/inst/web/templates/content/help/serial-interval.html new file mode 100644 index 0000000..e061115 --- /dev/null +++ b/inst/web/templates/content/help/serial-interval.html @@ -0,0 +1,9 @@ +

Reference: Wikipedia +

+ The serial interval (SI) is not one of the estimators. It is a parameter required by most of the estimators, and can + also be estimated by some of them (if not specified). +

+

+ The SI is defined as the average time between successive infections in a chain of transmission (i.e., the time between + the infection of an infected individual and their subsequent transmissions). +

diff --git a/inst/web/templates/footer.html b/inst/web/templates/footer.html new file mode 100644 index 0000000..19d4b0c --- /dev/null +++ b/inst/web/templates/footer.html @@ -0,0 +1,7 @@ + diff --git a/inst/web/templates/navbar.html b/inst/web/templates/navbar.html new file mode 100644 index 0000000..d447fba --- /dev/null +++ b/inst/web/templates/navbar.html @@ -0,0 +1,27 @@ + diff --git a/inst/web/templates/tabs.html b/inst/web/templates/tabs.html new file mode 100644 index 0000000..351b480 --- /dev/null +++ b/inst/web/templates/tabs.html @@ -0,0 +1,14 @@ + diff --git a/inst/web/www/script.js b/inst/web/www/script.js new file mode 100644 index 0000000..30066d1 --- /dev/null +++ b/inst/web/www/script.js @@ -0,0 +1,21 @@ +$(document).ready(() => { + // Enable tooltips. + $('[data-bs-toggle="tooltip"]').tooltip(); + + // Toggle the text in the bulk data help button. + $('#data-format-toggle').on('click', event => { + btn = $(event.target); + show_format = 'Show required format'; + btn.text(btn.text() === show_format ? 'Hide required format' : show_format); + }); + + // Trigger the file selector via a custom button. + $('#data-upload-select').on('click', () => { + $('#data_upload').trigger('click'); + }); + + // Display the name of the uploaded file. + $('#data_upload').on('change', event => { + $('#data-upload-name').attr('placeholder', event.target.files[0].name); + }); +}); diff --git a/inst/web/www/styles.css b/inst/web/www/styles.css new file mode 100644 index 0000000..a6fc3cd --- /dev/null +++ b/inst/web/www/styles.css @@ -0,0 +1,23 @@ +body { + min-height: 100vh; + height: 100%; + width: 100%; +} + +noscript { + text-align: center; +} + +.shiny-notification { + background-color: black; + color: white; +} + +.plotly-notifier .notifier-note { + background-color: black !important; + color: white !important; +} + +#data_upload { + display: none; +} -- cgit v1.2.3