Shiny + DT：如何使数据表反应？

Question

我在尝试在闪亮的应用程序（来自 DT 包）中使数据表反应时遇到问题。这是我的可重现示例：

ui.r

dashboardPage(

  dashboardHeader(title = "TEST reactive DT"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("See data", tabName = "db"),
      menuItem("Test", tabName = "test")),
      radioButtons("rb1", label = "Select data", 
                 choices = list("IRIS" = "iris", "CARS" = "cars"),
                 selected = "iris")
    ),

  dashboardBody(
    tabItems(
      tabItem(tabName = "db",
              h4("Show selected dataset"),
              fluidRow(DT::dataTableOutput('tbl')) #THIS DOES NOT WORK (NOT REACTIVE)
              ),
      tabItem(tabName = "test",
              h4("Test tab"),
              fluidRow(column(3, verbatimTextOutput("value"))) #THIS WORKS
              )
      )
    )
)  

服务器.r

library(shiny)
library(shinydashboard)

server <- function(input, output, session) {

  output$value <- renderPrint({ input$rb1 })

  data <- reactive({
    switch(input$rb1,
           "iris" = iris,
           cars)
  })

  action <- dataTableAjax(session, cars)  # HOW SHOULD I SPECIFY? data() INSTEAD OF cars DOES NOT WORK
  widget <- datatable(cars,  # HOW SHOULD I SPECIFY? data() INSTEAD OF cars DOES NOT WORK
                     class = 'display cell-border compact',
                     filter = 'top',
                     server = TRUE,
                     options = list(ajax = list(url = action))
  )

  output$tbl <- DT::renderDataTable(widget)
}

正如您在“测试选项卡”中看到的那样，单选按钮选择会在更改时更新。但是我不明白这应该如何集成到 dataTableAjax 和 dataTable 函数中，你能解释/帮我解决这个问题吗？

非常感谢您的帮助！

最好的问候

Answer 1

找到解决方案：

ui.R

## ui.R ##

dashboardPage(

  dashboardHeader(title = "TEST reactive DT"),

  dashboardSidebar(
    sidebarMenu(
      menuItem("See data", tabName = "db")
      ),
      radioButtons("rb1", label = "Select data", 
                 choices = list("IRIS" = "iris", "CARS" = "cars"),
                 selected = "iris")
    ),

  dashboardBody(
    tabItems(
      tabItem(tabName = "db",
              h4("Show selected dataset"),
              fluidRow(DT::dataTableOutput('tbl2'))
              )
      )
    )
)  

服务器.R

## server.R ##
library(shiny)
library(shinydashboard)

server <- function(input, output, session) {

  output$value <- renderPrint({ input$rb1 })

  data <- reactive({
    switch(input$rb1,
           "iris" = iris,
           cars)
  })

  action <- dataTableAjax(session, cars)
  widget <- datatable(cars, 
                     class = 'display cell-border compact',
                     filter = 'top',
                     server = TRUE,
                     options = list(ajax = list(url = action))
  )

  output$tbl2 <- DT::renderDataTable({
           DT::datatable(data())
  })
}