Динамический selectInput в блестящий - PullRequest
Новая
       31

Динамический selectInput в блестящий

0 голосов
/ 13 сентября 2018

Я хочу иметь блестящее приложение, которое 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)

Я не знаю, что мне здесь не хватает!

...