Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Disable visual response of R Plotly click events

Tags:

r

dt

shiny

plotly

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)
like image 652
Brian Stamper Avatar asked Sep 29 '17 17:09

Brian Stamper


1 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]])
like image 118
Maximilian Peters Avatar answered Nov 03 '22 01:11

Maximilian Peters