r - 禁用 R Plotly 单击事件的视觉响应

Question

我正在构建一个带有 plot_ly 散点图的 Shiny 应用程序。我使用 SharedData 对象(来自 crosstalk 包)在绘图和 datatable(来自 DT)之间共享信息。

问题是，当您单击图中的一个点时，它会使所有其他点的颜色变暗，并向所选点的图例添加一个条目，一旦发生这种情况，似乎没有办法撤消它。我想禁用这些视觉变化，但仍然能够检测绘图点击。

如果我仅在 plot_ly 的数据参数中使用响应式 data.frame 而不是 SharedData 对象，则不会出现此问题调用，但绘图中的 event_data 没有足够的信息来选择 datatable 中的行。 (x 和 y 点坐标是 float 值，因此根据数据进行坐标匹配可能会产生意外结果。)

这是使用 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)

Answer 1

为什么会发生这种情况让我困惑，但我可以看到两种可能的解决方法。

<小时/>

强制 Plotly 将所有标记的不透明度设置为 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
        })    
      }

缺点:图表闪烁。

<小时/>

更改您的filterRows 语句。我不知道您的数据，但对于 mtcars，您可以按 carb(通过 curveNumber)过滤，然后通过 pointNumber 进行过滤>.

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