闪亮：observeEvent停留在DTOutput上

Question

在下面的应用程序中，我可以在shiny::plotOutput和shiny::plotOutput shiny::dataTableOutput生成的输出之间来回切换。 但是，当我选择选项“ DT”（使用DT::DTOutput函数生成表）时，应用程序卡住了：

1. 我可以和桌子互动（好）
2. 单击“加载”不会执行任何操作（不好），即使在之前选择非DT输出时也可以正常运行。 单击“加载”应切换到选定的输出。

这是DT中的错误吗？ 有解决方法吗？

用户界面：

library(shiny)

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$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

它通常不是一个好主意，使很多内部的observe为内存泄漏可能会发生。 看看下面更大的示例diamonds从数据集ggplot2包。

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)

我也不认为一直创建对象非常有效，最好只渲染一次并简单地切换并显示所需内容。

拟议的解决方案

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

您实际上是在定义多个具有相同ID的元素。 那是无效的HTML，势必导致未定义的行为。 有时用相同的ID定义多个输入/输出似乎可行，但是绝对不要这样做。

为每个输出提供自己的ID可解决此问题。

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)