閃亮：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)