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

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

正如您在“测试标签”中看到的那样，radiobutton选择会在更改时更新。但是我无法理解这应该如何集成在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'))
              )
      )
    )
)

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

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

1 个答案: