Блестящий: наблюдать за событием застрял на DTOutput

Question

В приложении ниже я могу переключаться между выходами, генерируемыми shiny::plotOutput и shiny::dataTableOutput.Но когда я выбираю опцию «DT», которая генерирует таблицу с помощью функции DT::DTOutput, приложение застревает:

1. Я могу взаимодействовать с таблицей (хорошо)
2. Нажатие «Load» ничего не делает (не хорошо), даже если оно отлично работало, когда ранее был выбран вывод без DT.Нажатие «Load» должно переключиться на выбранный выход.

Это ошибка в 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

Вы определяете несколько элементов с одинаковым идентификатором.Это недопустимый HTML-код, который обязательно приведет к неопределенному поведению.Иногда кажется, что определение нескольких входов / выходов с одинаковыми идентификаторами работает, но это никогда не должно выполняться.

Разрешение каждого выхода своим собственным идентификатором решает эту проблему.

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)