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

时间:2017-07-12 17:16:39

标签: r shiny

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

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

我可以使用checkbox选项而不是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'),

server.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的新手,因此我愿意接受关于我做错了什么以及如何实现这一点的建议。

1 个答案:

答案 0 :(得分: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)