ggplot2: how to differentiate click from brush? - r

Question

I want to have a plot in my shiny app that the user can click on or choose certain regions, so I'm using the click and brush arguments of plotOutput. My problem is that when a brush is initiated, the click handler is also called. I want to know when a click is made, and I want to know when a brush is made, but if a click is part of a brush then I want to ignore it.
Example: in the following app, if you just brush (click somewhere and drag the mouse), you get a "click" message as well as a "brush" message. I want to only get the "brush" message in that case.
library(shiny)
library(ggplot2)
runApp(shinyApp(
ui = fluidPage(
plotOutput("plot", click = "click", brush = "brush")
),
server = function(input, output, session) {
output$plot <- renderPlot({
ggplot(mtcars, aes(wt, mpg)) + geom_point()
})
observeEvent(input$click, {
cat("clicked\n")
})
observeEvent(input$brush, {
cat("brushed\n")
})
}
))

Answer 1

I am developing a Shiny app for interactive heatmaps (https://github.com/jokergoo/InteractiveComplexHeatmap). On the heatmap, users can click on the heatmap to see the value for that cell or select a region to catch a sub-heatmap. I don't like double click on heatmap either which is very unfriendly to users.
Following is my solution to differentiate click and brush, may be helpful for you:
A runnable code:
library(shiny)
library(grid)
library(glue)
library(circlize) # only for random colors
ui = fluidPage(
plotOutput("plot", width = 600, height = 400,
click = "click", brush = "brush"),
tags$script(HTML("
$('#plot').mousedown(function(e) {
var parentOffset = $(this).offset();
var relX = e.pageX - parentOffset.left;
var relY = e.pageY - parentOffset.top;
Shiny.setInputValue('x1', relX);
Shiny.setInputValue('y1', relY);
}).mouseup(function(e) {
var parentOffset = $(this).offset();
var relX = e.pageX - parentOffset.left;
var relY = e.pageY - parentOffset.top;
Shiny.setInputValue('x2', relX);
Shiny.setInputValue('y2', relY);
Shiny.setInputValue('action', Math.random());
});
")),
fluidRow(
column(3, htmlOutput("output1")),
column(3, htmlOutput("output2"))
)
)
server = function(input, output, session) {
output$plot = renderPlot({
grid.newpage()
grid.rect()
})
observeEvent(input$action, {
if(input$x1 == input$x2 && input$y1 == input$y2) {
output$output1 = renderText({
isolate(glue("
<pre style='background-color:{rand_color(1)}'>
a click:
x1 = {input$x1}
y1 = {input$y1}
x2 = {input$x2}
y2 = {input$y2}
input$click$coords_css$x = {input$click$coords_css$x}
input$click$coords_css$y = {input$click$coords_css$y}</pre>"))
})
} else {
output$output2 = renderText({
isolate(glue("
<pre style='background-color:{rand_color(1)}'>
a brush:
x1 = {input$x1}
y1 = {input$y1}
x2 = {input$x2}
y2 = {input$y2}
input$brush$coords_css$xmin = {input$brush$coords_css$xmin}
input$brush$coords_css$ymin = {input$brush$coords_css$ymin}
input$brush$coords_css$xmax = {input$brush$coords_css$xmax}
input$brush$coords_css$ymax = {input$brush$coords_css$ymax}</pre>"))
})
}
})
}
shinyApp(ui, server)
And a demo is here:
The idea is to compare the mouse positions at "mousedown" and "mouseup". And at "mouseup" triggers a reactive value (here is action) so that in server function, it can respond to it. (This is implemented in tags$script(...)).
As you can see in the figure, click and brush change the box colors independently, and doing brush won't affect the box for click.

Answer 2

I know it's just a workaround, but my only solution for this was to undo the action of the last click when the brush is activated; I needed this for a plot where the user could add points by clicking.
Using the brushing will first create the point and remove it after releasing the click button.
Just a drawback: sometimes you click and do a micro-brush without noticing, in this case it won't create the point obviously. My app:
library(shiny); library(dplyr); library(ggplot2)
ui <- fluidPage(
fluidRow(
h1("add by clicking anywhere on the plot"),
plotOutput("mainplot",
click="mainplot_click",
brush=brushOpts(id="mainplot_brush"))
),
fluidRow(
actionButton("add", "add"),
actionButton("reset", "reset")
)
)
server <- function(input, output, session) {
vals = reactiveValues(
keeprows = rep(TRUE, nrow(mtcars)),
mydata = mtcars
)
observeEvent(input$mainplot_click, handlerExpr = {
my.x = input$mainplot_click$x
my.y = input$mainplot_click$y
vals$mydata <- vals$mydata %>% bind_rows(data.frame("wt"=my.x, "mpg"=my.y))
})
output$mainplot = renderPlot({
temp = vals$mydata
ggplot() +geom_point(data=temp, col="black", fill="white", size=3) + aes(x=wt, y=mpg)
})
observeEvent(input$mainplot_brush, handlerExpr = {
vals$mydata <- vals$mydata %>% head(-1)
})
observeEvent(input$reset, handlerExpr = {
vals$mydata <- mtcars
vals$keeprows <- rep(TRUE, nrow(mtcars))
})
session$onSessionEnded(stopApp)
}
shinyApp(ui, server)

Answer 3

I solved this problem with a set of flags, recognizing that a drag event triggers a click (mouse down), followed by brush, followed by a second click (actually mouse up). I delay processing of the first click, then cancel the first click if I handle the brush. And if I am handling the brush, then I know that there will be a second click that I should ignore.
single.click.up <- FALSE
single.click.down <- FALSE
brush.click <- FALSE
# Brush events trigger plot1_click twice (down and up) with a brush event in between.
observe({
input$plot1_click
if (single.click.down) {
if (brush.click) {
single.click.up <<- TRUE
message("single click down ignored")
} else {
message("single click down processed")
}
single.click.down <<- FALSE
} else if (single.click.up) {
message("single click up, reset brush click")
brush.click <<- FALSE
single.click.up <<- FALSE
} else {
single.click.down <<- TRUE
invalidateLater(1000)
message("new single click. delay.")
}
})
observeEvent( input$plot1_brush, {
brush.click <<- TRUE
message("Processing brush")
})
There's probably a cleaner way to do this. And strange things could happen if events were lost or slow to be processed. But it works for me.