使用 Shiny 时自动更新 DT 有效，但在具有多个选项卡的 Shinydashboard 中无效

如何解决使用 Shiny 时自动更新 DT 有效，但在具有多个选项卡的 Shinydashboard 中无效

我设计了一个带有 Shiny 的 DT 应用，它可以检测输入字段是否发生变化并自动更新值。下面是一个屏幕截图和我的代码。这个应用程序按我的预期工作。运行此应用时，DT 中的值会根据输入值进行相应更新。

# 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")),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)

但是，当我将相同的代码转移到具有多个标签的 shinydahsboard 时。首次初始化应用程序时，DT 无法更新值。下面是截图和代码。

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

# Create an empty data frame
dat <- tibble(
  Input = c("SliderInput",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",value = "Enter text ...")
            ),# The datatable
              DTOutput(outputId = "d1")
          )
        )
      )
     )
  }

server <- function(input,server)

请注意，如果 shinydashboard 中只有一个选项卡，DT 将起作用。如果在初始化应用程序后更改了任何输入值，DT 也将起作用。但是，当 DT 有多个选项卡时，为什么 shinydashboard 一开始就不能工作对我来说是个谜。任何建议或意见都会很棒。

解决方法

进一步搜索后，我从这个 post 和这个 post 中找到了解决方案。由于某些原因，shinydashboard 的默认设置是忽略从第二个选项卡开始的隐藏对象。就我而言，添加 outputOptions(output,"d1",suspendWhenHidden = FALSE) 可以解决问题。完整代码如下。

# 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")),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,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)