Trouble with reactivity when binding/unbinding DataTable

问题

I have a shiny app with two tabs, each with a DataTable that have numericInputs so I have to bind and unbind the DataTable for the numericInputs to work. Unfortunately this has created reactivity problems that I am hoping someone can help with. In the example below, if you change the input on the sidebar that determines the data in the tables, only the table in the open tab will actually update/react.

library(shiny) 
library(DT) 
shinyApp( 
  ui = fluidPage(
    sidebarPanel(
      # choose dataset
      selectInput("select","Choose dataset",c("mtcars","iris"))),
    # display table
    mainPanel(
      tabsetPanel(tabPanel("one",DT::dataTableOutput('x1')),
                  tabPanel("two",DT::dataTableOutput('x2'))),
      tags$script(HTML("Shiny.addCustomMessageHandler('unbind-DT', function(id) {
                       Shiny.unbindAll($('#'+id).find('table').DataTable().table().node());
                       })")))), 

  server = function(session, input, output) { 
    # function for dynamic inputs in DT
    shinyInput <- function(FUN,id,num,...) {
      inputs <- character(num)
      for (i in seq_len(num)) {
        inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
      }
      inputs
    }
    # function to read DT inputs
    shinyValue <- function(id,num) {
      unlist(lapply(seq_len(num),function(i) {
        value <- input[[paste0(id,i)]]
        if (is.null(value)) NA else value
      }))
    }
    # reactive dataset
    data <- reactive({
      req(input$select)
      session$sendCustomMessage('unbind-DT', 'x1')
      get(input$select)[1:5,1:3]
    })
    data2 <- reactive({
      req(input$select)
      session$sendCustomMessage('unbind-DT', 'x2')
      get(input$select)[5:10,1:3]      
    })
    # render datatable with inputs
    output$x1 <- DT::renderDataTable({
      data.frame(data(),ENTER = shinyInput(numericInput,"numin",nrow(data()),value=NULL))
    },
    server=FALSE,escape=FALSE,selection='none',
    options=list(language = list(search = 'Filter:'),
                 preDrawCallback=JS(
      'function() {
      Shiny.unbindAll(this.api().table().node());}'),
      drawCallback= JS(
        'function(settings) {
        Shiny.bindAll(this.api().table().node());}')))

    output$x2 <- DT::renderDataTable({
      data.frame(data2(),
                 ENTER = shinyInput(numericInput,"numin2",nrow(data2()),value=NULL))
    },
    server=FALSE,escape=FALSE,selection='none',
    options=list(language = list(search = 'Filter:'),
                 preDrawCallback=JS(
      'function() {
      Shiny.unbindAll(this.api().table().node());}'),
      drawCallback= JS(
        'function(settings) {
        Shiny.bindAll(this.api().table().node());}')))

    outputOptions(output, "x1", suspendWhenHidden = FALSE)
    outputOptions(output, "x2", suspendWhenHidden = FALSE)
  }
      ) 

Even though the table in the closed tab is hidden, the options are set so that it should still function like it isn't hidden. Any guidance would be appreciated.

EDIT: Now that I am older and wiser I would never add HTML to a DataTable this way. Makes more sense to write a JS callback function that writes the HTML on the client side.

回答1:

Here below your updated code that works.
All credit goes to tomasreigl, I took some code from the issue he opened here https://github.com/rstudio/shiny/issues/1246

library(shiny) 
library(DT) 
shinyApp( 
    ui = fluidPage(
        sidebarPanel(
            # choose dataset
            selectInput("select","Choose dataset",c("mtcars","iris"))),
        # display table
        mainPanel(
            tabsetPanel(tabPanel("one",DT::dataTableOutput('x1')),
                        tabPanel("two",DT::dataTableOutput('x2'))),
            tags$head(
                tags$script('
                        Shiny.addCustomMessageHandler("unbinding_table_elements", function(x) {
                        Shiny.unbindAll($(document.getElementById(x)).find(".dataTable"));
                        });'
                )
            )
        )
    ), 

    server = function(session, input, output) { 
        # function for dynamic inputs in DT
        shinyInput <- function(FUN,id,num,...) {
            inputs <- character(num)
            for (i in seq_len(num)) {
                inputs[i] <- as.character(FUN(paste0(id,i),label=NULL,...))
            }
            inputs
        }
        # function to read DT inputs
        shinyValue <- function(id,num) {
            unlist(lapply(seq_len(num),function(i) {
                value <- input[[paste0(id,i)]]
                if (is.null(value)) NA else value
            }))
        }
        # reactive dataset
        data <- reactive({
            req(input$select)
            session$sendCustomMessage('unbinding_table_elements', 'x1')
            get(input$select)[1:5,1:3]
        })
        data2 <- reactive({
            req(input$select)
            session$sendCustomMessage('unbinding_table_elements', 'x2')
            get(input$select)[5:10,1:3]      
        })
        # render datatable with inputs
        output$x1 <- DT::renderDataTable({
            data.frame(data(),ENTER = shinyInput(numericInput,"numin",nrow(data()),value=NULL))
        },
        server=FALSE,escape=FALSE,selection='none',
        options=list(language = list(search = 'Filter:'),
                     preDrawCallback=JS(
                         'function() {
                         Shiny.unbindAll(this.api().table().node());}'),
                     drawCallback= JS(
                         'function(settings) {
                         Shiny.bindAll(this.api().table().node());}')))

        output$x2 <- DT::renderDataTable({
            data.frame(data2(),
                       ENTER = shinyInput(numericInput,"numin2",nrow(data2()),value=NULL))
        },
        server=FALSE,escape=FALSE,selection='none',
        options=list(language = list(search = 'Filter:'),
                     preDrawCallback=JS(
                         'function() {
                         Shiny.unbindAll(this.api().table().node());}'),
                     drawCallback= JS(
                         'function(settings) {
                         Shiny.bindAll(this.api().table().node());}')))

        }
) 

来源：https://stackoverflow.com/questions/37572035/trouble-with-reactivity-when-binding-unbinding-datatable