Question

我有一个RShiny应用程序，我希望能够使用＆＃34;交互＆＃34;更新交互式情节。比如刷过图（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]
      }
  })

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

1 个答案: