R中保持部件同步互動情節閃亮

Question

我有一個RShiny應用程序，我希望能夠與「互動」，以更新的互動情節像刷過的情節（https://shiny.rstudio.com/articles/plot-interaction.html），並採用了滑蓋部件

我遇到的問題是筆刷更新範圍，然後繪製繪圖，然後範圍更新滑塊，然後滑塊更新繪圖。這意味着它正試圖繪製情節的兩倍，但在更糟糕的情況下，它可能會導致一個無限循環太

這裏是一個小例子代碼

library(shiny) 

shinyApp(
    ui = fluidPage(
     titlePanel("Test"), 
     sidebarLayout(
     sidebarPanel(
      p("This app can adjust plot with slider or with brush, but it plots the figure twice when the interactive brush is used. How to fix?"), 
      uiOutput("sliderRange") 
     ), 
     mainPanel(
      plotOutput("distPlot", 
      brush = brushOpts(
       id = "plot_brush", 
       resetOnNew = T, 
       direction = "x" 
      ) 
     ) 
     ) 
    ) 
    ), 
    server = function(input, output) { 
     ranges <- reactiveValues(xmin = 0, xmax = 10) 
     observeEvent(input$plot_brush, { 
      brush <- input$plot_brush 
      if (!is.null(brush)) { 
       ranges$xmin <- brush$xmin 
       ranges$xmax <- brush$xmax 
      } 
     }) 
     observeEvent(input$sliderRange, { 
      ranges$xmin <- input$sliderRange[1] 
      ranges$xmax <- input$sliderRange[2] 
     }) 

     output$sliderRange <- renderUI({ 
      sliderInput("sliderRange", "Range", min = 0, max = 100, value = c(ranges$xmin, ranges$xmax), step = 0.001) 
     }) 

     output$distPlot <- renderPlot({ 
      print('Plotting graph') 
      s = ranges$xmin 
      e = ranges$xmax 
      plot(s:e) 
     }) 
    } 
) 

Answer 1

最好將簡化事件流從刷更新滑塊，然後從滑塊範圍：

shinyApp(
    ui = fluidPage(
     titlePanel("Test"), 
     sidebarLayout(
     sidebarPanel(
      sliderInput("sliderRange", "Range", min = 0, max = 100, value = c(0,100)) 
     ), 
     mainPanel(
      plotOutput("distPlot",brush = brushOpts(
         id = "plot_brush", 
         resetOnNew = T, 
         direction = "x" 
        ) 
     )))), 
    server = function(input, output, session) { 
     ranges <- reactiveValues(xmin = 0, xmax = 10) 

     observeEvent(input$plot_brush, { 
     brush <- input$plot_brush 
     if (!is.null(brush)) { 
      updateSliderInput(session, "sliderRange", value=c(brush$xmin,brush$xmax)) 
     } 
     }) 

     observeEvent(input$sliderRange, { 
      ranges$xmin <- input$sliderRange[1] 
      ranges$xmax <- input$sliderRange[2] 
     }) 

     output$distPlot <- renderPlot({ 
     print('Plotting graph') 
     s = ranges$xmin 
     e = ranges$xmax 
     plot(s:e) 
     }) 
    } 
) 

如果這是不可能的應用程序，您可以使用此解決辦法，以避免重新繪製：從滑塊更新範圍之前，你可以檢查它是否已被修改。如果它剛剛被刷子修改過，它會相同（或非常接近）。那麼你不需要再次更新它，並且繪圖不會被繪製：

observeEvent(input$sliderRange, { 
    if(abs(ranges$xmin - input$sliderRange[1])>0.1 || # Compare doubles 
     abs(ranges$xmax - input$sliderRange[2])>0.1) # on small difference 
     { 
     ranges$xmin <- input$sliderRange[1] 
     ranges$xmax <- input$sliderRange[2] 
     } 
    })