时间戳

首页 > 解决方案 > 闪亮：observeEvent 卡在 DTOutput

r - 闪亮：observeEvent 卡在 DTOutput

问题描述

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

  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)

标签： rshiny

解决方案

在内部渲染很多内容通常不是一个好主意，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)

推荐阅读