shiny debounce не отображает начальный график

#r #shiny #debounce

#r #блестящий #удаление

Вопрос:

Если я добавлю debounce к реактивному выражению get_data(), при первом извлечении данных график не отображается. Однако изменение данных (путем выбора нового mpg) приводит к последующему отображению графика. Почему это? Есть ли обходной путь? Вот простой минимальный пример, демонстрирующий проблему. Попробуйте удалить %>% debounce(500) , чтобы убедиться, что он работает так, как ожидалось, без него:

 if (interactive()) {
  options(device.ask.default = FALSE)

  library(shiny)
  library(magrittr)

  ui <- fluidPage(
    selectInput("select", label = "select mpg", choices = c(mtcars$mpg, ""), selected = ""),
    plotOutput("plot")
  )

  server <- function(input, output, session) {
    get_data <- reactive({
      req(input$select)
      mtcars[mtcars$mpg == input$select,]
      }) %>% debounce(500)

    get_plot <- reactive({
      data <- get_data()
      print(data)
      plot(get_data())
      }) 

      output$plot <- renderPlot({
        get_plot()
      })
  }

  shinyApp(ui, server)
}
  

Ответ №1:

Здесь происходит пара вещей. Я не думаю, что нам разрешено иметь дубликаты во входных данных select. mtcars$mpg имеет повторяющиеся значения внутри него. Установка начального значения на "" также вызывает странное поведение. Если вы действительно хотите, чтобы начальный график был пустым вместе с debounce, мы могли бы установить для него значение " " . Вот как это будет выглядеть.

 if (interactive()) {
  options(device.ask.default = FALSE)

  library(shiny)
  library(magrittr)

  ui <- fluidPage(
    selectInput("select", label = "select mpg", choices = c(" ",unique(mtcars$mpg)),selected = " "),
    plotOutput("plot")
  )

  server <- function(input, output, session) {
    get_data <- reactive({
      req(input$select)
      if(!is.na(as.numeric(input$select))) mtcars[mtcars$mpg == input$select,] else NULL
    }) %>% debounce(500)

    get_plot <- reactive({
      req(get_data())
      data <- get_data()
      print(data)
      plot(get_data())
    }) 

    output$plot <- renderPlot({
      get_plot()
    })
  }

  shinyApp(ui, server)
}
  

В противном случае, если вы согласны с наличием начального графика, работает следующее. Обратите внимание, что его важно использовать unique()

 if (interactive()) {
  options(device.ask.default = FALSE)

  library(shiny)
  library(magrittr)

  ui <- fluidPage(
    selectInput("select", label = "select mpg", unique(mtcars$mpg)),
    plotOutput("plot")
  )

  server <- function(input, output, session) {
    get_data <- reactive({
      req(input$select)
      mtcars[mtcars$mpg == input$select,]
    }) %>% debounce(500)

    get_plot <- reactive({
      req(get_data())
      data <- get_data()
      print(data)
      plot(get_data())
    }) 

    output$plot <- renderPlot({
      get_plot()
    })
  }

  shinyApp(ui, server)
}
  

Я даже пытался заменить ввод select на selectizeInput("select", label = "select mpg", choices = unique(mtcars$mpg),multiple = TRUE,options = list(maxItems = 1)) Это все еще вызывало проблемы.

Комментарии:

1. Похоже, это работает для моего reprex, поэтому я дал ответ. Тем не менее, это все еще не работает для моего более сложного приложения. Я попытаюсь восстановить пример, в котором ваше решение не работает.

2. В моем более сложном приложении мне пришлось удалить запрос в реактивах, чтобы загрузить начальный график. Я использовал validate в качестве обходного пути без запроса.