Why is reactivity with rhandsontable not working when crossing tab panels? - r

Question

I'm running two expandable rhandsontables who should always have the same number of columns and the same column headers, though the rows differ. One of the tables (myDF1 rendered in "hottable1") is the master where the user adds/deletes columns from the tabPanel() housing that table and the second table (myDF2 rendered in "hottable2") parrots the first table in terms of number of columns and column headers but is placed in a separate tabPanel() reacting to the action buttons in the first tabPanel(). The strange thing is, this linked column addition/deletion works fine when the two tables are rendered in Shiny's fluidPage() or when using Shiny's pageWithSidebar() the two tables are housed in the same tabPanel(). However, when the two tables are in separate tabPanels() (as shown in the code below), column addition works fine but the second table in tab "Slave" crashes when deleting columns from tab "Master".
I must be missing something very basic about tabPanels(). What am I doing wrong?
I've always assumed reactivity cuts across tabPanels().
Code:
library(dplyr)
library(rhandsontable)
library(shiny)
myDF1 <- data.frame('Series 1' = c(1,24,0), check.names = FALSE)
rownames(myDF1) <- c('Term A','Term B','Term C')
myDF2 <- data.frame('Series 1' = c(20,15), check.names = FALSE)
rownames(myDF2) <- c('Boy','Girl')
ui <- pageWithSidebar(
headerPanel(""),sidebarPanel(""),
mainPanel(
tabsetPanel(
tabPanel("Master table", hr(),
rHandsontableOutput('hottable1'),br(),
actionButton("addSeries", "Add", width = 80),
fluidRow(
column(2,actionButton("delSeries","Delete", width = 80)),
column(3,uiOutput("delSeries2"))
),
),
tabPanel("Slave table", hr(),rHandsontableOutput('hottable2'))
)
)
)
server <- function(input, output) {
emptyTbl1 <- reactiveVal(myDF1)
emptyTbl2 <- reactiveVal(myDF2)
observeEvent(input$hottable1, {emptyTbl1(hot_to_r(input$hottable1))})
observeEvent(input$hottable2, {emptyTbl2(hot_to_r(input$hottable2))})
output$hottable1 <- renderRHandsontable({
rhandsontable(emptyTbl1(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
output$hottable2 <- renderRHandsontable({
rhandsontable(emptyTbl2(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE)
})
observeEvent(input$addSeries, {
newCol1 <- data.frame(c(1,24,0))
newCol2 <- data.frame(c(20,15))
names(newCol1) <- paste("Series", ncol(hot_to_r(input$hottable1)) + 1)
names(newCol2) <- paste("Series", ncol(hot_to_r(input$hottable2)) + 1)
emptyTbl1(cbind(emptyTbl1(), newCol1))
emptyTbl2(cbind(emptyTbl2(), newCol2))
})
observeEvent(input$delSeries3, {
tmp1 <- emptyTbl1()
tmp2 <- emptyTbl2()
if(ncol(tmp1) > 1){
delCol <- input$delSeries3
tmp1 <- tmp1[ , !(names(tmp1) %in% delCol), drop = FALSE]
tmp2 <- tmp2[ , !(names(tmp2) %in% delCol), drop = FALSE]
newNames <- sprintf("Series %d",seq(1:ncol(tmp1)))
names(tmp1) <- newNames
names(tmp2) <- newNames
emptyTbl1(tmp1)
emptyTbl2(tmp2)
}
})
output$delSeries2 <-
renderUI(
selectInput("delSeries3",
label = NULL,
choices = colnames(hot_to_r(input$hottable1)),
selected = "", width = '100px',
multiple = TRUE)
)
}
shinyApp(ui,server)

Answer 1

The below "resolved code" resolves the issue. The few changes from OP code are commented below and are summarized as follows:
Insert outputOptions(output, 'hottable2', suspendWhenHidden = FALSE) in the server() section in order to update the 2nd table located in a separate tab panel from the action buttons driving that table from another tab panel; allows reactivity to instantly cross tab panels that aren't being viewed
Even with the above fix, the "hottable2" table had to be clicked on in order to completely render it. R whiz Stéphane Laurent pointed out that there's a known bug in Shiny when re-rendering this way, his html solution is accordingly included and commented in the revised code below for the rhandsontable() function used for "hottable2" in the server() section
Resolved code:
library(dplyr)
library(rhandsontable)
library(shiny)
myDF1 <- data.frame('Series 1' = c(1,24,0), check.names = FALSE)
rownames(myDF1) <- c('Term A','Term B','Term C')
myDF2 <- data.frame('Series 1' = c(20,15), check.names = FALSE)
rownames(myDF2) <- c('Boy','Girl')
ui <- pageWithSidebar(
headerPanel(""),sidebarPanel(""),
mainPanel(
tabsetPanel(
tabPanel("Master table", hr(),
rHandsontableOutput('hottable1'),br(),
actionButton("addSeries", "Add", width = 80),
fluidRow(
column(2,actionButton("delSeries","Delete", width = 80)),
column(3,uiOutput("delSeries2"))
),
),
tabPanel("Slave table", hr(),rHandsontableOutput('hottable2'))
)
)
)
server <- function(input, output) {
emptyTbl1 <- reactiveVal(myDF1)
emptyTbl2 <- reactiveVal(myDF2)
observeEvent(input$hottable1, {emptyTbl1(hot_to_r(input$hottable1))})
observeEvent(input$hottable2, {emptyTbl2(hot_to_r(input$hottable2))})
output$hottable1 <- renderRHandsontable({
rhandsontable(emptyTbl1(),rowHeaderWidth = 100, useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
hot_cols(colWidths = 80)
})
output$hottable2 <- renderRHandsontable({
rhandsontable(emptyTbl2(),rowHeaderWidth = 100, width = 800, height = 450,useTypes = TRUE)%>%
hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) %>%
hot_cols(colWidths = 80) %>%
# next section of html addresses issue of correcltly rendering the slave table:
htmlwidgets::onRender(
"function(el, x){
var hot = this.hot;
$('a[data-value=\"Slave table\"').on('click', function(){
setTimeout(function(){ hot.render(); }, 200);
});
}"
)
})
observeEvent(input$addSeries, {
newCol1 <- data.frame(c(1,24,0))
newCol2 <- data.frame(c(20,15))
names(newCol1) <- paste("Series", ncol(hot_to_r(input$hottable1)) + 1)
names(newCol2) <- paste("Series", ncol(hot_to_r(input$hottable2)) + 1)
emptyTbl1(cbind(emptyTbl1(), newCol1))
emptyTbl2(cbind(emptyTbl2(), newCol2))
})
observeEvent(input$delSeries3, {
tmp1 <- emptyTbl1()
tmp2 <- emptyTbl2()
if(ncol(tmp1) > 1){
delCol <- input$delSeries3
tmp1 <- tmp1[ , !(names(tmp1) %in% delCol), drop = FALSE]
tmp2 <- tmp2[ , !(names(tmp2) %in% delCol), drop = FALSE]
newNames <- sprintf("Series %d",seq(1:ncol(tmp1)))
names(tmp1) <- newNames
names(tmp2) <- newNames
emptyTbl1(tmp1)
emptyTbl2(tmp2)
}
})
output$delSeries2 <-
renderUI(
selectInput("delSeries3",
label = NULL,
choices = colnames(hot_to_r(input$hottable1)),
selected = "", width = '100px',
multiple = TRUE)
)
outputOptions(output, 'hottable2', suspendWhenHidden = FALSE) # this updates slave panel even when hidden
}
shinyApp(ui,server)