R shiny DT checkboxes in multiple tabs

问题

I am working on a task similar to those described in RStudio Shiny list from checking rows in dataTables and Shiny - checkbox in table in shiny - embedding checkboxes within a DT table.

My application is a little more complicated though - there are multiple tabs, the table can be filtered, and the content depends on reactive values elsewhere. I have been able to get the checkboxes working with a little JS, but have found if I have another DT table in another tab, the target table does not render at all.

A minimum example is given below, and if I comment out mytable1 in the tab1UI, everything in tab2 works - the tables on tab2 are rendered, checkboxes output a value, and mytable2 can be filtered by the values input. With the tab1 table present only the tab2 headers are rendered, no tables. Also, placing tab2 before tab1 renders the tab2 table as normal. Neither of these workarounds is a valid option though - anybody know what the problem could be? Most likely the problem would be the javascript snippets is my guess, but not sure how to fix it.

# Import required modules.
library(shiny)
library(shinyjs)
library(DT)

# Tab 1 UI code.
tab1UI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "Tab 1",
    fluidRow(
      DT::dataTableOutput(ns('mytable1'))
    )
  )
}

# Tab 2 UI code.
tab2UI <- function(id) {
  ns <- NS(id)
  tabPanel(
    "Tab 2",
    fluidRow(
      uiOutput(ns('cars')),
      h2('The mtcars data'),
      DT::dataTableOutput(ns('mytable2')),
      h2("Selected"),
      tableOutput(ns("checked"))
    )
  )
}

# Tab 1 server code.
tab1Server <- function(input, output, session) {
  ns <- session$ns
  output$mytable1 <- DT::renderDataTable(
    datatable(data.frame(a=c(1, 2), b=c(3, 4)))
  )
}

# Tab 2 server code.
tab2Server <- function(input, output, session) {
  ns <- session$ns

  # Helper function for making checkboxes.
  shinyInput = function(FUN, len, id, ...) {
    inputs = character(len)
    for (i in seq_len(len)) {
      inputs[i] = as.character(FUN(ns(paste0(id, i)), label = NULL, ...))
    }
    inputs
  }

  output$cars <- renderUI({
    selectInput(
      ns("cars"),
      "",
      choices=row.names(mtcars),
      multiple = TRUE,
      selected=row.names(mtcars)
    )
  })

  # Update table records with selection.
  subsetData <- reactive({
    runjs("Shiny.unbindAll($('#tab2-mytable2').find('table').DataTable().table().node());")
    cars <- req(input$cars)
    sel <- mtcars[row.names(mtcars) %in% cars,]
    data.frame(sel, Favorite=shinyInput(checkboxInput,nrow(sel), "cbox_", width = 10))
  })

  # Datatable with checkboxes.
  output$mytable2 <- DT::renderDataTable(
    datatable(
      subsetData(),
      escape = FALSE,
      options = list(
        paging = FALSE,
        server = FALSE,
        preDrawCallback = JS('function() {Shiny.unbindAll(this.api().table().node()); }'),
        drawCallback = JS('function() {Shiny.bindAll(this.api().table().node()); }')
      )
    )
  )

  # Helper function for reading checkbox.
  shinyValue = function(id, len) {
    values <- unlist(lapply(seq_len(len), function(i) {
      value = input[[paste0(id, i)]]
      if (is.null(value)) NA else value
    }))
    return(values)
  }

  # Output read checkboxes.
  observe({
    len <- length(input$cars)
    output$checked <- renderTable({
      data.frame(selected=shinyValue("cbox_", len))
    })
  })
}

# Define UI for application.
ui <- fluidPage(
  useShinyjs(),
  navbarPage(
    'Title',
    tab1UI("tab1"),
    tab2UI("tab2")
  )
)

# Define server.
server <- function(input, output, session) {

  # Call tab1 server code.
  callModule(tab1Server, "tab1")

  # Call tab2 server code.
  callModule(tab2Server, "tab2")
}

# Run the application
shinyApp(ui = ui, server = server)

来源：https://stackoverflow.com/questions/55715574/r-shiny-dt-checkboxes-in-multiple-tabs

标签

javascript

Shiny