Apply different function based of the option of the user RShiny SelectInput - r

Question

Depending on the choice in the drop-down list i want to implement a specific function.
selectInput("model","Choose Model",choices = c("d_SIR","d_SIRS","d_SEIR","s_SIR","s_SIRS","s_SEIR",'s_SIRadditive'))
For example, if the choice is d_SIR i want to implement the function for the d_SIR. Do i have to do it with if/else statements?

Answer 1

I can't speak to exactly the choices you describe, but I can answer the general question about using a selectInput for picking different functions to use with the app. This should be made clear through these examples using the familiar "Old Faithful" geyser data.
Using if/else conditionals
library(shiny)
# specify which functions users should be able to choose from
fun_choices <- c("barplot", "boxplot", "hist")
# specify the data that the app will be using, regardless of input
x <- faithful[, 2]
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
# get inputs here
selectInput("plot_fun",
"Choose plotting function",
choices = fun_choices),
# a conditional panel, only shown if user has selected 'hist'
# as the plotting function
conditionalPanel(
condition = "input.plot_fun === 'hist'",
sliderInput("bins",
"Number of bins",
min = 1,
max = 50,
value = 30)
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# we use conditionals to make sure that the "plot_fun" value
# is actually one of our suggested choices (so that the user can't
# trick the app into running any other functions than we want),
# and to use different sets of arguments depending
# on what function is chosen
if (input$plot_fun %in% c("barplot", "boxplot")) {
# here we deal with two functions that share the same set of arguments
# use `get` to fetch the actual function that the
# `plot_fun` string value corresponds to
plot_fun <- get(input$plot_fun)
plot_fun(x)
} else if (input$plot_fun=="hist") {
# here we deal with a function that has a unique set of arguments
plot_fun <- get(input$plot_fun)
bins <- seq(min(x), max(x), length.out = input$bins + 1)
plot_fun(x, breaks = bins, col = 'darkgray', border = 'white')
}
})
}
shinyApp(ui = ui, server = server)
A couple of things to note:
We're a bit clever and DRY with functions that use the same set of arguments. But when we need to pass different arguments to the different functions, here we use if/else conditionals.
It's important to compare the user-input values with your vector of "allowed" choices, to stop them from running malicious code. (a user might muck about with the HTML form input so that they can submit other input than your choices)
get() is key to making this work, as is remembering that functions are also objects, meaning you can refer to them with a variable, as in the example. Again, using get() like this is dangerous, which is why you really need to make sure that it's only used with inputs that you determine.
We embed the input that's only related to one function inside of a conditionalPanel, and make presentation of this panel dependent upon the user having selected the related function.
Using a list of lists and do.call
Instead of using if/else conditionals like we did above, we can specify a "list of lists", where each inner list holds the arguments of a function, and are linked to a "key" with the function's name.
library(shiny)
# specify which functions users should be able to choose from
fun_choices <- c("barplot", "boxplot", "hist")
# specify the data that the app will be using, regardless of input
x <- faithful[, 2]
# a list of lists which hold each function's set of arguments to be passed in
fun_args_list <- list(
barplot = list(
height = x
),
boxplot = list(
x = x,
main = 'Boxplot of waiting times'
),
hist = list(
x = x,
# inserting faux vector here, to be replaced with user input
# later in the server function
breaks = c(),
col = 'darkgray',
border = 'white',
main = 'Histogram of waiting times',
xlab = 'Waiting time'
)
)
ui <- fluidPage(
titlePanel("Old Faithful Geyser Data"),
sidebarLayout(
sidebarPanel(
# get input here
selectInput("plot_fun",
"Choose plotting function",
choices = fun_choices),
# a conditional panel, only shown if user has selected 'hist'
# as the plotting function
conditionalPanel(
condition = "input.plot_fun === 'hist'",
sliderInput("bins",
"Number of bins",
min = 1,
max = 50,
value = 30)
)
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
# now that the user input variable is available to us, we replace the
# faux "bin" argument data with values based on user input
bins <- seq(min(x), max(x), length.out = input$bins + 1)
fun_args_list$hist[['breaks']] = bins
# we use a conditional to make sure that the "plot_fun" value
# is actually one of our suggested choices (so that the user can't
# trick the app into running any other functions than we want),
if (input$plot_fun %in% fun_choices) {
# use `get` to fetch the actual function that the
# `plot_fun` string value corresponds to
plot_fun <- get(input$plot_fun)
# fetch the list of arguments (from our list of lists,
# which we defined at the top), using the name of
# the function as a "key"
fun_args <- fun_args_list[[input$plot_fun]]
}
# call the function "indirectly", by using `do.call` so that we can
# pass a list of arguments to the function
do.call(plot_fun, fun_args)
})
}
shinyApp(ui = ui, server = server)
Note:
do.call is what makes it possible for us to call the function without specifying the arguments in a function call one by one, instead passing a list which holds the necessary information. You can read more about do.call here.
Because of the way base R works, each time you want to "reference" the data in the "list of lists of arguments", the data are actually copied. So in our example, the "waiting time" data are actually copied three times. This isn't a problem with a small data set like in the example, but if you are dealing with larger data sets then I'd say it's better to bite the bullet and insert a bunch of if/else conditionals, rather than using this "list of lists" approach. Or you can try implementing "assignment by reference", which would avoid making copies, using e. g. the data.table package if you want - this SO thread seems like a good place to start.