Suggests:
knitr,
rmarkdown,
- shiny,
bslib,
- DT
+ shiny,
+ DT,
+ plotly
Encoding: UTF-8
LazyData: true
Roxygen: list(markdown = TRUE)
app <- function() {
missing_pkgs <- c()
# Check for any missing, required packages.
- if (!requireNamespace("shiny", quietly = TRUE)) {
- missing_pkgs <- c(missing_pkgs, "shiny")
- }
if (!requireNamespace("bslib", quietly = TRUE)) {
missing_pkgs <- c(missing_pkgs, "bslib")
}
+ if (!requireNamespace("shiny", quietly = TRUE)) {
+ missing_pkgs <- c(missing_pkgs, "shiny")
+ }
if (!requireNamespace("DT", quietly = TRUE)) {
missing_pkgs <- c(missing_pkgs, "DT")
}
+ if (!requireNamespace("plotly", quietly = TRUE)) {
+ missing_pkgs <- c(missing_pkgs, "plotly")
+ }
# If any of the required packages are missing,
# prompt the user to install them.
check.names = FALSE
)
- render_plot(input, output)
- single_entry(input, output, react_values)
- manual_bulk_entry(input, output, react_values)
+ manual_entry(input, output, react_values)
upload_data(input, output, react_values)
load_samples(input, output, react_values)
- render_data(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)
}
suppressWarnings(as.integer(unlist(strsplit(trimws(counts_str), ","))))
}
-# Render the preview plot for single entry data.
-render_plot <- function(input, output) {
+# Render the plots for daily and weekly data when the data table is updated.
+render_plot <- function(input, output, react_values, time_units) {
observe({
- counts <- tokenize_counts(input$data_counts)
- if (length(counts) > 0 && !anyNA(counts) && all(counts >= 0)) {
- output$data_plot <- renderPlot(
- plot(seq_along(counts) - 1, counts, type = "o", pch = 16, col = "black",
- xlab = input$data_units, ylab = "Cases", cex.lab = 1.5,
- xlim = c(0, max(length(counts) - 1, 1)), ylim = c(0, max(counts, 1))
+ 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]
)
- )
- } else {
- output$data_plot <- renderPlot(
- plot(NULL, xlim = c(0, 10), ylim = c(0, 10),
- xlab = input$data_units, ylab = "Cases", cex.lab = 1.5
- )
- )
- }
- })
-}
-
-# Add a single dataset to the existing table.
-single_entry <- function(input, output, react_values) {
- observeEvent(input$data_single, {
- valid <- TRUE
-
- # Ensure the dataset name is neither blank nor a duplicate.
- name <- trimws(input$data_name)
- if (name == "") {
- output$data_name_warn <- renderText("The dataset name cannot be blank.")
- valid <- FALSE
- } else if (name %in% react_values$data_table[, 1]) {
- output$data_name_warn <- renderText(
- "There is already a dataset with the specified name."
- )
- valid <- FALSE
- } else {
- output$data_name_warn <- renderText("")
- }
-
- # Ensure the case counts are specified as a comma-separated of one or more
- # non-negative integers.
- counts <- tokenize_counts(input$data_counts)
- if (length(counts) == 0) {
- output$data_counts_warn <- renderText("Case counts cannot be blank.")
- valid <- FALSE
- } else if (anyNA(counts) || any(counts < 0)) {
- output$data_counts_warn <- renderText(
- "Case counts can only contain non-negative integers."
- )
- valid <- FALSE
- } else {
- output$data_counts_warn <- renderText("")
+ }
}
- if (valid) {
- # Add the new dataset to the data table.
- new_row <- data.frame(name, input$data_units, toString(counts))
- colnames(new_row) <- c("Name", "Time units", "Case counts")
- react_values$data_table <- rbind(react_values$data_table, new_row)
+ plot_title <- paste(
+ if (time_units == "Days") "Daily" else "Weekly", "case counts"
+ )
- # Evaluate all existing estimators on the new dataset and update the
- # corresponding row in the estimates table.
- update_estimates_rows(new_row, react_values)
+ data_plot <- plotly::layout(data_plot, title = plot_title,
+ xaxis = list(title = time_units), yaxis = list(title = "Cases")
+ )
- showNotification("Dataset added successfully.",
- duration = 3, id = "notify-success"
+ 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)
})
}
-manual_bulk_entry <- function(input, output, react_values) {
+# Validate and add manually-entered datasets.
+manual_entry <- function(input, output, react_values) {
observeEvent(input$data_bulk, {
- validate_bulk_data(input, output, react_values, "data_area")
+ 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_bulk_data(input, output, react_values, "data_upload")
+ validate_data(input, output, react_values, "data_upload")
})
}
-validate_bulk_data <- function(input, output, react_values, data_source) {
+# Validate datasets and update the data table.
+validate_data <- function(input, output, react_values, data_source) {
tryCatch(
{
if (data_source == "data_area") {
react_values$data_table <- rbind(react_values$data_table, new_rows)
# Evaluate all existing estimators on the new datasets and update the
- # corresponding rows in the estimates table.
- update_estimates_rows(new_rows, react_values)
+ # corresponding columns in the estimates table.
+ update_estimates_cols(new_rows, react_values)
showNotification("Datasets added successfully.",
duration = 3, id = "notify-success"
react_values$data_table <- rbind(react_values$data_table, new_rows)
# Evaluate all existing estimators on the sample datasets and update the
- # corresponding rows in the estimates table.
- update_estimates_rows(new_rows, react_values)
+ # corresponding columns in the estimates table.
+ update_estimates_cols(new_rows, react_values)
showNotification("Datasets added successfully.",
duration = 3, id = "notify-success"
}
# Render the data table when new datasets are added.
-render_data <- function(output, react_values) {
+render_data_table <- function(output, react_values) {
observe({
- output$data_table <- DT::renderDataTable(react_values$data_table)
+ output$data_table <- DT::renderDataTable(
+ react_values$data_table, rownames = FALSE
+ )
})
}
-# Delete rows in the data table,
-# and the corresponding rows in the estimates table.
+# Delete rows in the data table and the corresponding columns in the estimates
+# table.
delete_data <- function(input, react_values) {
observeEvent(input$data_delete, {
- new_table <- react_values$data_table[-input$data_table_rows_selected, ]
- if (nrow(new_table) > 0) {
- rownames(new_table) <- seq_len(nrow(new_table))
- }
- react_values$data_table <- new_table
-
- if (ncol(react_values$estimates_table) == 1) {
- react_values$estimates_table <- data.frame(
- Datasets = react_values$data_table[, 1]
- )
- } else {
- react_values$estimates_table <-
- react_values$estimates_table[-input$data_table_rows_selected, ]
- }
+ 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)]
})
}
}
# When new datasets are added, evaluate all existing estimators on them and
-# add new rows to the estimates table.
-update_estimates_rows <- function(datasets, react_values) {
- new_rows <- data.frame(
- matrix(nrow = nrow(datasets), ncol = ncol(react_values$estimates_table))
+# 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_rows) <- colnames(react_values$estimates_table)
-
- for (row in seq_len(nrow(datasets))) {
- new_rows[row, 1] <- datasets[row, 1]
+ colnames(new_cols) <- datasets[, 1]
- if (length(react_values$estimators) > 0) {
- for (col in 2:ncol(react_values$estimates_table)) {
- new_rows[row, col] <- eval_estimator(
- react_values$estimators[[col - 1]], datasets[row, ]
- )
+ 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 <- rbind(
- react_values$estimates_table, new_rows
+ react_values$estimates_table <- cbind(
+ react_values$estimates_table, new_cols
)
}
+# 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(Dataset = character(0))
+ 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()
duration = 3, id = "notify-success"
)
- # Evaluate all the new estimator on all existing datasets and create a new
- # column in the estimates table.
- update_estimates_col(new_estimator, react_values)
+ # 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.
mu
}
-# Add a column to the estimates table when a new estimator is added.
-update_estimates_col <- function(estimator, react_values) {
+# 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 <- dataset_rows
+ estimates <- c()
- for (row in dataset_rows) {
- estimate <- eval_estimator(estimator, react_values$data_table[row, ])
- estimates[row] <- estimate
+ 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
+ }
}
- estimates <- data.frame(estimates)
- colnames(estimates) <- estimates_col_name(estimates, estimator)
+ 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 <- cbind(
- react_values$estimates_table, estimates
+ react_values$estimates_table <- rbind(
+ react_values$estimates_table, new_row
)
}
max_shape = estimator$max_shape, max_scale = estimator$max_scale
)
estimated_mu <- round(sum(estimate$supp * estimate$pmf), 2)
- estimate <- paste0(round(estimate$r0, 2), " (μ = ", estimated_mu,
+ estimate <- paste0(round(estimate$r0, 2), " (SI = ", estimated_mu,
" ", tolower(dataset[, 2]), ")"
)
} else {
return(estimate)
}
-# Create the column name of an estimator when it is
-# added to the estimates table.
-estimates_col_name <- function(estimates, estimator) {
+# 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(paste0("ID", " (μ = ", estimator$mu, " ",
- tolower(estimator$mu_units), ")"
- ))
+ return("ID")
} else if (estimator$method == "idea") {
- return(paste0("IDEA", " (μ = ", estimator$mu, " ",
- tolower(estimator$mu_units), ")"
- ))
+ return("IDEA")
} else if (estimator$method == "seq_bayes") {
- return(paste0("seqB", " (μ = ", estimator$mu, " ",
- tolower(estimator$mu_units), ", κ = ", estimator$kappa, ")"
- ))
+ 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(paste0("WP", " (μ = ", estimator$mu, " ",
- tolower(estimator$mu_units), ")"
- ))
+ 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("—")
+ }
+ paste(estimator$mu, tolower(estimator$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,
- selection = list(target = "column", selectable = c(0)),
escape = FALSE, rownames = FALSE,
options = list(
columnDefs = list(list(className = "dt-left", targets = "_all"))
})
}
-# Delete columns from the estimates table,
-# as well as the corresponding estimators.
+# Delete rows from the estimates table and the corresponding estimators.
delete_estimators <- function(input, react_values) {
observeEvent(input$estimators_delete, {
- cols_selected <- input$estimates_table_columns_selected
- react_values$estimators <- react_values$estimators[-cols_selected]
- react_values$estimates_table[, cols_selected + 1] <- NULL
+ 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, ]
})
}
# Substitute HTML entity codes with natural names.
sub_entity <- function(obj) {
- obj <- gsub("μ", "mu", obj)
obj <- gsub("κ", "kappa", obj)
obj
}
<div id="data" class="tab-pane fade">
{{ htmlTemplate("templates/content/data.html") }}
</div>
- <div id="estimators" class="tab-pane fade">
- {{ htmlTemplate("templates/content/estimators.html") }}
+ <div id="estimation" class="tab-pane fade">
+ {{ htmlTemplate("templates/content/estimation.html") }}
</div>
<div id="help" class="tab-pane fade">
{{ htmlTemplate("templates/content/help.html") }}
Technical details about the estimators featured in this project can be found in the reference
<a href="https://doi.org/10.1371/journal.pone.0269306" target="_blank">article</a>.
</p>
-
<h4>What is the basic reproduction number?</h4>
<p>
- The basic reproduction number, denoted <em>R<sub>0</sub></em>, 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.
+ The basic reproduction number, denoted <em>R</em><sub>0</sub>, 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.
</p>
<p>
- If <em>R<sub>0</sub></em> < 1, the disease will eventually die out. On the other hand, if
- <em>R<sub>0</sub></em> > 1, the disease will spread (the higher the <em>R<sub>0</sub></em>, the faster this will happen). Due to uncertainty of known data about the disease, it is difficult to
- determine <em>R<sub>0</sub></em> 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.
+ If <em>R</em><sub>0</sub> < 1, the disease will eventually die out. On the other hand, if
+ <em>R</em><sub>0</sub> > 1, the disease will spread (the higher the <em>R</em><sub>0</sub>, the faster this will
+ happen). Due to uncertainty of known data about the disease, it is difficult to determine <em>R</em><sub>0</sub>
+ 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.
</p>
<a class="nav-link active" data-bs-toggle="tab" href="#enter-data">Enter data</a>
<a class="nav-link" data-bs-toggle="tab" href="#view-data">View data</a>
</nav>
-
<div class="container-fluid tab-content">
<div id="enter-data" class="pt-3 tab-pane fade show active">
{{ htmlTemplate("templates/content/data/enter-data.html") }}
-\r
-<form class="mb-5">\r
- {{ htmlTemplate("templates/content/data/enter-data/entry.html") }}\r
-</form>\r
-<hr>\r
-<form>\r
- {{ htmlTemplate("templates/content/data/enter-data/load-samples.html") }}\r
-</form>\r
+<form class="mb-5">
+ {{ 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") }}
+</form>
+<hr>
+<form>
+ {{ htmlTemplate("templates/content/data/enter-data/load-samples.html") }}
+</form>
+++ /dev/null
-<h4 class="mb-3">Bulk entry</h4>
-<!-- Button to toggle help text. -->
-<button type="button" class="btn btn-outline-primary btn-sm" id="bulk-help-toggle"
- data-bs-toggle="collapse" data-bs-target="#bulk-help">Show required format</button>
-<!-- Help text for bulk input format. -->
-<div class="collapse mt-2" id="bulk-help">
- <div class="card card-body border-primary">
- <p>Manually enter rows or upload a CSV file in the following format:</p>
- <p class="overflow-x-scroll text-nowrap font-monospace">
- <u>Dataset name</u>,<u>Time units</u>,<u>Case counts</u>
- </p>
- <p>
- <u class="font-monospace">Time units</u> must be one of
- <u class="font-monospace">Days</u> or
- <u class="font-monospace">Weeks</u>, and
- <u class="font-monospace">Case counts</u>
- must be a comma-separated list of one or more non-negative integers.
- </p>
- <p>Example:</p>
- <p class="overflow-x-scroll text-nowrap font-monospace lh-sm">
- Montreal,Days,1,2,3,4,5,6,7,8,9,19<br>
- Ottawa,Weeks,1,2,3,4,5,6,7,8,9,19<br>
- Toronto,Days,1,2,3,4,5,6,7,8,9,19
- </p>
- </div>
-</div>
-<!-- Data input area. -->
-<div class="my-4">
- <label class="form-label" for="data_area">Enter manually</label>
- <textarea id="data_area" class="form-control" rows="3" wrap="off"></textarea>
- <div>
- <small id="data_area_warn" class="form-text text-primary shiny-html-output"></small>
- </div>
- <button id="data_bulk" type="button" class="btn btn-outline-primary btn-sm action-button mt-3">
- <span class="glyphicon glyphicon-plus"></span> Add
- </button>
-</div>
-<!-- File input for data upload (hidden). -->
-<input class="form-control" type="file" id="data_upload" accept="text/csv,text/comma-separated-values,text/plain,.csv">
-<!-- Custom button to trigger file selector for data upload (visible). -->
-<label class="form-label" for="data-upload-select">Upload a CSV file</label>
-<div class="input-group">
- <button id="data-upload-select" type="button" class="btn btn-outline-primary btn-sm">
- <span class="glyphicon glyphicon-file"></span> Select file
- </button>
- <input type="text" id="data-upload-name" class="form-control" placeholder="No file selected" disabled>
-</div>
-<small id="data_upload_warn" class="form-text text-primary shiny-html-output"></small>
+++ /dev/null
-\r
-<!-- Button to toggle help text. -->\r
-<button type="button" class="btn btn-outline-primary btn-sm" id="bulk-help-toggle"\r
- data-bs-toggle="collapse" data-bs-target="#bulk-help">Show required format</button>\r
-<!-- Help text for bulk input format. -->\r
-<div class="collapse mt-2" id="bulk-help">\r
- <div class="card card-body border-primary">\r
- <p>Manually enter rows or upload a CSV file in the following format:</p>\r
- <p class="overflow-x-scroll text-nowrap font-monospace">\r
- <u>Dataset name</u>,<u>Time units</u>,<u>Case counts</u>\r
- </p>\r
- <p>\r
- <u class="font-monospace">Time units</u> must be one of\r
- <u class="font-monospace">Days</u> or \r
- <u class="font-monospace">Weeks</u>, and\r
- <u class="font-monospace">Case counts</u>\r
- must be a comma-separated list of one or more non-negative integers.\r
- </p>\r
- <p>Example:</p>\r
- <p class="overflow-x-scroll text-nowrap font-monospace lh-sm">\r
- Montreal,Days,1,2,3,4,5,6,7,8,9,19<br>\r
- Ottawa,Weeks,1,2,3,4,5,6,7,8,9,19<br>\r
- Toronto,Days,1,2,3,4,5,6,7,8,9,19\r
- </p>\r
- </div>\r
-</div>\r
-<!-- Data input area. -->\r
-<div class="my-4">\r
- <label class="form-label" for="data_area">Enter manually</label>\r
- <textarea id="data_area" class="form-control" rows="3" wrap="off"></textarea>\r
- <div>\r
- <small id="data_area_warn" class="form-text text-primary shiny-html-output"></small>\r
- </div>\r
- <button id="data_bulk" type="button" class="btn btn-outline-primary btn-sm action-button mt-3">\r
- <span class="glyphicon glyphicon-plus"></span> Add\r
- </button>\r
-</div>\r
-<!-- File input for data upload (hidden). -->\r
-<input class="form-control" type="file" id="data_upload" accept="text/csv,text/comma-separated-values,text/plain,.csv">\r
-<!-- Custom button to trigger file selector for data upload (visible). -->\r
-<label class="form-label" for="data-upload-select">Upload a CSV file</label>\r
-<div class="input-group">\r
- <button id="data-upload-select" type="button" class="btn btn-outline-primary btn-sm">\r
- <span class="glyphicon glyphicon-file"></span> Select file\r
- </button>\r
- <input type="text" id="data-upload-name" class="form-control" placeholder="No file selected" disabled>\r
-</div>\r
-<small id="data_upload_warn" class="form-text text-primary shiny-html-output"></small>\r
<h4 class="mb-3">Load samples</h4>
+<!-- Checkboxes for sample data. -->
{{
checkboxInput(inputId = "covid_canada", label = "COVID-19 Canada, 2020/03/03 - 2020/03/31 (Weekly)",
value = FALSE, width = "100%"
value = FALSE, width = "100%"
)
}}
+<!-- Warning text. -->
<div>
<small id="data_samples_warn" class="form-text text-primary shiny-text-output"></small>
</div>
--- /dev/null
+<!-- Data input area (manual entry). -->
+<div class="my-4">
+ <label class="form-label" for="data_area">Enter manually</label>
+ <textarea id="data_area" class="form-control" rows="3" wrap="off"></textarea>
+ <div>
+ <small id="data_area_warn" class="form-text text-primary shiny-html-output"></small>
+ </div>
+ <button id="data_bulk" type="button" class="btn btn-outline-primary btn-sm action-button mt-3">
+ <span class="glyphicon glyphicon-plus"></span> Add
+ </button>
+</div>
--- /dev/null
+<!-- Button to toggle help text. -->
+<button type="button" class="btn btn-outline-primary btn-sm" id="data-format-toggle"
+ data-bs-toggle="collapse" data-bs-target="#data-format">Show required format</button>
+<!-- Help text for data input format. -->
+<div class="collapse mt-2" id="data-format">
+ <div class="card card-body border-primary">
+ <p>Manually enter rows or upload a CSV file in the following format:</p>
+ <p class="overflow-x-scroll text-nowrap font-monospace">
+ <u>Dataset name</u>,<u>Time units</u>,<u>Case counts</u>
+ </p>
+ <p>
+ <u class="font-monospace">Time units</u> must be one of
+ <u class="font-monospace">Days</u> or
+ <u class="font-monospace">Weeks</u>, and
+ <u class="font-monospace">Case counts</u>
+ must be a comma-separated list of one or more non-negative integers.
+ </p>
+ <p>Example:</p>
+ <p class="overflow-x-scroll text-nowrap font-monospace lh-sm">
+ Disease A,Days,1,2,3,4,5,6,7,8,9<br>
+ Disease B,Weeks,3,1,4,1,5,2,9<br>
+ Disease C,Days,2,3,5,7,11,13,17,19
+ </p>
+ </div>
+</div>
+++ /dev/null
-<h4>Single entry</h4>
-<!-- Dataset name. -->
-<div class="my-3">
- <label class="form-label" for="data_name">Dataset name</label>
- <input name="data_name" class="form-control" type="text">
- <small id="data_name_warn" class="form-text text-primary shiny-text-output"></small>
-</div>
-<!-- Case counts. -->
-<div class="mb-3">
- <label class="form-label" for="data_counts">
- Case counts
- <sup data-bs-toggle="tooltip" data-bs-placement="right"
- data-bs-title="Enter as a comma-separated list of non-negative integers (example: 0,1,1,2,3,5,8,13).">
- [?]
- </sup>
- </label>
- <input name="data_counts" class="form-control" type="text">
- <small id="data_counts_warn" class="form-text text-primary shiny-text-output"></small>
-</div>
-<!-- Time units. -->
-<div class="mb-3">
- <label class="form-label" for="data_units">Time units</label>
- <div class="shiny-input-radiogroup" id="data_units">
- <div class="form-check form-check-inline">
- <label class="form-check-label">
- <input type="radio" class="form-check-input me-2" name="data_units" value="Days">Days
- </label>
- </div>
- <div class="form-check form-check-inline">
- <label class="form-check-label">
- <input type="radio" class="form-check-input me-2" name="data_units" value="Weeks" checked>Weeks
- </label>
- </div>
- </div>
-</div>
-<!-- Submit data. -->
-<button id="data_single" type="button" class="btn btn-outline-primary btn-sm action-button">
- <span class="glyphicon glyphicon-plus"></span> Add
-</button>
--- /dev/null
+<!-- File input for data upload (hidden). -->
+<input class="form-control" type="file" id="data_upload" accept="text/csv,text/comma-separated-values,text/plain,.csv">
+<!-- Custom button to trigger file selector for data upload (visible). -->
+<label class="form-label" for="data-upload-select">Upload a CSV file</label>
+<div class="input-group">
+ <button id="data-upload-select" type="button" class="btn btn-outline-primary btn-sm">
+ <span class="glyphicon glyphicon-file"></span> Select file
+ </button>
+ <input type="text" id="data-upload-name" class="form-control" placeholder="No file selected" disabled>
+</div>
+<!-- Warning text. -->
+<small id="data_upload_warn" class="form-text text-primary shiny-html-output"></small>
-<h4>Data table</h4>
-<!-- Data table. -->
-<div class="my-3">
- {{ DT::dataTableOutput(outputId = "data_table") }}
-</div>
-<!-- Display inactive delete button when no rows are selected. -->
-<button type="button" class="btn btn-primary btn-sm text-white" disabled
- data-display-if="'data_table_rows_selected' in input && input.data_table_rows_selected.length == 0">
- <span class="glyphicon glyphicon-remove"></span> Delete row(s)
-</button>
-<!-- Display active delete button when at least one row is selected. -->
-<button id="data_delete" type="button" class="btn btn-primary btn-sm action-button text-white"
- data-display-if="'data_table_rows_selected' in input && input.data_table_rows_selected.length != 0">
- <span class="glyphicon glyphicon-remove"></span> Delete row(s)
-</button>
-<!-- Button to export data table as a CSV file. -->
-<a id="data_export" type="button" class="btn btn-outline-primary btn-sm shiny-download-link">
- <span class="glyphicon glyphicon-download-alt"></span> Export table
-</a>
+{{ htmlTemplate("templates/content/data/view-data/data-table.html") }}
+<hr>
+{{ htmlTemplate("templates/content/data/view-data/data-plots.html") }}
--- /dev/null
+<h4>Data plots</h4>
+<div class="container my-5">
+ {{ plotly::plotlyOutput(outputId = "data_plot_days") }}
+</div>
+<div class="container">
+ {{ plotly::plotlyOutput(outputId = "data_plot_weeks") }}
+</div>
--- /dev/null
+<h4>Data table</h4>
+<div class="my-3">
+ {{ DT::dataTableOutput(outputId = "data_table") }}
+</div>
+<!-- Display inactive delete button when no rows are selected. -->
+<button type="button" class="btn btn-primary btn-sm text-white" disabled
+ data-display-if="'data_table_rows_selected' in input && input.data_table_rows_selected.length == 0">
+ <span class="glyphicon glyphicon-remove"></span> Delete row(s)
+</button>
+<!-- Display active delete button when at least one row is selected. -->
+<button id="data_delete" type="button" class="btn btn-primary btn-sm action-button text-white"
+ data-display-if="'data_table_rows_selected' in input && input.data_table_rows_selected.length != 0">
+ <span class="glyphicon glyphicon-remove"></span> Delete row(s)
+</button>
+<!-- Button to export data table as a CSV file. -->
+<a id="data_export" type="button" class="btn btn-outline-primary btn-sm shiny-download-link">
+ <span class="glyphicon glyphicon-download-alt"></span> Export table
+</a>
--- /dev/null
+<nav class="nav nav-tabs">
+ <a class="nav-link active" data-bs-toggle="tab" href="#about-estimators">About the estimators</a>
+ <a class="nav-link" data-bs-toggle="tab" href="#estimates">Compute and view estimates</a>
+</nav>
+
+<div class="container-fluid tab-content">
+ <div id="about-estimators" class="pt-3 tab-pane fade show active">
+ {{ htmlTemplate("templates/content/estimation/about-estimators.html") }}
+ </div>
+ <div id="estimates" class="pt-3 tab-pane fade">
+ {{ htmlTemplate("templates/content/estimation/estimates.html") }}
+ </div>
+</div>
--- /dev/null
+<div class="accordion accordion-flush" id="estimation-accordion">
+ {{
+ 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"
+ )
+ }}
+</div>
--- /dev/null
+The incidence decay (ID) estimator assumes an exponential model and finds the parameters by minimizing the sum of the
+squared differences between the observed cases counts and the case counts expected based on the assumed model.
+The method assumes that the serial interval is known. This means that the user needs to input the value of the serial
+interval. The serial interval is the average time between the first infection and the time the first infected individual
+exhibits disease symptoms.
<div id="{{ id }}" class="accordion-collapse collapse" data-bs-parent="#estimators-accordion">
<div class="accordion-body">
<p>Reference: <a href="{{ reference_url }}" target="_blank"><em>{{ reference_label }}</em></a></p>
- <p>{{ htmlTemplate(paste0("templates/content/estimators/add-estimators/descriptions/", id, ".html")) }}</p>
- <h5>Parameters</h5>
- <form class="my-3">
- {{ htmlTemplate(paste0("templates/content/estimators/add-estimators/parameters/", id, ".html")) }}
- </form>
- <button id="add_{{ id }}" type="button" class="btn btn-outline-primary btn-sm action-button">
- <span class="glyphicon glyphicon-plus"></span> Add
- </button>
+ <p>{{ htmlTemplate(paste0("templates/content/estimation/about-estimators/", id, ".html")) }}</p>
</div>
</div>
</div>
--- /dev/null
+{{ htmlTemplate("templates/content/estimation/estimates/estimates-table.html") }}
+<hr>
+{{ htmlTemplate("templates/content/estimation/estimates/add-estimators.html") }}
--- /dev/null
+<h4>Add estimators</h4>
+<form class="my-3">
+ <!-- Dropdown to select estimator. -->
+ <label class="form-label" for="estimator_select">Select estimator:</label>
+ <select name="estimator_select" class="form-select">
+ <option value="id" selected>Incidence Decay (ID)</option>
+ <option value="idea">Incidence Decay and Exponential Adjustment (IDEA)</option>
+ <option value="seq_bayes">Sequential Bayes (seqB)</option>
+ <option value="wp">White and Pagano (WP)</option>
+ </select>
+ <!-- Parameters. -->
+ {{ 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") }}
+</form>
--- /dev/null
+{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "id") }}
--- /dev/null
+{{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "idea") }}
<!-- Serial interval label and help tooltip. -->
<label class="form-label" for="mu_{{ id }}">
- Serial interval (μ)
+ Serial interval
<sup data-bs-toggle="tooltip" data-bs-placement="right"
data-bs-title="The serial interval is the time between when an infected individual (the infector) becomes
symptomatic, to when another individual (who is infected by the infector) becomes symptomatic.">
</select>
</div>
<!-- Warning text for incorrect values. -->
-<small id="mu_{{ id }}_warn" class="form-text text-primary shiny-text-output"></small>
+<div>
+ <small id="mu_{{ id }}_warn" class="form-text text-primary shiny-text-output"></small>
+</div>
--- /dev/null
+<div class="my-4" data-display-if="input.estimator_select === '{{ id }}'">
+ <h5>Parameters</h5>
+ {{ htmlTemplate(paste0("templates/content/estimation/estimates/add-estimators/", id, ".html")) }}
+ <button id="add_{{ id }}" type="button" class="btn btn-outline-primary btn-sm action-button mt-3">
+ <span class="glyphicon glyphicon-plus"></span> Add
+ </button>
+</div>
<div class="row">
<!-- Serial interval (mu). -->
<div class="col-md">
- {{ htmlTemplate("templates/content/estimators/add-estimators/components/mu.html", id = "seq_bayes") }}
+ {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "seq_bayes") }}
</div>
<!-- Maximum value of the uniform prior (kappa). -->
<div class="col-md mt-2 mt-md-0">
<label class="form-label" for="kappa">
Maximum prior (κ)
<sup data-bs-toggle="tooltip" data-bs-placement="right" data-bs-html="true"
- data-bs-title="The initial maximum belief of <em>R<sub>0</sub></em>. The higher this value, the higher
- <em>R<sub>0</sub></em> is believed to be prior to the estimation.">
+ data-bs-title="The initial maximum belief of <em>R</em><sub>0</sub>. The higher this value, the higher
+ <em>R</em><sub>0</sub> is believed to be prior to the estimation.">
[?]
</sup>
</label>
</div>
<!-- Show the input field for the serial interval if it is known. -->
<div data-display-if="input.wp_mu_known == 'Yes'" class="mt-2 mt-md-0">
- {{ htmlTemplate("templates/content/estimators/add-estimators/components/mu.html", id = "wp") }}
+ {{ htmlTemplate("templates/content/estimation/estimates/add-estimators/mu.html", id = "wp") }}
</div>
<!-- Show the input fields for the grid search parameters if the serial interval is unknown. -->
<div data-display-if="input.wp_mu_known == 'No'" class="row">
--- /dev/null
+<h4>Estimates table</h4>
+<!-- Estimates table. -->
+<div class="my-3">
+ {{ DT::dataTableOutput(outputId = "estimates_table") }}
+</div>
+<!-- Display inactive delete button when no rows are selected. -->
+<button type="button" class="btn btn-primary btn-sm text-white" disabled
+ data-display-if="'estimates_table_rows_selected' in input && input.estimates_table_rows_selected.length == 0">
+ <span class="glyphicon glyphicon-remove"></span> Delete row(s)
+</button>
+<!-- Display active delete button when at least one row is selected. -->
+<button id="estimators_delete" type="button" class="btn btn-primary btn-sm action-button text-white"
+ data-display-if="'estimates_table_rows_selected' in input && input.estimates_table_rows_selected.length != 0">
+ <span class="glyphicon glyphicon-remove"></span> Delete row(s)
+</button>
+<!-- Button to export estimates table as a CSV file. -->
+<a id="estimates_export" type="button" class="btn btn-outline-primary btn-sm shiny-download-link">
+ <span class="glyphicon glyphicon-download-alt"></span> Export table
+</a>
+++ /dev/null
-<nav class="nav nav-tabs">
- <a class="nav-link active" data-bs-toggle="tab" href="#add-estimators">About the estimators</a>
- <a class="nav-link" data-bs-toggle="tab" href="#view-estimates">Select and compute estimates</a>
-</nav>
-
-<div class="container-fluid tab-content">
- <div id="add-estimators" class="pt-3 tab-pane fade show active">
- {{ htmlTemplate("templates/content/estimators/add-estimators.html") }}
- </div>
- <div id="view-estimates" class="pt-3 tab-pane fade">
- {{ htmlTemplate("templates/content/estimators/view-estimates.html") }}
- </div>
-</div>
+++ /dev/null
-<div class="accordion accordion-flush" id="estimators-accordion">
- {{
- htmlTemplate("templates/content/estimators/add-estimators/components/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/estimators/add-estimators/components/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/estimators/add-estimators/components/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/estimators/add-estimators/components/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" ) }}
-</div>
+++ /dev/null
-The incidence decay (ID) estimator assumes an exponential model and finds the parameters by minimizing the sum of the squared differences between the observed cases counts and the case counts expected based on the assumed model. The method assumes that the serial interval is known. This means that the user needs to input the value of the serial interval. The serial interval is the average time between the first infection and the time the first infected individual exhibits disease symptoms.
+++ /dev/null
-The serial interval (SI) is NOT one of the estimators.
-
-<p>The SI is a parameter required by all of the estimators, and can also be estimated by the WP method.</p>
-
-<p>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 and their subsequent transmissions. </p>
-
-<P> Make the tab a different shade (light gray) and then this won't have parameters. It will let us not have to explain SI every single time. We'll expand the description later.</p>
+++ /dev/null
-{{ htmlTemplate("templates/content/estimators/add-estimators/components/mu.html", id = "id") }}
+++ /dev/null
-{{ htmlTemplate("templates/content/estimators/add-estimators/components/mu.html", id = "idea") }}
+++ /dev/null
-{{ htmlTemplate("templates/content/estimators/add-estimators/components/mu.html", id = "id") }}
+++ /dev/null
-<h4>Estimates table</h4>
-<!-- Estimates table. -->
-<div class="my-3">
- {{ DT::dataTableOutput(outputId = "estimates_table") }}
-</div>
-<!-- Display inactive delete button when no columns are selected. -->
-<button type="button" class="btn btn-primary btn-sm text-white" disabled
- data-display-if="'estimates_table_columns_selected' in input &&
- input.estimates_table_columns_selected.length == 0">
- <span class="glyphicon glyphicon-remove"></span> Delete column(s)
-</button>
-<!-- Display active delete button when at least one column is selected. -->
-<button id="estimators_delete" type="button" class="btn btn-primary btn-sm action-button text-white"
- data-display-if="'estimates_table_columns_selected' in input &&
- input.estimates_table_columns_selected.length != 0">
- <span class="glyphicon glyphicon-remove"></span> Delete column(s)
-</button>
-<!-- Button to export estimates table as a CSV file. -->
-<a id="estimates_export" type="button" class="btn btn-outline-primary btn-sm shiny-download-link">
- <span class="glyphicon glyphicon-download-alt"></span> Export table
-</a>
<div class="accordion accordion-flush" id="help-accordion">
- {{ htmlTemplate("templates/content/help/panel.html", id = "serial-interval",
- header = "What is a Serial Interval(mu) ?" ) }} {{
- htmlTemplate("templates/content/help/panel.html", id = "example-help-2",
- header = "Example help 2" ) }}
+ {{
+ htmlTemplate("templates/content/help/panel.html",
+ id = "serial-interval",
+ header = "What is the serial interval?"
+ )
+ }}
</div>
+++ /dev/null
-Example help 1
+++ /dev/null
-Example help 2
-Reference
-<a href="https://en.wikipedia.org/wiki/Serial_interval" target="_blank"
- ><i>Wikipedia</i></a
->
-<br />
-<br />
-
-<p>The serial interval (SI) is NOT one of the estimators.</p>
+<p>Reference: <a href="https://en.wikipedia.org/wiki/Serial_interval" target="_blank"><em>Wikipedia</em></a>
<p>
- The SI is a parameter required by all of the estimators, and can also be
- estimated by the WP method.
+ 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).
</p>
-
<p>
- 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 and their
- subsequent transmissions.
+ 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).
</p>
<!-- Project name and description. -->
<a class="navbar-brand text-primary" href="/">Rnaught Web</a>
<span class="navbar-text d-none d-md-block">
- An estimation suite for <em>R<sub>0</sub></em>
+ An estimation suite for <em>R</em><sub>0</sub>
</span>
<!-- Navigation toggler for smaller screens. -->
<button class="navbar-toggler" type="button" data-bs-toggle="collapse" data-bs-target="#nav-toggle">
About <span class="glyphicon glyphicon-info-sign"></span>
</a>
<a class="nav-link rounded-0" data-bs-toggle="pill" href="#data">
- Upload Data <span class="glyphicon glyphicon-list-alt"></span>
+ Data <span class="glyphicon glyphicon-list-alt"></span>
</a>
- <a class="nav-link rounded-0" data-bs-toggle="pill" href="#estimators">
- Select and Compute Estimators <span class="glyphicon glyphicon-random"></span>
+ <a class="nav-link rounded-0" data-bs-toggle="pill" href="#estimation">
+ Estimation <span class="glyphicon glyphicon-random"></span>
</a>
<a class="nav-link rounded-0" data-bs-toggle="pill" href="#help">
Help <span class="glyphicon glyphicon-question-sign"></span>
$('[data-bs-toggle="tooltip"]').tooltip();
// Toggle the text in the bulk data help button.
- $('#bulk-help-toggle').on('click', event => {
+ $('#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);
text-align: center;
}
-.nav-pills .active {
- color: white !important;
+.shiny-notification {
+ background-color: black;
+ color: white;
}
-.action-button:hover, #bulk-help-toggle:hover, #data_export:hover {
+.plotly-notifier .notifier-note {
+ background-color: black !important;
color: white !important;
}
-#data_plot {
- margin-top: -0.5rem;
-}
-
-td.selected, .shiny-notification {
- background-color: black;
- color: white;
-}
-
#data_upload {
display: none;
}
git.nmode.ca / Rnaught / commitdiff
