Plotly图表与Leaflet/Plotly地图双向高亮联动问题咨询

修改要点 #

• 拆分折线散点图的线条与标记为两个独立trace：线条使用原始数据集渲染，不绑定crosstalk选中事件，不会被高亮逻辑修改；标记绑定highlight_key，仅标记会被选中高亮为红色，无多余连线生成
• 为leaflet的highlight方法显式指定高亮颜色与未选中元素透明度参数，实现选中点变红、未选中点透明度不变的效果

完整可运行代码 #

library(plotly)
library(dplyr)
library(leaflet)
library(htmlwidgets)
library(crosstalk)

set.seed(1)
dat <- tibble(name = letters[1:21]
              , latitude = seq(38.6,38.8,0.01)
              , longitude = seq(-86.4,-86.8,-0.02)
              , var.x = 1:21
              , var.y = runif(21))

dat.a <- highlight_key(dat)

p <- plot_ly() %>%
  # 单独渲染线条，不绑定选中key，不会被高亮修改
  add_lines(data = dat, x = ~var.x, y = ~var.y
            , alpha = 0.8
            , color = I("#1f77b4")
            , showlegend = FALSE) %>%
  # 单独渲染标记，绑定选中key，仅标记会被高亮
  add_markers(data = dat.a, x = ~var.x, y = ~var.y
              , text = ~name
              , alpha = 0.8
              , color = I("#1f77b4")
              , showlegend = FALSE) %>%
  highlight(on = "plotly_selected"
            , off = "plotly_deselect"
            , opacityDim = 1
            , color='red') 

map <- leaflet(dat.a) %>%    
  addTiles() %>%
  addCircles(lat = ~latitude
             , lng = ~longitude
             , stroke = TRUE
             , color = I("#1f77b4")
             , weight = 3
             , opacity = .8) %>%
  # 指定高亮颜色和未选中透明度
  highlight(on="plotly_selected", color = "red", opacityDim = 1)

bscols(widths = c(5, 7)
       , p, map)

修改要点 #

• 同方案A拆分折线散点图的线条与标记，解决高亮多余连线问题
• 删除地图层重复添加的未绑定key的散点trace，该重复层是导致地图选择后高亮异常的核心原因
• 为地图的highlight方法添加opacityDim=1参数，保证未选中点透明度不会降低

完整可运行代码 #

library(plotly)
library(dplyr)
library(htmlwidgets)
library(crosstalk)

set.seed(1)
dat <- tibble(name = letters[1:21]
              , latitude = seq(38.6,38.8,0.01)
              , longitude = seq(-86.4,-86.8,-0.02)
              , var.x = 1:21
              , var.y = runif(21))

dat.a <- highlight_key(dat)

p <- plot_ly() %>%
  # 单独渲染线条，不绑定选中key
  add_lines(data = dat, x = ~var.x, y = ~var.y
            , alpha = 0.8
            , color = I("#1f77b4")
            , showlegend = FALSE) %>%
  # 单独渲染标记，绑定选中key
  add_markers(data = dat.a, x = ~var.x, y = ~var.y
              , text = ~name
              , alpha = 0.8
              , color = I("#1f77b4")
              , showlegend = FALSE) %>%
  highlight(on = "plotly_selected"
            , off = "plotly_deselect"
            , opacityDim = 1
            , color = 'red')

map <- plot_ly(dat.a) %>% 
  add_trace(lon = ~longitude, lat = ~latitude
            , type = "scattermapbox"
            , text = ~name
            , alpha = 0.8
            , mode = "marker"
            , color = I("#1f77b4")
            , hoverinfo = ~name
            , showlegend = FALSE) %>%
  layout(
    mapbox = list(
      style = 'open-street-map',
      zoom = 8.5,
      center = list(lon = mean(dat$longitude), 
                    lat = mean(dat$latitude)))) %>%
  highlight(on = "plotly_selected"
            , off = "plotly_deselect"
            , color = 'red'
            , opacityDim = 1)

bscols(p, map, widths = c(5, 7))

内容的提问来源于stack exchange，提问作者greengrass62