在 R Shiny 中使用 selectinput 函数选择多个变量时显示多个输入框

Question

该应用程序的目标是让用户从 rshiny 中的 selectinput 函数中选择一些变量，并且根据选择的任何变量，应该有一个相应的 numericinput 框，该框以该变量的权重作为输入。

例如，如果我从 selectinput 函数中选择四个变量，那么应该有 4 个数字输入框，它们会提示用户输入相应的权重。

我可以使用复选框选项而不是 selectinput 函数来做到这一点，但由于变量的数量很大，所以复选框选项不可行。

使用复选框功能代码如下：

checkboxInput("pick", "Picked_up"),
      conditionalPanel(
        condition = "input.pick == true",
        numericInput("var1","Enter the weightage of the variable","")
      ),

      br(),
      checkboxInput("c2", "%C2"),
      conditionalPanel(
        condition = "input.c2 == true",
        numericInput("var2","Enter the weightage of the variable","")
      ),
      br(),
      checkboxInput("newfill", "Perc_Newfill"),
      conditionalPanel(
        condition = "input.newfill == true",
        numericInput("var3","Enter the weightage of the variable","")
      ),

      br(),
      checkboxInput("rts", "%RTS"),
      conditionalPanel(
        condition = "input.rts == true",
        numericInput("var4","Enter the weightage of the variable","")
      )

我想为selectinput函数实现同样的功能，我尝试的代码如下：

ui.r

uiOutput('select_value'),
uiOutput('input_value'),

服务器.r

output$select_value <- renderUI({
    selectInput('var_name','choose variables',names(descriptive_data),multiple = TRUE)
  })



  runInput2<- observeEvent(input$var_name,{


      for(i in 1:length(input$var_name))
      {
      output$input_value <- renderUI({
        mydata <- input$var_name[1]
        numericInput('var', 'input weightage',"")

      })
      }
  })

我是 Rshiny 的新手，因此愿意接受有关我做错了什么以及如何实施的建议。

Answer 1

这是您的问题的解决方案。它为每个选定的变量创建一个numericInput。它不使用for 循环，而是使用lapply 函数，该函数返回一个包含所有已创建UI 元素的列表（这是对多个UI 元素进行分组的最佳方式）。最后，为了避免创建多个观察者来获取numericInput 的值，它仅在选择变量时使用操作按钮来恢复值。在服务器功能开始时，创建了一个向量来存储预定义的权重值，恢复用户先前分配的numericInput 的值也很有用。这是必要的，因为每次选择新变量时，都会再次呈现完整的 mainPanel。

library(shiny)

ui <- fluidPage(
  sidebarPanel(uiOutput('select_value')),
  mainPanel(uiOutput('input_value'))
)

server <- function(input , output){
  descriptive_data <- mtcars
  # initial value for weights and to keep track of value
  weightages <- rep(0, ncol(descriptive_data))
  # set names to simplify recover/storing value
  names(weightages) <- names(descriptive_data)

  output$select_value <- renderUI({
    div(
      selectInput('var_name', 'choose variables',
        names(descriptive_data), multiple = TRUE),
      actionButton("get", "Get weightages"),
      tableOutput('table')
    )
  })

  output$input_value <- renderUI({
    var_name <- input$var_name
    if (!is.null(var_name)) {
      # lapply will return a list
      lapply(1:length(var_name), function(k) { 
          numericInput(paste0("var", k), 
            paste('input weightage for', 
            # assign stored value
            var_name[k]), weightages[[var_name[k]]])
      })
    }    
  })

  observeEvent(input$get, {
    # to avoid create one observer per numeric input
    # we use a action button to trigger the recovering 
    # of weights.
    var_name <- input$var_name
    if (!is.null(var_name)) {
      for(k in 1:length(var_name)) { 
        # only recover/update value is the numeric input exists
        if (!is.null(input[[paste0("var", k)]]))
          weightages[[var_name[k]]] <<- input[[paste0("var", k)]]
      }
    }
    # show current weights 
    output$table <- renderTable(data.frame(
                        variable = names(descriptive_data),
                        weightages))

  })

}

shinyApp(ui = ui , server = server)