Disable visual response of R Plotly click events

Viewed 1282

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)
2 Answers

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]])

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.

Related