Trouble with reactivity when binding/unbinding DataTable - r

Question

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.

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