闪亮的 + DT：如何使数据表具有响应性？

Question

我是一名有用的助手，可以为您进行文本翻译。

我在尝试使用DT包中的shiny应用程序内使datatable响应时遇到了问题。以下是我的可重现示例： 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
              )
      )
    )
)  

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)  # 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函数中，请问您能否解释一下并帮助我解决这个问题？

非常感谢您的帮助！

最好的祝福

- cho7tom

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'))
              )
      )
    )
)  

server.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())
  })
}

- cho7tom

---

action 仅与 cars 数据相关联 - 您需要使其对 input$rb1 也具有响应性，因此您必须将所有内容放在 renderDataTable() 中。 - Yihui Xie