バインディング/バインド解除時の反応の問題

Question

私は2つのタブを持つ光沢のあるアプリケーションを持っています。それぞれにnumericInputsを持つDataTableがあるので、numericInputsを動作させるためにDataTableをバインドしてアンバインドする必要があります。残念ながら、これは私が誰かを助けてくれることを望んでいる反応性の問題を作り出しました。下の例では、テーブルのデータを決定するサイドバーの入力を変更すると、開いているタブのテーブルのみが実際に更新/反応します。

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

閉じたタブの表は非表示になっていますが、隠されていないように機能するようにオプションが設定されています。どんな指導も高く評価されます。

編集：私は年をとっているので、私はこの方法でHTMLをDataTableに追加しません。クライアント側にHTMLを書き込むJSコールバック関数を書く方が意味があります。

Answer 1

以下は、動作する更新されたコードです。
すべてのクレジットがtomasreiglに行く、私は彼があなたがセッションの$ sendCustomMessage（ 'アンバインド-DT'、 'X1'） `+` in`エラーを持ってここに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());}'))) 

     } 
)