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)
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]])
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With