shiny conditionalPanel update problem with output.table-condition - r

Question

I am trying to build an app that displays tables for different years. In some years some tables do not exist. I solved this with conditionalPanel and the condition that the tables exist. This works at first. The problem is that it doesn't work once a table is retrieved that doesn't exist. You can try this on this test page (http://46.231.205.192/Tests/). After opening the app, one table per year is visible. If you go to the next table with >, the error message for 2021 is correctly displayed at the bottom. If you then go back <, the error continues to be displayed, although the table for 2021 exists in that case.
I think the problem arises from conditionalPanel with output.Table_2021 but I can't fix it.
Can you see a solution?
library(shiny)
library(DT)
Table_1 <- data.frame(Antworten = "mean", Total = 3, US = 3.5, FR = 4, IT = 2, male = 0, female = 1)
Table_2 <- data.frame(Antworten = "mean", Total = 2, US = 2.5, FR = 3, IT = 1, male = 1, female = 2)
Table_1_2021 <- data.frame(Antworten = "mean", Total = 4, US = 4.5, FR = 5, IT = 3, male = 3, female = 10)
# in 2021 the Table_2 is missing
tabnames <- c("Table_1", "Table_2")
# Columns
kopfvariablen <- c("region", "sex")
default_vars <- c("region")
# Shiny ----
ui <- fluidPage(
titlePanel(title=div("Tables")),
sidebarLayout(
sidebarPanel(width = 2, tags$style(".well {background-color: #ffffff; border-color: #ffffff}"),
a(br(), br(), br(), br()),
checkboxInput(
inputId = "year_2022",
label = "Tabs: 2022",
value = TRUE),
checkboxInput(
inputId = "year_2021",
label = "Tabs: 2021",
value = TRUE)
),
mainPanel(
align = "center",
actionButton("prevBin", "<", class="btn btn-success"),
actionButton("nextBin", ">", class="btn btn-success"),
selectInput(
inputId = "dataset",
label = "",
choices = tabnames,
width = "60%"),
conditionalPanel(
condition = "input.year_2022 == 1 ",
DT::dataTableOutput("Table_2022")),
conditionalPanel(inline = T,
condition = "input.year_2021 == 1 && output.Table_2021", # I think the problem comes with this line.
DT::dataTableOutput('Table_2021')),
conditionalPanel(inline = T,
condition = "input.year_2021 == 1 && output.Table_2021 == null",
h4("[This Question was not asked in 2021.]", align = "left", style = "color:grey"))
)
))
server = function(input, output, session) {
# "next" and "previous" buttons
output$prevBin <- renderUI({
actionButton("prevBin",
label = "Previous")
})
output$nextBin <- renderUI({
actionButton("nextBin",
label = "Next")
})
observeEvent(input$prevBin, {
current <- which(tabnames == input$dataset)
if(current > 1){
updateSelectInput(session, "dataset",
choices = as.list(tabnames),
selected = tabnames[current - 1])
}
})
observeEvent(input$nextBin, {
current <- which(tabnames == input$dataset)
if(current < length(tabnames)){
updateSelectInput(session, "dataset",
choices = as.list(tabnames),
selected = tabnames[current + 1])
}
})
# Tables 2022 -----
output$Table_2022 <- DT::renderDataTable({
# Data with names from input
data <- get(input$dataset)
data_fin <- data[,1:7]
#subheader as list
subheader <- list()
subheader <- c(subheader, "US", "FR", "IT")
subheader <- c(subheader, "male", "female")
# The header
topheader_txt <- "tr(th(rowspan = 2, 'Values'), th(rowspan = 2, 'Total') , th(class = 'dt-center', colspan = 3, 'region'), th(class = 'dt-center', colspan = 2, 'sex')"
topheader <- parse(text=paste0(topheader_txt, ")"))
#Container for topheader and subheader
sketch = htmltools::withTags(table(
class = 'display',
thead(
eval(topheader),
tr(lapply(rep(subheader, 1), th))
)
)
)
# Table with container
DT::datatable(data_fin,
container = sketch,
rownames = F)
})
# Tables 2021 -----
output$Table_2021 <- DT::renderDataTable({
#Daten aus Auswahl
data <- get(paste0(input$dataset, "_2021"))
data_fin <- data[,1:7]
#subheader list
subheader <- list()
subheader <- c(subheader, "US", "FR", "IT")
subheader <- c(subheader, "male", "female")
topheader_txt <- "tr(th(rowspan = 2, 'Values'), th(rowspan = 2, 'Total') , th(class = 'dt-center', colspan = 3, 'region'), th(class = 'dt-center', colspan = 2, 'sex')"
topheader <- parse(text=paste0(topheader_txt, ")"))
#Container for topheader and subheader
sketch = htmltools::withTags(table(
class = 'display',
thead(
eval(topheader),
tr(lapply(rep(subheader, 1), th))
)
)
)
js <- c(
"function(settings){",
" var datatable = settings.oInstance.api();",
" var table = datatable.table().node();",
" var caption = '2021'",
" $(table).append('<caption style=\"caption-side: top-right; text-align: center; margin: 8px 0; font-size: 2em\">' + caption + '</caption>');",
"}"
)
# Table with container
DT::datatable(data_fin,
container = sketch,
rownames = F,
caption = tags$caption(
style="caption-side: bottom; text-align: left; margin: 8px 0;"
),
extensions = c('Buttons'),
options = list(initComplete = JS(js))
)
})
}
shinyApp(ui, server)

Answer 1

The solution comes with: outputOptions(output, "Table_2021", suspendWhenHidden = FALSE) in the server function.
library(shiny)
library(DT)
Table_1 <- data.frame(Antworten = "mean", Total = 3, US = 3.5, FR = 4, IT = 2, male = 0, female = 1)
Table_2 <- data.frame(Antworten = "mean", Total = 2, US = 2.5, FR = 3, IT = 1, male = 1, female = 2)
Table_1_2021 <- data.frame(Antworten = "mean", Total = 4, US = 4.5, FR = 5, IT = 3, male = 3, female = 10)
# in 2021 the Table_2 is missing
tabnames <- c("Table_1", "Table_2")
# Columns
kopfvariablen <- c("region", "sex")
default_vars <- c("region")
# Shiny ----
ui <- fluidPage(
titlePanel(title=div("Tables")),
sidebarLayout(
sidebarPanel(width = 2, tags$style(".well {background-color: #ffffff; border-color: #ffffff}"),
a(br(), br(), br(), br()),
checkboxInput(
inputId = "year_2022",
label = "Tabs: 2022",
value = TRUE),
checkboxInput(
inputId = "year_2021",
label = "Tabs: 2021",
value = TRUE)
),
mainPanel(
align = "center",
actionButton("prevBin", "<", class="btn btn-success"),
actionButton("nextBin", ">", class="btn btn-success"),
selectInput(
inputId = "dataset",
label = "",
choices = tabnames,
width = "60%"),
conditionalPanel(
condition = "input.year_2022 == 1 ",
DT::dataTableOutput("Table_2022")),
conditionalPanel(inline = T,
condition = "input.year_2021 == 1 && output.Table_2021", # I think the problem comes with this line.
DT::dataTableOutput('Table_2021')),
conditionalPanel(inline = T,
condition = "input.year_2021 == 1 && output.Table_2021 == null",
h4("[This Question was not asked in 2021.]", align = "left", style = "color:grey"))
)
))
server = function(input, output, session) {
outputOptions(output, "Table_2021", suspendWhenHidden = FALSE) # Solution
# "next" and "previous" buttons
output$prevBin <- renderUI({
actionButton("prevBin",
label = "Previous")
})
output$nextBin <- renderUI({
actionButton("nextBin",
label = "Next")
})
observeEvent(input$prevBin, {
current <- which(tabnames == input$dataset)
if(current > 1){
updateSelectInput(session, "dataset",
choices = as.list(tabnames),
selected = tabnames[current - 1])
}
})
observeEvent(input$nextBin, {
current <- which(tabnames == input$dataset)
if(current < length(tabnames)){
updateSelectInput(session, "dataset",
choices = as.list(tabnames),
selected = tabnames[current + 1])
}
})
# Tables 2022 -----
output$Table_2022 <- DT::renderDataTable({
# Data with names from input
data <- get(input$dataset)
data_fin <- data[,1:7]
#subheader as list
subheader <- list()
subheader <- c(subheader, "US", "FR", "IT")
subheader <- c(subheader, "male", "female")
# The header
topheader_txt <- "tr(th(rowspan = 2, 'Values'), th(rowspan = 2, 'Total') , th(class = 'dt-center', colspan = 3, 'region'), th(class = 'dt-center', colspan = 2, 'sex')"
topheader <- parse(text=paste0(topheader_txt, ")"))
#Container for topheader and subheader
sketch = htmltools::withTags(table(
class = 'display',
thead(
eval(topheader),
tr(lapply(rep(subheader, 1), th))
)
)
)
# Table with container
DT::datatable(data_fin,
container = sketch,
rownames = F)
})
# Tables 2021 -----
output$Table_2021 <- DT::renderDataTable({
#Daten aus Auswahl
data <- get(paste0(input$dataset, "_2021"))
data_fin <- data[,1:7]
#subheader list
subheader <- list()
subheader <- c(subheader, "US", "FR", "IT")
subheader <- c(subheader, "male", "female")
topheader_txt <- "tr(th(rowspan = 2, 'Values'), th(rowspan = 2, 'Total') , th(class = 'dt-center', colspan = 3, 'region'), th(class = 'dt-center', colspan = 2, 'sex')"
topheader <- parse(text=paste0(topheader_txt, ")"))
#Container for topheader and subheader
sketch = htmltools::withTags(table(
class = 'display',
thead(
eval(topheader),
tr(lapply(rep(subheader, 1), th))
)
)
)
js <- c(
"function(settings){",
" var datatable = settings.oInstance.api();",
" var table = datatable.table().node();",
" var caption = '2021'",
" $(table).append('<caption style=\"caption-side: top-right; text-align: center; margin: 8px 0; font-size: 2em\">' + caption + '</caption>');",
"}"
)
# Table with container
DT::datatable(data_fin,
container = sketch,
rownames = F,
caption = tags$caption(
style="caption-side: bottom; text-align: left; margin: 8px 0;"
),
extensions = c('Buttons'),
options = list(initComplete = JS(js))
)
})
}
shinyApp(ui, server)