使用 Shiny 时自动更新 DT 有效，但在具有多个选项卡的闪亮仪表板中无效

Question

I designed a Shiny app with a DT that can detect if the input fields changes and automatically update the values. Below is a screen shot and my code. This app works as I expected. When running this app, values are updated accordingly in DT based on the input values.

# Load the packages
library(tidyverse)
library(shiny)
library(DT)

# Create an empty data frame
dat <- tibble(
  Input = c("SliderInput", "RadioButtons", "TextInput"),
  Value = NA_character_
)

ui <- fluidPage(
  
  titlePanel("DT: Document the Input Values"),
  
  sidebarLayout(
    sidebarPanel = sidebarPanel(
      # The input widgets
      sliderInput(inputId = "Slider", label = "The SliderInput", min = 1, max = 10, value = 5),
      br(),
      radioButtons(inputId = "Radio", label = "The RadioButtons", choices = c("A", "B", "C")),
      br(),
      textInput(inputId = "Text", label = "The TextInput", value = "Enter text ...")
    ),
    mainPanel = mainPanel(
      # The datatable
      DTOutput(outputId = "d1")
    )
  )
)

server <- function(input, output, session){
  
  # Save the dat to a reactive object
  dat_save <- reactiveValues(df = dat)
  
  output$d1 <- renderDT(dat, options = list(pageLength = 5), editable = TRUE, rownames = TRUE)
  
  # Save the condition of the data table d1
  d1_proxy <- dataTableProxy("d1")
  
  # Edit the data table
  observeEvent(input$d1_cell_edit, {
    dat_save$df <- editData(dat_save$df, input$d1_cell_edit, d1_proxy)
  })
  
  # Update the input numbers for each cell
  observeEvent(input$Slider, {
    dat_save$df[1, "Value"] <- as.character(input$Slider)
  })
  
  observeEvent(input$Radio, {
    dat_save$df[2, "Value"] <- input$Radio
  })
  
  observeEvent(input$Text, {
    dat_save$df[3, "Value"] <- input$Text
  })
  
  observe({
    replaceData(d1_proxy, dat_save$df, resetPaging = FALSE)
  })
  
}

shinyApp(ui, server)

However, when I transferred the same code to a shinydahsboard with more than one tab. The DT cannot update the values when first initialize the app. Below is a screenshot and the code.

# Load the packages
library(tidyverse)
library(shiny)
library(shinydashboard)
library(DT)

# Create an empty data frame
dat <- tibble(
  Input = c("SliderInput", "RadioButtons", "TextInput"),
  Value = NA_character_
)

ui <- function(request) {
  dashboardPage(
    # The header panel
    header = dashboardHeader(title = ""),
    # The sidebar panel
    sidebar = dashboardSidebar(
      # The sidebar manual
      sidebarMenu(
        id = "tabs",
        # Tab 1
        menuItem(
          text = "Tab1",
          tabName = "Tab1"
        ),
        # Tab 2
        menuItem(
          text = "DT Example",
          tabName = "DT_E"
        )
      )),
    # The main panel
    body = dashboardBody(
      tabItems(
        tabItem(
          # The tab name
          tabName = "Tab1",
          
          h2("Placeholder")
        ),
        # Tab 2: DT example
        tabItem(
          # The tab name
          tabName = "DT_E",
          
          h2("DT: Document the Input Values"),
          
            sidebarPanel(
              # The input widgets
              sliderInput(inputId = "Slider", label = "The SliderInput", min = 1, max = 10, value = 5),
              br(),
              radioButtons(inputId = "Radio", label = "The RadioButtons", choices = c("A", "B", "C")),
              br(),
              textInput(inputId = "Text", label = "The TextInput", value = "Enter text ...")
            ),
              # The datatable
              DTOutput(outputId = "d1")
          )
        )
      )
     )
  }

