r - 使小部件与 R Shiny 中的交互式绘图保持同步

Question

我有一个 RShiny 应用程序，我希望能够通过“交互”更新交互式绘图，例如刷过绘图 (https://shiny.rstudio.com/articles/plot-interaction.html) 和 slider 小部件

我遇到的问题是画笔更新范围，然后绘制绘图，然后范围更新 slider ，然后 slider 更新绘图。这意味着它会尝试绘制两次绘图，但在更坏的情况下，它也可能导致无限循环

这是一个小示例代码

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

最好的办法是通过从画笔更新 slider ，然后从 slider 更新范围来简化事件流:

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

如果您的应用程序无法做到这一点，您可以使用此解决方法来避免重新绘制:在更新 slider 的范围之前，您可以检查它是否已被修改。如果它刚刚被刷子修改过，它将相同(或非常接近)。然后你不需要再次更新它并且不会绘制绘图:

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