Shiny + DT: как сделать datatable реактивным?

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

Как вы можете видеть в закладке 'Test', выбор радиокнопку обновляется при изменении. Однако я не могу понять, как это должно быть интегрировано в функции 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()) 
    }) 
}