server <- function(input, output, session){
  
  # Save the dat to a reactive object
  dat_save <- reactiveValues(df = dat)
  
  output$d1 <- renderDT(dat, options = list(pageLength = 5), editable = TRUE, rownames = TRUE)
  
  # Save the condition of the data table d1
  d1_proxy <- dataTableProxy("d1")
  
  # Edit the data table
  observeEvent(input$d1_cell_edit, {
    dat_save$df <- editData(dat_save$df, input$d1_cell_edit, d1_proxy)
  })
  
  # Update the input numbers for each cell
  observeEvent(input$Slider, {
    dat_save$df[1, "Value"] <- as.character(input$Slider)
  })
  
  observeEvent(input$Radio, {
    dat_save$df[2, "Value"] <- input$Radio
  })
  
  observeEvent(input$Text, {
    dat_save$df[3, "Value"] <- input$Text
  })
  
  observe({
    replaceData(d1_proxy, dat_save$df, resetPaging = FALSE)
  })
  
}

shinyApp(ui, server)

Notice that if there is only one tab in the shinydashboard , the DT will work. If changed any input values after initializing the app, the DT will also work. But it is a mystery to me why the DT cannot work in the first place when the shinydashboard has multiple tabs. Any suggestions or comments would be great.

Answer 1

After further search, I found a solution from this post and this post . For some reasons, the default setting for shinydashboard is to ignore hidden objects starting the second tab. In my case, adding outputOptions(output, "d1", suspendWhenHidden = FALSE) solves the issue. Below is the complete code.

# Load the packages
library(tidyverse)
library(shiny)
library(shinydashboard)
library(DT)

# Create an empty data frame
dat <- tibble(
  Input = c("SliderInput", "RadioButtons", "TextInput"),
  Value = NA_character_
)

ui <- function(request) {
  dashboardPage(
    # The header panel
    header = dashboardHeader(title = ""),
    # The sidebar panel
    sidebar = dashboardSidebar(
      # The sidebar manual
      sidebarMenu(
        id = "tabs",
        # Tab 1
        menuItem(
          text = "Tab1",
          tabName = "Tab1"
        ),
        # Tab 2
        menuItem(
          text = "DT Example",
          tabName = "DT_E"
        )
      )),
    # The main panel
    body = dashboardBody(
      tabItems(
        tabItem(
          # The tab name
          tabName = "Tab1",
          
          h2("Placeholder")
        ),
        # Tab 2: DT example
        tabItem(
          # The tab name
          tabName = "DT_E",
          
          h2("DT: Document the Input Values"),
          
            sidebarPanel(
              # The input widgets
              sliderInput(inputId = "Slider", label = "The SliderInput", min = 1, max = 10, value = 5),
              br(),
              radioButtons(inputId = "Radio", label = "The RadioButtons", choices = c("A", "B", "C")),
              br(),
              textInput(inputId = "Text", label = "The TextInput", value = "Enter text ...")
            ),
              # The datatable
              DTOutput(outputId = "d1")
          )
        )
      )
     )
  }

server <- function(input, output, session){
  
  # Save the dat to a reactive object
  dat_save <- reactiveValues(df = dat)
  
  output$d1 <- renderDT(dat, options = list(pageLength = 5), editable = TRUE, rownames = TRUE)
  
  outputOptions(output, "d1", suspendWhenHidden = FALSE)
  
  
  # Save the condition of the data table d1
  d1_proxy <- dataTableProxy("d1")
  
  # Edit the data table in tab 3
  observeEvent(input$d1_cell_edit, {
    dat_save$df <- editData(dat_save$df, input$d1_cell_edit, d1_proxy)
  })
  
  # Update the input numbers for each cell
  observeEvent(input$Slider, {
    dat_save$df[1, "Value"] <- as.character(input$Slider)
  })
  
  observeEvent(input$Radio, {
    dat_save$df[2, "Value"] <- input$Radio
  })
  
  observeEvent(input$Text, {
    dat_save$df[3, "Value"] <- input$Text
  })
  
  observe({
    replaceData(d1_proxy, dat_save$df, resetPaging = FALSE)
  })
  
}

shinyApp(ui, server)