使用 Shiny 時自動更新 DT 有效，但在具有多個選項卡的閃亮儀表板中無效

Question

我設計了一個帶有DT的Shiny應用程序，它可以檢測輸入字段是否更改並自動更新值。 下面是屏幕截圖和我的代碼。 這個應用程序按我的預期工作。 運行此應用程序時，值會根據輸入值在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")),
      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)

但是，當我將相同的代碼傳輸到具有多個選項卡的shinydahsboard時。 首次初始化應用程序時， DT無法更新值。 下面是截圖和代碼。

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

請注意，如果shinydashboard中只有一個選項卡，則DT將起作用。 如果在初始化應用程序后更改了任何輸入值， DT也將起作用。 但對我來說，為什么當shinydashboard有多個選項卡時DT無法工作，這對我來說是個謎。 任何建議或意見都會很棒。

Answer 1

經過進一步搜索，我從這篇文章和這篇文章中找到了解決方案。 由於某些原因， 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")),
              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)