如何在R Shiny中使用renderUI触发renderDataTable进行输入？

Question

我正在开发一个简单的应用程序，使用R Shiny将数据库数据显示为数据表。

从数据库查询的数据可能会发生变化，因此我希望根据当前数据量身定制过滤输入选项，因此，我使用renderUI在服务器中生成UI。问题是来自renderUI的输入没有触发renderDataTable，因此在操作按钮触发renderDataTable之前它是空的。我想这样做，以便renderDataTable的输入触发renderDataTable。

作为一个例子，这是一个小应用程序，按我的意愿工作，但它的过滤输入是静态的，所以我不能使用它：

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      selectInput(
        "fish_taste", "Please select fish taste:",
        choices  = c("good", "bad"),
        selected = c("good", "bad"),
        multiple = TRUE
      ),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                    cost = c("$", "$$$", "$$", "$"),
                    taste = c("bad", "good", "good", "bad"))

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(filtered_fish())
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}

以下是编辑使用renderUI生成过滤选项的相同应用程序，请注意在按下提交之前如何生成数据表：

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("fish_taste"),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                    cost = c("$", "$$$", "$$", "$"),
                    taste = c("bad", "good", "good", "bad"))

  output$fish_taste = renderUI({
    fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
    fish_taste_choices_initial <- fish_taste_choices

    selectInput(
      "fish_taste", "Please select fish taste:",
      choices  = fish_taste_choices,
      selected = fish_taste_choices_initial,
      multiple = TRUE
    )
  })

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(filtered_fish())
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}

在提供动态过滤选项的同时，让第二个应用程序像第一个应用程序一样工作的最佳方法是什么？

Answer 1

只需通过filtered_fish_click初始化data

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      uiOutput("fish_taste"),
      actionButton("submit", "Submit")
    ),
    mainPanel(
      DT::dataTableOutput("dt")
    ))

)

server <- function(input, output) {

  data <- data.frame(fish = c("jellyfish", "tuna", "salmon", "magikarp"),
                     cost = c("$", "$$$", "$$", "$"),
                     taste = c("bad", "good", "good", "bad"))

  output$fish_taste = renderUI({
    fish_taste_choices <- sort(unique(data$taste), decreasing = TRUE)
    fish_taste_choices_initial <- fish_taste_choices

    selectInput(
      "fish_taste", "Please select fish taste:",
      choices  = fish_taste_choices,
      selected = fish_taste_choices_initial,
      multiple = TRUE
    )
  })

  filtered_fish <- reactive({
    data[ data$taste %in% input$fish_taste, ]
  })

  filtered_fish_click <- reactiveVal(
    value = isolate(data)
  )

  observeEvent(input$submit, {
    filtered_fish_click( filtered_fish() )
  })


  output$dt <- DT::renderDataTable({

    DT::datatable(
      filtered_fish_click(),
      rownames = FALSE,
      options = list(
        pageLength = 100,
        lengthChange = FALSE
      ) 
    )

  })

}
shinyApp(ui, server)