Question

我想要一个ui动态更新的闪亮应用程序。例如，我的数据集如下：

lookup_table = structure(list(var = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 
                                                1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
                                                3L), .Label = c("var1", "var2", "var3"), class = "factor"), sub_var = structure(c(1L, 
                                                                                                                                  1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 4L, 4L, 4L, 4L, 5L, 5L, 6L, 
                                                                                                                                  6L, 7L, 7L, 7L, 8L, 8L, 8L), .Label = c("var11", "var12", "var13", 
                                                                                                                                                                          "var21", "var22", "var31", "var32", "var33"), class = "factor")), class = "data.frame", row.names = c(NA, 
                                                                                                                                                                                                                                                                                -24L))

在ui函数中，我希望selectInput函数与'length（unique（lookup_table $ var））'一样多。

，这些下拉菜单的选择为unique(lookup_table$var)。第二组下拉菜单应根据第一组下拉菜单中的用户选择从lookup_table$sub_var获取其值。

我的示例应用程序如下所示，但是第二组下拉列表没有更新！

    library(shiny)

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

)

server <- function(input , output){

  descriptive_data <- data.frame(unique(lookup_table$var))

  turb = as.character(unique(lookup_table[,1]))


  output$input_value <- renderUI({
    var_name <- as.character(unique(lookup_table$var))
    if (!is.null(var_name)) {
      # lapply will return a list
      lapply(1:length(var_name), function(k) { 
        selectInput(paste0("var", k), 
                     'first selection ',turb )
      })
    }
  })

  main2 <- reactive({
    var_name <- as.character(unique(lookup_table$var))
    sub_var=lapply(1:length(var_name), function(k) { 
      as.character(unique(filter(lookup_table,var == paste0("input$var",k))[,2]))
    })

    result = list(sub_var = sub_var)
    return(result)

  })

  output$doc_name <- renderUI({
    var_name <- as.character(unique(lookup_table$var))
    if (!is.null(var_name)) {
      # lapply will return a list
      lapply(1:length(var_name), function(k) { 
        selectInput(paste0("doc", k), 
                   'sub_var', main2()$sub_var[[k]] )
      })
    }
  })  


}

shinyApp(ui = ui , server = server)

我不知道我在这里想念的是什么！

动态selectInput闪亮

0 个答案: