在R Shiny中使小部件与交互式图表保持同步

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

- Colin D

---

有用的问题！ - RanonKahn

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

- HubertL

---

我希望在这里可能有一些解决“数据流”问题的方法，但这可能是一个不错的权宜之计。 - Colin D

非常感谢您更新答案并提供updateSliderInput建议！ - Colin D