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

Question

我设计了一个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")),
      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具有多个选项卡的 a 时。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也将起作用。但对我来说，为什么当有多个标签DT时不能首先工作是一个谜。shinydashboard任何建议或意见都会很棒。

标签： rshinydatatablesshinydashboarddt

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)