Проблемы с реактивностью при привязке / отвязке DataTable

У меня есть блестящее приложение с двумя вкладками, каждая с DataTable, у которых есть numericInputs, поэтому мне нужно привязать и отвязать DataTable для работы numericInputs. К сожалению, это создало проблемы с реактивностью, и я надеюсь, что кто-то может помочь с ними. В приведенном ниже примере, если вы измените ввод на боковой панели, которая определяет данные в таблицах, только таблица на открытой вкладке будет фактически обновляться / реагировать.

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 таким образом. Имеет смысл написать функцию обратного вызова JS, которая записывает HTML на стороне клиента.


person Carl    schedule 01.06.2016    source источник
comment
У вас есть ошибка в сеансе $ sendCustomMessage ('unbind-DT', 'x1') `+ Shiny.unbindAll( см. Проверить   -  person Batanichek    schedule 01.06.2016
comment
Я считаю, что ошибка javascript существует, потому что, когда страница сначала загружается, она загружает данные до того, как рисует данные, поэтому при первой отправке сообщения в пользовательский интерфейс таблицы нет, но я не верю, что эта ошибка связана к моей проблеме   -  person Carl    schedule 02.06.2016
comment
Вам нужно просто сбросить ввод ДТ?   -  person Batanichek    schedule 02.06.2016


Ответы (1)


Вот ваш обновленный код, который работает.
Все заслуги Tomasreigl, я взял код из проблемы, которую он открыл здесь 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());}')))

        }
) 
person qfazille    schedule 12.12.2017