r - 防止在选择更改时在 Shiny 的应用程序中重复绘制

Question

我有一个 Shiny 的应用程序，其中对 selectInputs 的更改会触发对其他选择的更新并触发绘图更新。不幸的是，在某些情况下，更改选择会导致重新绘制绘图，然后它会更新另一个选择并再次绘制绘图。所以我最终多次重新绘制了一个情节。我 Shiny 的应用程序比下面的应用程序更复杂，但我已经提炼了问题。

每当用户更改国家、年份或标题时，我都希望更改情节。但是，当用户更改国家/地区时，它也可能最终自动更新年份，这可能会导致更新与国家/地区相关的绘图，然后重新绘制与年份相关的图表。

有没有办法允许短暂的延迟，也许是为了让 Shiny “ catch ”而不是让两个 react 都触发情节？或者也许还有其他选择？

library(shiny)
server <- function(input, output, session) {
  output$plot <- renderPlot({
        Sys.sleep(0.2)
        plot(1:10, main=input$title)
        rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))
  })

  observeEvent(input$country, {
    vals <- switch(input$country,
                   US = 2001:2003,
                   UK = 2001:2005,
                   FR = 2002:2006)

    updateSelectInput(session, "year", choices = vals, selected = vals[1])
  })

  observeEvent(c(input$country, input$year), {

    updateNumericInput(session, "title", 
                       value = paste(input$country, input$year))
  })

} 

ui <- fluidPage(

  tags$div(class="panel-body",

           selectInput("country", "country", choices = c("US", "UK", "FR"), selected = "US"),
           textInput("title", "Give a title",  "This is my initital title"),
           selectInput("year", "year", choices = NULL, selected = NULL)

  ),

  plotOutput("plot")

)

shinyApp(ui = ui, server = server)

Answer 1

从我在这个特定案例中看到的情况来看，更改“标题”观察者可能就足够了:

observeEvent(input$year, {

            updateNumericInput(session, "title", 
                               value = paste(input$country, input$year))
    })

因为 input$country 的每次更改都会触发 input$year 的更新，从“title”观察者中移除 input$country 应该避免重复绘图。我已经在本地测试过它并且有效。

让我知道，这是一个很好解决的问题...

!!!笔记答案中有错误。如果更改了国家/地区但未更改年份，则不起作用。我修改了代码:

    library(shiny)
    server <- function(input, output, session) {
            rv <- reactiveValues(trigger = FALSE)
            output$plot <- renderPlot({
                    Sys.sleep(0.2)
                    plot(1:10, main=input$title)
                    rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = sample(colors() ,1))
            })

            observeEvent(input$country, {
                    vals <- switch(input$country,
                                   US = 2001:2003,
                                   UK = 2001:2005,
                                   FR = 2002:2006)
                    rv$trigger = input$year == vals[1]
                    updateSelectInput(session, "year", choices = vals, selected = vals[1])
            })

            observeEvent(c(input$year, rv$trigger), {

                    updateNumericInput(session, "title", 
                                       value = paste(input$country, input$year))
                    if(rv$trigger == TRUE) {
                            rv$trigger = FALSE
                    }
            })

    } 

    ui <- fluidPage(

            tags$div(class="panel-body",

                     selectInput("country", "country", choices = c("US", "UK", "FR"), selected = "US"),
                     textInput("title", "Give a title",  "US 2001"),
                     selectInput("year", "year", choices = 2001:2003, selected = 2001)

            ),

            plotOutput("plot")

    )

    shinyApp(ui = ui, server = server)