绑定/解除绑定DataTable时的反应性问题 [英] Trouble with reactivity when binding/unbinding DataTable

问题描述

我有一个带有两个选项卡的闪亮应用程序，每个选项卡都有一个带有numericInputs的DataTable，因此我必须绑定和取消绑定DataTable才能使numericInputs正常工作。不幸的是，这造成了反应性问题，我希望有人可以提供帮助。在下面的示例中，如果更改确定表中数据的侧边栏上的输入，则只有打开选项卡中的表才会实际更新/反应。

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.

编辑：现在，我年纪大了并且很聪明，我永远不会以这种方式将HTML添加到DataTable中。编写一个在客户端写HTML的JS回调函数更有意义。

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.

推荐答案

在下面的更新后的代码中起作用

所有的功劳都归给tomasreigl，我从他在这里打开的问题中获取了一些代码 https://github.com/rstudio/shiny/issues/1246

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

        }
) 

这篇关于绑定/解除绑定DataTable时的反应性问题的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！