根据用户RShiny SelectInput的选项应用不同的功能

如何解决根据用户RShiny SelectInput的选项应用不同的功能

根据下拉列表中的选择，我要实现特定功能。

 selectInput("model","Choose Model",choices = c("d_SIR","d_SIRS","d_SEIR","s_SIR","s_SIRS","s_SEIR",'s_SIRadditive'))

例如，如果选择的是d_SIR，我想实现d_SIR的功能。我必须使用if / else语句吗？

解决方法

我无法准确说明您所描述的选择，但是我可以回答有关使用selectInput来选择要与应用程序一起使用的不同功能的一般问题。通过这些示例，使用熟悉的“老忠实”间歇泉数据可以清楚地说明这一点。

使用if / else条件

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)

几件事要注意：

• 我们有点聪明，DRY的函数使用相同的参数集。但是，当我们需要将不同的参数传递给不同的函数时，在这里我们使用if / else条件。
• 将用户输入的值与“允许”选择的向量进行比较非常重要，以防止它们运行恶意代码。 （用户可能会对HTML表单输入感到厌烦，以便他们可以提交您选择之外的其他输入）
• get()是完成这项工作的关键，要记住，函数也是对象，这意味着您可以使用示例中的变量来引用它们。同样，使用get()是危险的，这就是为什么您真正需要确保仅将其与您确定的输入一起使用的原因。
• 我们将仅与一个功能相关的输入嵌入conditionalPanel中，并根据用户选择了相关功能来显示此面板。

使用列表列表和do.call

我们可以指定一个“列表列表”，而不是像上面那样使用if / else条件，其中每个内部列表都保存一个函数的参数，并链接到带有函数名称的“键”。 / p>

library(shiny)

# specify which functions users should be able to choose from
fun_choices <- c("barplot",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(),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",only shown if user has selected 'hist' 
            # as the plotting function
            conditionalPanel(
                condition = "input.plot_fun === 'hist'",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),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)

注意：

• do.call使我们可以调用函数而无需在函数调用中一个接一个地指定参数，而是传递一个包含必要信息的列表。您可以read more about do.call here。
• 由于基R的工作方式，每次您要“引用”“参数列表列表”中的数据时，实际上都会复制该数据。因此，在我们的示例中，“等待时间”数据实际上被复制了三次。对于示例中的较小数据集来说，这不是问题，但是如果您要处理较大的数据集，那么我会说最好是硬着头皮插入一堆if / else条件语句，而不是使用此条件“列表列表”方法。或者，您可以尝试实现“按引用分配”，这将避免使用e进行复制。 G。 data.table软件包-this SO thread似乎是一个不错的起点。