Question

我有一个Shiny应用程序，一旦我更改了selectInput值，我的动态生成的UI就无法正常显示。

在这里，您可以在两个数据框之间进行选择。单击该按钮时，它会生成一个selectInput（其值为数据框的列名）和checkboxInput UI（您选择的列的唯一值）。这很好，但是一旦我更改了我想要查看的数据框，selectInput值就会“相应地”填充新数据框的列名。但是，不再显示checkboxInput。

ui <- fluidPage(
  fluidRow(
    column(4, 
           uiOutput("projectSelection"),
           uiOutput("addCol")
    )
  ),
  fluidRow(
    tags$div(id="rowLabel")
  )
)

server <- function(input, output, session) {
  Project.ID <- c("Test Project 1", "Test Project 1", "Test Project 1", "Test Project 1")
  Project.ID2 <- c("Test Project 2", "Test Project 2", "Test Project 2", "Test Project 2")
  Author.ID <- c("1234", "5234", "3253", "5325")
  Fav.Color <- c("Blue", "Red", "Blue", "Green")
  Author.Name <- c("Bob", "Jenny", "Bob", "Alice")

  output$projectSelection <- renderUI(
    selectInput("projectSelection",
                "Project Name:",
                c("Project1", "Project2"),
                selectize=TRUE)
  )

  # update datatable
  project <- reactive({
    if(input$projectSelection == "Project1"){
      projectDT <- data.frame(Project.ID, Author.ID, Author.Name)
    }
    if(input$projectSelection == "Project2"){
      projectDT <- data.frame(Project.ID2, Author.Name, Fav.Color)
    }
    return(projectDT)
  })


  #Button to add comparison column
  output$addCol <- renderUI({
    input$projectSelection #re-render once projectSelection changes?
    if(is.null(input$projectSelection)) return() 
    actionButton('addCol', strong("Add UI"), icon=icon("plus", class=NULL, lib="font-awesome"))
  })

  observeEvent({input$addCol},{
    insertUI(
      selector = "#rowLabel", 
      where = "beforeEnd", 
      ui = div(              
        fluidRow( 
             column(4, 
                    uiOutput(paste0("showMeta",input$addCol)),
                    uiOutput(paste0("showVal",input$addCol)),
                    br()
          )
        )
      )
    )
  })

  #Output creations
  lapply(1:10, function(idx){
    #comparison dropdowns
    output[[paste0("showMeta",idx)]] <- renderUI({
      input$projectSelection
      selectInput(inputId =  paste0("metalab",idx),
                  label =  "Column Label:",
                  choices =  c(unique(as.vector(colnames(project())))),
                  selectize = TRUE,
                  selected = input[[paste0("metalab",idx)]]
      )
    })
    output[[paste0("showVal",idx)]] <- renderUI({
      req(input$addCol >= idx)
      input$projectSelection
      if(!is.null(input[[paste0("metalab", idx)]])){
        checkboxGroupInput(paste0("metaval",idx),
                           "Column Value:",
                           choices = unique(as.vector(unlist(project()[[input[[paste0("metalab",idx)]]]]))),
                           selected = input[[paste0("metaval",idx)]]
        )

      }
    })
  })

  # observe({input$projectSelection},
  #         {
  #           lapply(1:10, function(idx){
  #             updateSelectInput(session, paste0("metalab",idx),
  #                               label =  "Column Label:",
  #                               choices =  c(unique(as.vector(colnames(project()))))
  #             )
  #           })
  #         })
}

shinyApp(ui=ui, server = server)

我不确定沿线某处是否存在引用问题，但我希望checkboxInput UI显示适当的值（对于选定的列）。我曾经考虑过在input$projectSelection更改后尝试重新渲染，但似乎没有做任何事情。我还尝试为它添加observe，以便在input$projectSelection更改时动态生成的UI更新，但我也没有成功。

我会感激任何帮助！谢谢！

Answer 1

只有在单击“添加”按钮时，才会更新您的复选框。

我已根据列名的selectinput更改了代码以生成动态复选框，我相信功能保持不变

{{1}}

R Shiny - 使用selectInput

1 个答案: