是否有可能"清除"闪亮的情节的拉丝区域？

Question

闪亮支持点击和刷子处理程序中的图.是否可以"清除"/"删除"/"删除"拉丝矩形,而无需用户点击绘图上的其他位置？例如,如果我想在刷子完成后只存储拉丝坐标然后清除绘图,这是我将使用的代码,但我不知道如何清除位.

library(ggplot2)
library(shiny)

runApp(shinyApp(
  ui = fluidPage(
    plotOutput("plot",
               brush = brushOpts("plotBrush", delay = 5000)),
    actionButton("clear", "Clear")
  ),
  server = function(input, output, session) {
    values <- reactiveValues(brush = NULL)

    output$plot <- renderPlot({
      ggplot(cars, aes(speed, dist)) + geom_point()
    })

    brush <- reactive({
      input$plotBrush
    })

    observeEvent(input$clear, {
      cat(str(brush()))
      # clear the brushed area
    })
  }
))

Answer 1

从Shiny 版本0.14开始,可以使用该session对象重置绘图的画笔.

下面是一个简单的Shiny应用程序,session$resetBrush(<BRUSH_ID>)用于清除拉丝区域.该应用程序允许人们突出显示点的区域或删除拉丝区域,同时保持点突出显示或删除拉丝区域并重置点的颜色.

请参阅https://shiny.rstudio.com/reference/shiny/latest/session.html上的官方文档.

library(shiny)
library(ggplot2)

shinyApp(
  ui = fluidPage(
    plotOutput(
      outputId = "plot",
      brush = brushOpts(
        id = "plotBrush", 
        delay = 5000
      )
    ),
    actionButton("clearBrush", "Clear brush"),
    actionButton("resetPlot", "Reset plot")
  ),
  server = function(input, output, session) {
    output$plot <- renderPlot({
      ggplot(mtcars, aes(wt, mpg)) + 
        geom_point() +
        geom_point(
          data = brushedPoints(mtcars, brush),
          color = "#79D8CB",
          size = 2
        )
    })

    brush <- NULL
    makeReactiveBinding("brush")

    observeEvent(input$plotBrush, {
      brush <<- input$plotBrush
    })

    observeEvent(input$clearBrush, {
      session$resetBrush("plotBrush")
    })

    observeEvent(input$resetPlot, {
      session$resetBrush("plotBrush")
      brush <<- NULL
    })
  }
)

Answer 2

我发现自己处于类似的情况,我有多个刷子,需要一个按钮来"清除世界".我还没有找到一个正式的方法来删除带有R代码的画笔div,但事实证明这是一个很棒的包叫做shinyjs;)

library(shiny)
library(shinyjs)

ui <- fluidPage(
  useShinyjs(),
  actionButton("clear", "Clear brush"),
  fluidRow(
    column(
      width = 6,
      plotOutput("p1", brush = brushOpts("b1"))
    ),
    column(
      width = 6,
      plotOutput("p2", brush = brushOpts("b2"))
    )
  ),
  fluidRow(
    column(
      width = 6,
      verbatimTextOutput("brush1")
    ),
    column(
      width = 6,
      verbatimTextOutput("brush2")
    )
  )
)

server <- function(input, output) {

  values <- reactiveValues(
    brush1 = NULL,
    brush2 = NULL
  )

  # update reactive values when input values change
  observe({
    values$brush1 <- input$b1
    values$brush2 <- input$b2
  })

  # display brush details
  output$brush1 <- renderPrint({
    values$brush1
  })

  output$brush2 <- renderPrint({
    values$brush2
  })

  # clear brush values and remove the div from the page
  observeEvent(input$clear, {
    values$brush1 <- NULL
    values$brush2 <- NULL
    runjs("document.getElementById('p1_brush').remove()")
    runjs("document.getElementById('p2_brush').remove()")
  })

  output$p1 <- renderPlot({
    input$clear
    m <- brushedPoints(mtcars, values$brush1, allRows = TRUE)
    qplot(data = m, wt, mpg, colour = selected_) + 
      theme(legend.position = "none")
  })

  output$p2 <- renderPlot({
    input$clear
    m <- brushedPoints(mtcars, values$brush2, allRows = TRUE)
    qplot(data = m, wt, mpg, colour = selected_) +
      theme(legend.position = "none")
  })

}

shinyApp(ui, server)

IMO,闪亮应该真的提供类似的东西:

clearBrush <- function(id) {
  shinyjs::runjs(sprintf("document.getElementById('%s_brush').remove()", id))
}

Answer 3

首先是关于服务器参数的注释。要分配reactiveValues，您必须在反应式表达式内执行此操作。因此，要捕获画笔坐标，您需要使用它

  observeEvent(input$plotBrush,{
    if(is.null(values$brush)){
    values$brush <- input$plotBrush}
  })

而不是这个

brush <- reactive({
      input$plotBrush
    })

第二个版本创建了一个名为 Brush 的函数，您可以使用 Brush() 调用该函数。

清除画笔上的绘图的一种方法是测试values$brush是否为空，并根据该值改变您所做的事情。在这种情况下，如果values$brush不为空，则显示空白图并且无法选择新点。

library(ggplot2)
library(shiny)

runApp(list(
  ui = fluidPage(
    plotOutput("plot",
               brush = brushOpts("plotBrush", 
                                 delay = 5000,
                                 resetOnNew = TRUE)
               # resetOnNew = TRUE clears the brush
               # each time a new plot is displayed.
               ),
    p("Brushed Points:"),
    verbatimTextOutput("brushedPoints")
  ),
  server = function(input, output, session) {
    values <- reactiveValues(brush = NULL)

    output$plot <- renderPlot({
      if(is.null(values$brush)){
        ggplot(cars, aes(speed, dist)) + geom_point()
      } else {
        ggplot(cars, aes(speed, dist)) + geom_blank()
      }
    })

    observeEvent(input$plotBrush,{
      #Run this whenever points are brushed
      if(is.null(values$brush)){
        values$brush <- input$plotBrush}
    })

    output$brushedPoints <- renderPrint({
      values$brush
    })
  }
))

还可以使用第二个选项，请参阅/sf/answers/2454657271/了解说明

library(ggplot2)
library(shiny)

runApp(list(
  ui = fluidPage(
    plotOutput("plot",
               brush = brushOpts("plotBrush", 
                                 delay = 5000,
                                 resetOnNew = TRUE)
               # resetOnNew = TRUE clears the brush
               # each time a new plot is displayed.
    ),
    p("Brushed Points:"),
    verbatimTextOutput("brushedPoints")
  ),
  server = function(input, output, session) {
    values <- reactiveValues(brush = NULL)

    output$plot <- renderPlot({
      if(is.null(values$brush)){
        ggplot(cars, aes(speed, dist)) + geom_point()
      } else {
        ggplot(cars, aes(speed, dist)) + geom_blank()
      }
    })

    observeEvent(input$plotBrush,{
      #Run this whenever points are brushed
        output$plot <- renderPlot({
          if(is.null(values$brush)){
            ggplot(cars, aes(speed, dist)) + geom_point()
            values$brush <- input$plotBrush
          } else {
            ggplot(cars, aes(speed, dist)) + geom_blank()
          }
        })
        }
    )

    output$brushedPoints <- renderPrint({
      values$brush
    })
  }
))