How to label anomaly points if these points are not consecutive ？

[ZJUguquan]

Hi, very nice work !

And here is a problem. How to label anomaly points if these points are not consecutive ？

When I use this tool, I can only draw one rectangle on the showing plot. So, if the anomalous points are not consecutive, it is not supported for me to draw multiple rectangles to embrace all these points.

How to solve that ?

[omri374]

Hi @ZJUguquan , This is a known issue with Shiny (Link to issue) The best way to overcome this is to download multiple regions (Select a region and click "Download"). Then, use the provided python script to merge all CSVs together into one CSV which contains all the selected points.

Hope this helps.

[ZJUguquan]

@omri374 OK, I see. Thanks ～

[ZJUguquan]

@omri374 Hi, I have come up with a solution. We can use the function shiny::observeEvent to add a actionButton which is bound up with the brush event. And if we press the actionButton, the new points in rectangle will be added or deleted. So we can draw multiple rectangles and deal with the inconsecutive points step by step.

Here is the minimal example:

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux
library(data.table)

cols <- c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")
mtcars2 <- data.table(mtcars[, cols])

ui <- fluidPage(
  fluidRow(
    column(width = 5,
           plotOutput("plot1", height = 300,
                      brush = brushOpts(id = "plot1_brush")
           )
    ),
    column(width = 2, 
           br(),
           actionButton("add", "Add Points"),
           br(),
           br(),
           actionButton("delete", "Delete Points")
    ),
    column(width = 5,
           plotOutput("plot2", height = 300)
    )
  ),
  fluidRow(
    column(width = 6,
           h4("Brushed points"),
           verbatimTextOutput("brush_info")
    )
  )
)

server <- function(input, output) {

  output$plot1 <- renderPlot({
    ggplot(mtcars2, aes(wt, mpg)) + geom_point()
  })

  new.pts <- reactive(brushedPoints(mtcars2, input$plot1_brush))
  output$brush_info <- renderPrint({
    new.pts()
  })

  ### Using `observeEvent` to Add or Delete Points -------
  points <- data.table()
  makeReactiveBinding("points")

  observeEvent(input$add, {
    points <<- rbind(points, new.pts())
  })

  observeEvent(input$delete, {
    if (dim(points)[1] > 0) {
      points <<- points[!new.pts(), on = cols]
    }
  })
  ### ----------------------------------------------------

  output$plot2 <- renderPlot({
    p2 <- ggplot(mtcars2, aes(wt, mpg)) + geom_point()
    if (dim(points)[1] > 0) {
      p2 <- p2 + geom_point(aes(wt, mpg), data = points, color = "red")
    } 
    return(p2)
  })

}

shinyApp(ui, server)

Below is screenshots of the app:

• Add points * 1

• Add points * 2

• delete points

[omri374]

Hi @ZJUguquan . Great suggestion! Would you be interested in doing a PR? If yes, please try addressing these issues:

1. Keep selected points on the original graph and not a second graph. It's a straightforward change.
2. If possible, please avoid using makeReactiveBinding as it introduces global assignments (<<-).
3. A solution without an "add" button is favorable, but I'm not sure how feasible it is. See my comments on the original Shiny issue for ideas on solving this at least from a UX perspective

Thanks!

[omri374]

Fixed see PR #16