Disable visual response of R Plotly click events

Question

I'm building a Shiny app with a plot_ly scatter plot. I'm using a SharedData object (from the crosstalk package) to share information between the plot and a datatable (from DT).

The problem is when you click a point in the plot it dims the color of all of the other points and adds an entry to the legend for the selected point, and once this happens there doesn't seem to be a way to undo it. I would like to disable these visual changes but still be able to detect plot clicks.

This issue does not occur if I just use a reactive data.frame instead of a SharedData object in the data parameter of the plot_ly call, but then the event_data from the plot doesn't have enough information to select a row in the datatable. (The x and y point coordinates are floating point numeric, so matching by coordinates against the data can have unexpected results.)

Here's a demo using mtcars:

library(shiny)
library(DT)
library(plotly)
library(data.table)
library(crosstalk)

### UI function ---------
ui <- fluidPage(
  fluidRow(
    plotlyOutput('my_graph', height = '400px')
  ),
  fluidRow(
    dataTableOutput('my_table')
  )
)

### Server function -------
server <- function(input, output, session) {

### SharedData object ----
  filtered_data <- reactive({
    data.table(mtcars, keep.rownames = TRUE)
  }) 

  shared_data <- reactive({
    req(filtered_data())
    SharedData$new(filtered_data(), ~rn)
  })

### my_graph ----
  output$my_graph <- renderPlotly({
    p <- plot_ly(shared_data(),
                 x = ~disp,
                 y = ~mpg,
                 color = ~factor(carb),
                 source = 'm')
    p
  }) 

### my_table --------- 
  output$my_table <- renderDataTable({
    datatable(shared_data()$data(),
              selection = 'single')
  })

  observe({
    click_detect = plotly::event_data('plotly_hover', source = 'm')
    str(click_detect)

    dataTableProxy('my_table') %>%
      selectRows(match(click_detect$key, shared_data()$data()$rn))
  })
}

shinyApp(ui, server)

Knowhow

Answer 1

Why that happens beats me but I can see two possible workarounds.

---

Force Plotly to set the opacity of all markers to 1.

if (click_detect$curveNumber != 0) {
        output$my_graph <- renderPlotly({
          p <- plot_ly(shared_data(),
                       x = ~disp,
                       y = ~mpg,
                       color = ~factor(carb),
                       source = 'm',
                       marker = list(opacity = 1))
          p
        })    
      }

Drawback: The graph flickers.

---

Change your filterRows statement. I don't know your data but for mtcars you can filter by carb (via curveNumber) and then via pointNumber.

dataTableProxy('my_table') %>% selectRows(
        which(mtcars$carb == sort(unique(mtcars$carb))[[click_detect$curveNumber + 1]])[[click_detect$pointNumber + 1]])

Hindgut

The first solution doesn't really work so well, but the second comes close, at least as a workaround using a data.frame instead of a SharedData object. This is my first bounty offer so I'm a little unsure of the protocol here. I may need to check SO meta, but for now I'll award the bounty but still hold out for an answer that directly addresses allowing use of the SharedData object and just disable the visual response of the plot clicks, rather than the workaround. Thank you! – Knowhow

Thanks! I'll try to work on the code some more and update it later if I find a better answer. – Hindgut

Answer 2

I came across the same issue and found an approach using the highlight function. https://www.rdocumentation.org/packages/plotly/versions/4.8.0/topics/highlight

The default setting for non-selected points is opacity=0.2 . This is why the other points dim. So all you need to do is add a pipe %>% highlight(opacityDim = 1) Use any number between 0 and 1 to reduce the opacity of non-selected traces. If you want to disable it completely, then do 1. Otherwise you can try 0.5 and it worked for me.

In your case, you may try

output$my_graph <- renderPlotly({
    p <- plot_ly(shared_data(),
                 x = ~disp,
                 y = ~mpg,
                 color = ~factor(carb),
                 source = 'm')
    p <- highlight(p, opacityDim = 1)
    p
  }) 

Hopefully, it helps for whoever need it later.

Hormonal