Probleme mit der Reaktivität beim Binden/Trennen DataTable

Question

Ich habe eine glänzende App mit zwei Registerkarten, jede mit einer DataTable, die numericInputs haben, so dass ich die DataTable binden und lösen muss, damit die numerischenInputs funktionieren. Leider hat dies zu Reaktivitätsproblemen geführt, von denen ich hoffe, dass ihnen jemand helfen kann. Wenn Sie im folgenden Beispiel die Eingabe in der Seitenleiste ändern, die die Daten in den Tabellen bestimmt, wird nur die Tabelle in der geöffneten Registerkarte aktualisiert/reagiert.

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

Auch wenn die Tabelle in der geschlossenen Tab versteckt wird, werden die Optionen so eingestellt, dass er nach wie vor funktionieren soll, wie es nicht verborgen ist. Jede Anleitung würde geschätzt werden.

BEARBEITEN: Jetzt, wo ich älter und weiser bin, würde ich niemals HTML zu einer DataTable auf diese Weise hinzufügen. Sinnvoller ist es, eine JS-Callback-Funktion zu schreiben, die den HTML-Code auf der Client-Seite schreibt.

Answer 1

Hier unter Ihrem aktualisierten Code, der funktioniert.
Alle Kredit tomasreigl geht, habe ich einige Code aus der Ausgabe er https://github.com/rstudio/shiny/issues/1246 hier eröffnet

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

     } 
)