選択変更時に光沢のあるアプリでダブルドローを防止する

Question

私は、selectInputsを変更すると、両方の更新を他の選択肢にトリガし、プロット更新をトリガする光沢のあるアプリを持っています。残念なことに、選択を変更するとプロットが再描画され、別の選択が更新され、プロットがもう一度描画される状況があります。だから、私は複数回図面を再描画することになります。私の光沢のあるアプリは、以下のものより複雑ですが、私は問題を蒸留しました。

ユーザーが国、年、またはタイトルを変更するたびにプロットを変更したい。しかし、ユーザーが国を変更すると、自動的に年の更新が終了する可能性があり、国に関連付けられたプロットが更新され、年に関連付けられた再描画が行われる可能性があります。

簡単な遅延を許容する方法がありますか？光沢があり、「追いつく」ことができますが、両方の反応がプロットを引き起こすことはありませんか？それとも他にもオプションがありますか？

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)) 
    }) 

を"タイトル"オブザーバーからの$ 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)