0

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.

enter image description here

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

enter image description here

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

www
  • 38,575
  • 12
  • 48
  • 84

1 Answers1

0

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)
www
  • 38,575
  • 12
  • 48
  • 84