闪亮：observeEvent停留在DTOutput上

Question

In the app below, I can switch back and forth between outputs generated by shiny::plotOutput and shiny::dataTableOutput . But when I select the option "DT", which generates a table using the DT::DTOutput function, the app gets stuck:

1. I can interact with the table (good)
2. Clicking "Load" does nothing (not good) even though it worked perfectly when non-DT output was selected before. Clicking "Load" should switch to selected output.

Is this a bug in DT? Is there a workaround?

UI:

library(shiny)

ui <- fluidPage(
  uiOutput("ui_select"),
  uiOutput("my_ui")
)

Server:

server <- function(input, output) {

  output$ui_select = renderUI({
    tagList(
      selectInput("selectVal", "Select value", choices = c("gg", "dt", "DT")),
      actionButton("loadVal", label = "Load")
    )
  })

  observeEvent(input$loadVal, {

    val = isolate({ input$selectVal })

    output$my_output = switch(
      val,
      "gg" = renderPlot({ ggplot2::qplot(cyl, drat, data = mtcars) }),
      "dt" = renderDataTable({ mtcars[1:3, 1:3] }),
      "DT" = DT::renderDT({ mtcars[1:3, 1:3] })
    )

    output$my_ui = renderUI({
      switch(
        val,
        "gg" = plotOutput("my_output"),
        "dt" = dataTableOutput("my_output"),
        "DT" = DT::DTOutput("my_output")
      )
    })

  })
}

shinyApp(ui, server)

Answer 1

Its generally not a good idea to render much inside the observe as a memory leak can occur. have a look at the example below with a bigger diamonds dataset from the ggplot2 package.

library(shiny)
library(ggplot2)
data(diamonds)

ui <- fluidPage(
  uiOutput("ui_select"),
  uiOutput("my_ui")
)

server <- function(input, output) {

  output$ui_select = renderUI({
    tagList(
      selectInput("selectVal", "Select value", choices = c("gg", "dt", "DT")),
      actionButton("loadVal", label = "Load")
    )
  })

  observeEvent(input$loadVal, {

    val = isolate({ input$selectVal })

    output$gg_output = renderPlot({ ggplot2::qplot(cyl, drat, data = mtcars) })
    output$dt_output = renderDataTable({ diamonds })
    output$DT_output = DT::renderDT({ diamonds })

    output$my_ui = renderUI({
      switch(
        val,
        "gg" = plotOutput("gg_output"),
        "dt" = dataTableOutput("dt_output"),
        "DT" = DT::DTOutput("DT_output")
      )
    })

  })
}

shinyApp(ui, server)

Also I dont think its very efficient to create objects all the time, its best to render them once and simply switch and show what is required.

Proposed solution

library(shiny)
library(shinyjs)
library(ggplot2)
data(diamonds)
outputs <- c("gg_output","dt_output","DT_output")

hideoutputs <- function(output_names){
  lapply(output_names, function(output_name){
    hide(output_name)
  })
}

ui <- fluidPage(
  useShinyjs(),
  uiOutput("ui_select"),
  plotOutput("gg_output"),
  dataTableOutput("dt_output"),
  DT::DTOutput("DT_output")
)

server <- function(input, output, session) {

  hideoutputs(outputs)
  v <- reactiveValues(selection = "None")

  output$ui_select <- renderUI({
    tagList(
      selectInput("selectVal", "Select value", choices = c("gg", "dt", "DT")),
      actionButton("loadVal", label = "Load")
    )
  })

  output$gg_output <- renderPlot({ 
    qplot(cyl, drat, data = mtcars) 
  })

  output$dt_output <- renderDataTable({ 
    diamonds 
  })

  output$DT_output <- DT::renderDT({ 
    diamonds 
  })

  observeEvent(input$loadVal, {

    if(v$selection == input$selectVal){
      return()
    }

    hideoutputs(outputs)
    switch(
      input$selectVal,
      "gg" = show("gg_output"),
      "dt" = show("dt_output"),
      "DT" = show("DT_output")
    )
    v$selection <- input$selectVal
  })

}

shinyApp(ui, server)

Answer 2

You're essentially defining multiple elements with the same ID. That's invalid HTML, and is bound to result in undefined behaviour. Sometimes defining multiple inputs/outpust with identical IDs seems to work, but it should never be done.

Giving each output its own ID solves this.

server <- function(input, output) {

    output$ui_select = renderUI({
        tagList(
            selectInput("selectVal", "Select value", choices = c("gg", "dt", "DT")),
            actionButton("loadVal", label = "Load")
        )
    })

    observeEvent(input$loadVal, {

        val = isolate({ input$selectVal })

        output$gg_output = renderPlot({ ggplot2::qplot(cyl, drat, data = mtcars) })
        output$dt_output = renderDataTable({ mtcars[1:3, 1:3] })
        output$DT_output = DT::renderDT({ mtcars[1:3, 1:3] })

        output$my_ui = renderUI({
            switch(
                val,
                "gg" = plotOutput("gg_output"),
                "dt" = dataTableOutput("dt_output"),
                "DT" = DT::DTOutput("DT_output")
            )
        })

    })
}

shinyApp(ui, server)