#' Server part
#' @import shiny
# start simulation from this number of exposures
start.exp.default <- 1
r0.default <- 2.8
est.days <- 365
server <- function(input, output, session) {
# setting model
model <- "M0"
# initializing a set of parameters
params <- reactiveValues()
model_defaults <- default_params(model = model)
for (model_param in names(model_defaults)){
params[[model_param]] = model_defaults[[model_param]]
}
frozen_lines <- reactiveVal(NULL)
## ............................................................................
## Bookmarking logic
## ............................................................................
setBookmarkExclude(
c(
# DT sends this, no reason to save it in bookmarks
"int_table_rows_all",
"int_table_rows_current",
"int_table_search",
"int_table_state",
"int_table_cell_clicked",
"rendered.table_rows_all",
"rendered.table_rows_current",
"rendered.table_rows_selected",
"rendered.table_search",
"rendered.table_state",
"rendered.table_cell_clicked",
# Buttons shouldn't be saved; they can cause problems on restore if their
# stored values cause observeEvents to be triggered
"parameters_modal",
"add_intervention",
"save",
"goleft",
"goright",
"showint",
"howtouse",
"lastClick",
"lastClickId"
)
)
# Shiny takes care of restoring most inputs automatically, but state whose
# "single source of truth" is on the server (in the form of reactiveVal and
# reactiveValues, usually) need to be manually saved and restored.
onBookmark(function(state) {
state$values$params <- reactiveValuesToList(params)
state$values$intervention.table <- intervention.table()
state$values$plot_day <- plot_day()
})
onRestore(function(state) {
mapply(function(name, value) {
params[[name]] <- value
},
names(state$values$params),
state$values$params)
plot_day(state$values$plot_day)
# There are two complicating factors with restoring intervention.table
# from bookmarked state.
#
# First, the bookmarked state doesn't contain type information, so Shiny
# gives this value back to us as a list, not a data frame. Use
# as.data.frame to turn it back into a data frame.
#
# Second, each individual column doesn't contain type information
# either, so IF there weren't any rows to the intervention table, then
# the columns are given back to us as NULL, which as.data.frame will
# simply throw out; the resulting data frame as 0 columns. Forcing each
# column to be numeric preserves the columns.
intervention.table(as.data.frame(lapply(
state$values$intervention.table, as.numeric
)))
})
onBookmarked(function(url) {
url <- urlshorteneR::isgd_LinksShorten(url)
showBookmarkUrlModal(url)
})
## ............................................................................
## Helper Modal
## ............................................................................
# modal pop-up helper screen
observeEvent(input$howtouse, {
showModal(modalDialog(HTML(about.wording), size = "l", easyClose = TRUE))
})
## ............................................................................
## Selection of R0 or Doubling Time
## ............................................................................
observeEvent(input$curr_date, {
date.select <- format(input$curr_date, format = "%B %d")
updateSliderInput(session, 'doubling_time',
label = sprintf("Doubling Time (days) Before %s", date.select))
updateSliderInput(session, 'r0_prior',
label = sprintf("Basic reproductive number R0 before %s", date.select))
})
## ............................................................................
## Estimation of Re
## ............................................................................
re.estimates <- reactiveValues(graph = NULL,
best.estimate = NULL)
historical.df.blank <- data.frame(
'Date' = character(0),
'Hospitalizations' = numeric(0),
'Day' = numeric(0)
)
hist.data <- reactiveVal(historical.df.blank)
observeEvent(input$add.hist, {
if (!as.character(input$date.hist) %in% as.character(hist.data()$Date) &
!is.na(input$num.hospitalized.hist)) {
new.hist <- add.to.hist.table(
hist.data = hist.data(),
date.hist = input$date.hist,
num.hospitalized.hist = input$num.hospitalized.hist,
curr.date = input$curr_date
)
hist.data(new.hist)
updateDateInput(session,
inputId = 'date.hist',
value = input$date.hist - 1)
}
else if (as.character(input$date.hist) %in% as.character(hist.data()$Date))
(
shinyalert::shinyalert(re.warning.date.repeat, type = "error")
)
else{
shinyalert::shinyalert(re.warning.blank.num, type = "error")
}
})
output$input_hosp_dt <- DT::renderDataTable({
hist.dt <- hist.data()
if (nrow(hist.dt) > 0) {
hist.dt[["Delete"]] <-
paste0(
'
<div class="btn-group" role="group" aria-label="">
<button type="button" class="btn btn-secondary delete" id=delhist',
'_',
hist.dt$Day,
'>Delete</button>
</div>
'
)
}
hist.dt$Day <- NULL
DT::datatable(
hist.dt,
escape = FALSE,
selection = 'none',
options = list(
pageLength = 10,
language = list(zeroRecords = "No historical data added.",
search = "Find in table:"),
dom = 't'
),
rownames = FALSE
)
})
observeEvent(input$lastClick, {
if (grepl('delhist', input$lastClickId)) {
delete_day <- as.numeric(strsplit(input$lastClickId, '_')[[1]][2])
hist.data(hist.data()[hist.data()$Day != delete_day, ])
}
})
observeEvent(input$run.fit, {
hist.temp <- hist.data()
hist.temp <- dplyr::arrange(hist.temp, dplyr::desc(Date))
if (nrow(hist.temp) >= 2) {
best.fit <- findBestRe(
model = model,
N = input$num_people,
start.exp = start.exp.default,
num.days = est.days,
day.vec = hist.temp$Day,
num_actual.vec = hist.temp$Hospitalizations,
params = params
)
best.vals <- best.fit$best.vals
df.graph <- data.frame(
Date = hist.temp$Date,
Predicted = best.vals,
Actual = hist.temp$Hospitalizations
)
df.melt <- tidyr::pivot_longer(
df.graph,
-Date,
names_to = "variable"
)
re.estimates$graph <- re_estimate_plot(df.melt)
re.estimates$best.estimate <- sprintf(best.re.msg,
best.fit$best.re)
shinyjs::show("predict.ui.toggle")
}
else{
shinyalert::shinyalert(re.warning.more.data, type = "error")
}
})
output$best.re <- renderUI({
HTML(re.estimates$best.estimate)
})
output$fit.plot <- renderPlot({
re.estimates$graph
})
observeEvent(input$curr_date, {
hist.data(historical.df.blank)
})
## ............................................................................
## Parameter selection
## ............................................................................
output$params_ui <- renderUI({
div(
HTML("<br><h4><b>Parameters</b></h4><br>"),
parameters_page(model = model)
)
})
observeEvent(input$illness.length,{
params$illness.length <- input$illness.length
params$gamma.r <- 1 / input$illness.length
params$gamma <- ((1 - input$hosp.rate) * 1 / input$illness.length) +
(input$hosp.rate * 1 / input$hosp.after.inf)
})
observeEvent(input$hosp.after.inf,{
params$inf.to.hosp <- input$hosp.after.inf
params$gamma.h <- 1 / input$hosp.after.inf
params$gamma <- ((1 - input$hosp.rate) * 1 / input$illness.length) +
(input$hosp.rate * 1 / input$hosp.after.inf)
})
observeEvent(input$incubation.period,{
params$incubation.period <- input$incubation.period
params$sigma <- 1 / input$incubation.period
})
observeEvent(input$hosp.los,{
params$hosp.los <- input$hosp.los
params$psi <- 1 / input$hosp.los
})
observeEvent(input$hosp.rate, {
params$hosp.rate <- input$hosp.rate
params$gamma <- ((1 - input$hosp.rate) * 1 / input$illness.length) +
(input$hosp.rate * 1 / input$hosp.after.inf)
})
observeEvent(input$icu.rate, {
params$icu.rate <- input$icu.rate
})
observeEvent(input$vent.rate, {
params$vent.rate <- input$vent.rate
})
observeEvent(input$p.g_icu, {
params$p.g_icu = input$p.g_icu
params$p.g_g = 1 - input$p.g_d - input$p.g_icu
})
observeEvent(input$p.g_d, {
params$p.g_d = input$p.g_d
params$p.g_g = 1 - input$p.g_d - input$p.g_icu
})
observeEvent(input$p.icu_g, {
params$p.icu_g = input$p.icu_g
params$p.icu_icu = 1 - input$p.icu_g - input$p.icu_v
})
observeEvent(input$p.icu_v, {
params$p.icu_v = input$p.icu_v
params$p.icu_icu = 1 - input$p.icu_g - input$p.icu_v
})
observeEvent(input$p.v_icu, {
params$p.v_icu = input$p.v_icu
params$p.v_v = 1 - input$p.v_icu - input$p.v_m
})
observeEvent(input$p.v_m, {
params$p.v_m = input$p.v_m
params$p.v_v = 1 - input$p.v_icu - input$p.v_m
})
## ............................................................................
## Initialization
## ............................................................................
initial_beta_vector <- reactive({
if (input$usedouble == FALSE) {
beta <- getBetaFromRe(input$r0_prior, params$gamma)
}
else{
beta <- getBetaFromDoubling(input$doubling_time, params$gamma)
}
initial.beta.vector <- rep(beta, est.days)
initial.beta.vector
})
curr.day.list <- reactive({
find.curr.estimates(
model = model,
N = input$num_people,
beta.vector = initial_beta_vector(),
num.days = est.days,
num.actual = input$num_hospitalized,
metric = "Hospitalizations",
start.exp = start.exp.default,
params = params
)
})
## ............................................................................
## Interventions
## ............................................................................
# blank intervention dataframes
int.df.with.re <- data.frame(
'Day' = numeric(0),
'New Re' = numeric(0),
'Days to Reach New Re' = numeric(0)
)
int.df.with.double <- data.frame(
'Day' = numeric(0),
'New Double Time' = numeric(0),
'Days to Reach New Re' = numeric(0)
)
intervention.table <- reactiveVal(int.df.with.re)
observe({
min <- input$curr_date
val <- input$curr_date
updateDateInput(session, "int_date", min = min, value = val)
})
observeEvent(input$showint, {
params$int.new.double <- input$doubling_time
params$int.new.r0 <- input$r0_prior
params$int.new.num.days <- 0
params$int.smooth.days <- 0
})
observeEvent(input$doubling_time, {
if (input$showint == FALSE) {
params$int.new.double <- input$doubling_time
}
})
observeEvent(input$r0_prior, {
if (input$showint == FALSE) {
params$int.new.r0 <- input$r0_prior
}
})
observeEvent(input$new_double, {
params$int.new.double <- input$new_double
})
observeEvent(input$r0_new, {
params$int.new.r0 <- input$r0_new
})
observeEvent(input$smooth.int, {
params$int.smooth.days <- input$smooth.int
})
observeEvent(input$int_date, {
params$int.new.num.days <- input$int_date - input$curr_date
})
observeEvent(input$usedouble, ignoreInit = TRUE, {
if (input$usedouble == TRUE) {
intervention.table(int.df.with.double)
}
else{
intervention.table(data.frame(int.df.with.re))
}
})
observeEvent(input$add_intervention, {
if (!params$int.new.num.days %in% intervention.table()$Day) {
new.table <- bind.to.intervention(
int.table = intervention.table(),
params = reactiveValuesToList(params),
usedouble = input$usedouble
)
intervention.table(new.table)
}
else{
shinyalert::shinyalert(double.int.warning, type = "error")
}
})
output$int_table <- DT::renderDataTable({
int.df <- intervention.table()
int.df$Date <- int.df$Day + input$curr_date
if (input$usedouble) {
int.df <-
int.df[, c('Date',
'New.Double.Time',
'Days.to.Reach.New.Re',
'Day')]
colnames(int.df) <-
c('Date', 'New Double Time', 'Days to Reach New Re', 'Day')
}
else{
int.df <- int.df[, c('Date', 'New.Re', 'Days.to.Reach.New.Re', 'Day')]
colnames(int.df) <-
c('Date', 'New Re', 'Days to Reach New Re', 'Day')
}
if (nrow(int.df) > 0) {
int.df[["Delete"]] <-
paste0(
'
<div class="btn-group" role="group" aria-label="">
<button type="button" class="btn btn-secondary delete" id=delete',
'_',
int.df$Day,
'>Delete</button>
</div>
'
)
}
int.df$Day <- NULL
DT::datatable(
int.df,
escape = FALSE,
selection = 'none',
options = list(
pageLength = 10,
language = list(zeroRecords = "No interventions added.",
search = 'Find in table:'),
dom = 't'
),
rownames = FALSE
)
})
observeEvent(input$lastClick, {
if (grepl('delete', input$lastClickId)) {
delete_day <- strsplit(input$lastClickId, '_')[[1]][2]
intervention.table(intervention.table()[intervention.table()$Day != delete_day, ])
}
})
## ............................................................................
## Influx of Infections
## ............................................................................
observeEvent(input$curr_date, {
updateDateInput(session,
inputId = 'influx_date',
min = input$curr_date)
})
## ............................................................................
## Projection
## ............................................................................
beta.vector <- reactive({
int.table.temp <- intervention.table()
# determines what 'day' we are on using the initialization
curr.day <- as.numeric(curr.day.list()['curr.day'])
# hacky way to deal with error at the startup
if (is.na(curr.day)) {
curr.day <- 365
new.num.days <- 1000
}
# creating intervention table to create a beta vector
if (input$usedouble == FALSE) {
if (!is.null(input$r0_prior) && !is.null(params$int.new.r0)) {
int.table.temp <- rbind(list(
Day = c(
params$int.new.num.days,
-curr.day,
input$proj_num_days
),
New.Re = c(params$int.new.r0, input$r0_prior, NA),
Days.to.Reach.New.Re = c(params$int.smooth.days, 0, 0)
),
int.table.temp)
}
else{
int.table.temp <- rbind(list(
Day = c(-curr.day, input$proj_num_days),
New.Re = c(r0.default, NA),
Days.to.Reach.New.Re = c(0, 0)
),
int.table.temp)
}
}
else{
int.table.temp <- rbind(
list(
Day = c(
params$int.new.num.days,
-curr.day,
input$proj_num_days
),
New.Double.Time = c(params$int.new.double, input$doubling_time, NA),
Days.to.Reach.New.Re = c(params$int.smooth.days, 0, 0)
),
int.table.temp
)
}
create.beta.vec(
int.table = int.table.temp,
usedouble = input$usedouble,
gamma = params$gamma
)
})
seir.output.df <- reactive({
# get current day
curr.day <- as.numeric(curr.day.list()['curr.day'])
# make influx list
influx = list('day' = -1, num.influx = 0)
if (input$showinflux == TRUE) {
if (length(input$influx_date > 0)) {
influx.day <- input$influx_date - input$curr_date + curr.day
influx <- list('day' = influx.day,
'num.influx' = input$num.influx)
}
}
# run the same model as initialization model but run extra days
new.num.days <- input$proj_num_days + curr.day
new.num.days <-
ifelse(is.na(new.num.days), 365, new.num.days)
# starting conditions
start.susc <- input$num_people - start.exp.default
start.inf <- 0
start.res <- 0
seir.df = SEIR(
model = model,
S0 = start.susc,
E0 = start.exp.default,
I0 = start.inf,
R0 = start.res,
beta.vector = beta.vector(),
num.days = new.num.days,
influx = influx,
params = params
)
# shift the number of days to account for day 0 in the model
seir.df$days.shift <- seir.df$day - curr.day
# Note: this will cause an error if Model 2 is run because icu.rate and vent.rate
# are not available
#
# TODO: this is very hack-y.... And may not give a good alignment for projections
# at days.shift>0
num.hosp.input <- input$num_hospitalized
num.icu.orig <- num.hosp.input * params$icu.rate
num.vent.orig <- num.icu.orig * params$vent.rate
seir.df[seir.df$days.shift == 0,]$hosp <- num.hosp.input
seir.df[seir.df$days.shift == 0,]$icu <- num.icu.orig
seir.df[seir.df$days.shift == 0,]$vent <- num.vent.orig
seir.df$date <-
seir.df$days.shift + as.Date(input$curr_date)
seir.df
})
## ............................................................................
## Plot Outputs
## ............................................................................
observeEvent(input$hosp_cap, {
params$hosp.avail <- input$hosp_cap
})
observeEvent(input$icu_cap, {
params$icu.avail <- input$icu_cap
})
observeEvent(input$vent_cap, {
params$vent.avail <- input$vent_cap
})
observeEvent(input$selected_graph, ignoreInit = TRUE,{
if (input$selected_graph == "Hospital Resources"){
updateNumericInput(session,
inputId = "hosp_cap",
value = params$hosp_cap)
updateNumericInput(session,
inputId = "icu_cap",
value = params$icu_cap)
updateNumericInput(session,
inputId = "vent_cap",
value = params$vent_cap)
updateCheckboxGroupInput(session,
inputId = "selected_lines",
choices = c('Hospital', 'ICU', 'Ventilator'),
selected = c('Hospital', 'ICU', 'Ventilator'),
inline = TRUE)
}
else if (input$selected_graph == "Hospitalization"){
updateCheckboxGroupInput(session,
inputId = "selected_lines",
choices = c('Hospital', 'ICU', 'Ventilator'),
selected = c('Hospital', 'ICU', 'Ventilator'),
inline = TRUE)
}
else{
updateCheckboxGroupInput(session,
inputId = "selected_lines",
choices = c('Total Cases', 'Active Cases', 'Resolved Cases'),
selected = c('Total Cases', 'Active Cases', 'Resolved Cases'),
inline = TRUE)
}
})
## ............................................................................
## Dataframes for Visualization and Downloading
## ............................................................................
cases.df <- reactive({
create.cases.df(df = seir.output.df())
})
hospitalization.df <- reactive({
create.hosp.df(df = seir.output.df())
})
resource.df <- reactive({
create.res.df(
df = seir.output.df(),
hosp_cap = input$hosp_cap,
icu_cap = input$icu_cap,
vent_cap = input$vent_cap
)
})
## ............................................................................
## Table output
## ............................................................................
selected_graph_data <- reactive({
if (input$selected_graph == 'Cases') {
cases.df()
}
else if (input$selected_graph == 'Hospitalization') {
hospitalization.df()
}
else {
resource.df()
}
})
output$rendered.table <- DT::renderDataTable({
df.render <- selected_graph_data()
df.render$date <- format(df.render$date, format = "%B %d, %Y")
DT::datatable(
data = df.render,
escape = FALSE,
selection = 'single',
options = list(
pageLength = 10,
lengthChange = FALSE,
searching = FALSE
),
rownames = FALSE
)
})
observeEvent(input$rendered.table_row_last_clicked, {
row.id <- input$rendered.table_row_last_clicked
df.table <- selected_graph_data()
select.date <- df.table[row.id, 'date']
plot_day(select.date)
})
## ............................................................................
## Graphs
## ............................................................................
plot_day <- reactiveVal(NULL)
observeEvent(input$curr_date, {
plot_day(input$curr_date)
})
observeEvent(input$plot_click, {
plot_day(as.Date(round(input$plot_click$x), origin = "1970-01-01"))
proxy <- DT::dataTableProxy(
'rendered.table',
session = shiny::getDefaultReactiveDomain(),
deferUntilFlush = TRUE
)
DT::selectRows(proxy, plot_day() - input$curr_date + 1)
DT::selectPage(proxy, ceiling((plot_day() - input$curr_date + 1) / 10))
})
observeEvent(input$goright, {
if (plot_day() != input$curr_date + input$proj_num_days) {
plot_day(plot_day() + 1)
proxy <- DT::dataTableProxy(
'rendered.table',
session = shiny::getDefaultReactiveDomain(),
deferUntilFlush = TRUE
)
DT::selectRows(proxy, plot_day() - input$curr_date + 1)
DT::selectPage(proxy, ceiling((
plot_day() - input$curr_date + 1
) / 10))
}
})
observeEvent(input$goleft, {
if (plot_day() != input$curr_date) {
plot_day(plot_day() - 1)
proxy <- DT::dataTableProxy(
'rendered.table',
session = shiny::getDefaultReactiveDomain(),
deferUntilFlush = TRUE
)
DT::selectRows(proxy, plot_day() - input$curr_date + 1)
DT::selectPage(proxy, ceiling((
plot_day() - input$curr_date + 1
) / 10))
}
})
output$rendered_plot <- renderPlot({
if (input$selected_graph == 'Hospitalization'){
create.graph(
df.to.plot = hospitalization.df(),
selected = input$selected_lines,
plot.day = plot_day(),
curr.date = input$curr_date,
frozen_data = frozen_lines()
)
}
else if (input$selected_graph == 'Hospital Resources'){
create.graph(
df.to.plot = resource.df(),
selected = input$selected_lines,
plot.day = plot_day(),
curr.date = input$curr_date,
frozen_data = frozen_lines()
)
}
else{
create.graph(
df.to.plot = cases.df(),
selected = input$selected_lines,
plot.day = plot_day(),
curr.date = input$curr_date,
frozen_data = frozen_lines()
)
}
})
observe({
shinyjs::toggleState("freeze_reset", condition = !is.null(frozen_lines()))
})
observe({
shinyjs::toggleState("freeze_btn", condition = nzchar(trimws(input$freeze_name)))
})
observe({
input$selected_graph
input$selected_lines
input$freeze_reset
frozen_lines(NULL)
})
observe({
show_freeze <-
length(input$selected_lines) == 1
shinyjs::toggle("freeze-section", condition = show_freeze)
})
observeEvent(input$freeze_btn, {
name <- trimws(input$freeze_name)
selected <- input$selected_lines
if (name == selected) {
shinyalert::shinyalert("You cannot use the same name as the selected variable.", type = "error")
return()
}
if (name %in% unique(frozen_lines()$variable)) {
shinyalert::shinyalert("You cannot use the same name twice.", type = "error")
return()
}
cols <- c("date", selected)
new_data <- selected_graph_data()[, cols]
names(new_data)[2] <- name
new_data <- tidyr::pivot_longer(new_data, -date, names_to = "variable")
if (is.null(frozen_lines())) {
frozen_lines(new_data)
} else {
frozen_lines(dplyr::full_join(frozen_lines(), new_data))
}
})
## ............................................................................
## Natural Language Outputs
## ............................................................................
# estimatated number of infections of "day 0"
output$infected_ct <- renderUI({
curr.date <- format(input$curr_date, format = "%B %d, %Y")
curr.day <- curr.day.list()['curr.day']
curr.row <-
seir.output.df()[seir.output.df()$day == curr.day, ]
infected <- round(curr.row$I + curr.row$E)
cases <- round(curr.row$I + curr.row$R + curr.row$E)
HTML(sprintf(curr.inf.est.wording, curr.date, cases, infected))
})
# describing each timestep in words
output$description <- renderUI({
df_temp <- seir.output.df()
select.row <- df_temp[df_temp$date == plot_day(), ]
select.date <- format(select.row$date, format = "%B %d, %Y")
select.day <- select.row$days.shift
if (input$selected_graph == 'Cases') {
cases <- round(select.row$I + select.row$R + select.row$E)
active <- floor(select.row$I + select.row$E)
if (length(select.day) != 0) {
if (select.day == 0) {
HTML(sprintf(
cases.curr.wording,
select.date,
cases,
active
))
}
else{
HTML(sprintf(
cases.fut.wording,
select.date,
cases,
active
))
}
}
}
else if (input$selected_graph == 'Hospitalization') {
hosp <- round(select.row$hosp)
icu <- round(select.row$icu)
vent <- round(select.row$vent)
if (select.day == 0) {
HTML(sprintf(
hosp.curr.wording,
select.date,
hosp,
icu,
vent
))
}
else{
HTML(sprintf(hosp.fut.wording, select.date, hosp, icu, vent))
}
}
else{
hosp_res <- input$hosp_cap - round(select.row$hosp)
icu_res <- input$icu_cap - round(select.row$icu)
vent_res <- input$vent_cap - round(select.row$vent)
if (select.day == 0) {
HTML(
sprintf(
res.curr.wording,
select.date,
hosp_res,
icu_res,
vent_res
)
)
}
else{
HTML(sprintf(
res.fut.wording,
select.date,
hosp_res,
icu_res,
vent_res
))
}
}
})
## ............................................................................
## Download Data
## ............................................................................
output$downloadData <- downloadHandler(filename <- function() {
paste('Projections', '-', Sys.Date(), '.csv', sep = '')
},
content <- function(file) {
data <- selected_graph_data()
# TODO: this is for testing only, uncomment and
# remove bottom lines after testing is done, and instead
# write the data df above to CSV.
# utils::write.csv(data.frame(data), file, row.names = FALSE)
df.output <- seir.output.df()
# model specific dataframe downloads
# process.df.for.download function is in model1.R or model2.R
df.output <- process_df_download(model = model,
df = df.output)
# TODO: this is dirty. Should perhaps be parsed out into a function.
# process parameters
gen.param.names <- c('Number of people in Area', 'Date')
gen.param.vals <- c(input$num_people, input$curr_date)
# doubling time or Re
if (input$usedouble == TRUE) {
gen.param.names <- c(gen.param.names, 'Prior Doubling Time')
gen.param.vals <-
c(gen.param.vals, input$doubling_time)
}
else{
gen.param.names <- c(gen.param.names, 'Prior Re')
gen.param.vals <- c(gen.param.vals, input$r0_prior)
}
# hospitalizations or cases
gen.param.names <- c(gen.param.names, paste('Initial', input$metric))
gen.param.vals <- c(gen.param.vals, input$num_hospitalized)
if (input$showinflux) {
gen.param.names <-
c(gen.param.names, 'Influx Date', 'Influx Number')
gen.param.vals <-
c(gen.param.vals,
input$influx.date,
input$num_influx)
}
params.list <- process_params_download(model = model,
params = params)
params.df <-
data.frame(
PARAMETERS = rep(NA, length(c(
gen.param.names, names(params.list)
))),
params = c(gen.param.names, names(params.list)),
values = c(gen.param.vals, unlist(params.list)),
INTERVENTIONS = rep(NA, length(c(
gen.param.names, names(params.list)
)))
)
df.binded <- cbind.fill(df.output, params.df)
if (nrow(intervention.table()) > 0) {
df.binded <- cbind.fill(df.output, params.df, intervention.table())
}
else{
df.binded <- cbind.fill(df.output, params.df)
}
utils::write.csv(data.frame(df.binded),
file,
row.names = FALSE,
na = '')
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.