Customize highlight between between plotly figure and leaflet map

Question

My goal is to link highlighting between a plotly figure in one panel and a map in the second panel. For my purposes, I want to select (highlight) data in one panel and have the selected data highlight in red in both panels and not dim the non-selected data. This should work regardless of which panel is used to select the data. In the below, I have two approaches, both of which highlight data between the two panels, but have highlighting color and dimming has functionality issues.

Approach A: In this approach I map with leaflet so as to avoid mapbox. I am also using mode ='markers+lines' since in my real data, the data points are spaced very close along the x-axis and the connecting the data with a line is visually helpful although this introduces a functionality issue that I describe below the code.

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(dat.a) %>%
  add_trace(x = ~var.x, y = ~var.y
            , text = ~name
            , alpha = 0.8
            , mode = 'markers+lines', type = 'scatter'
            , color = I("#1f77b4")
            , showlegend = FALSE) %>%
  highlight(on = "plotly_selected"
            , off = "plotly_deselect"
            , opacityDim = 1
            , color='red') 

map <- leaflet(dat.a) %>%    
  addTiles() %>%
  # addProviderTiles(providers$CartoDB.Positron) %>%
  addCircles(lat = ~latitude
             , lng = ~longitude
             , stroke = TRUE
             , color = I("#1f77b4")
             , weight = 3
             , opacity = .8) %>%
  highlight(on="plotly_selected")

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

Approach A comments: In the below screen capture, I selected 4 data points from the figure (left panel) where y<=0.2. Issue 1: the correct points in the map (right panel) are selected, but in the highlighted points (in the map) stay blue and non-selected points dim. Issue 2: Upon selection, the figure (left panel) adds a red line between points as var.x= 5 and var.x=10. (A solution to issue 2 that just involves highlighting the symbols and not the lines in the figure (left panel) is acceptable).

Approach B: In this approach I map with plotly which is nice because of the more advanced selection features in the map

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(dat.a) %>%
  add_trace(x = ~var.x, y = ~var.y
            , type = "scatter"
            , text = ~name
            , alpha = 0.8
            , mode = 'lines+markers'
            , 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) %>%
  # Plot the data again but using the original data
  add_trace(lon = ~longitude, lat = ~latitude
            , data = dat
            , type = "scattermapbox"
            , text = ~name
            , alpha = 0.8
            , mode = "markers"
            , color = I("#1f77b4")
            , 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')

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

Approach B comments: When running the code, selecting data from the figure (left panel) properly highlight the data in the map (right panel)--this appears to work repeatedly. Issue 1: Upon initial running of the code, selecting data from the map (right panel) properly highlight the data in the figure (left panel) the first time. Subsequent selections from the map result do not get the desired red coloring and also dims the non-selected points. Issue 2 (same as Approach A issue 2): Upon selection, the figure (left panel) adds a red line between points as var.x= 5 and var.x=10. (A solution to issue 2 that just involves highlighting the symbols and not the lines in the figure (left panel) is acceptable).

My questions (“issues”) that I need help with as stated in the approach A and B comments are:

For Approach A: I am looking for edits to my code that will 1) highlight points in red in left panel without adding a red connecting line, and 2) highlight points in red on right panel and not dim other points.

For approach B: I am looking for edits that will allow for consistently highlighting points as red in map (it seems to work ok first time but not repeatedly, and 2) do not connect points in plot with a red line, ie just highlight the points).

Answer 1

Continuing with Approach B, one needs to split the highlighting for the lines and points. Below is a solution built out as a shiny app that includes a reset option.

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

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

# Create two separate highlight keys
dat.a_lines <- highlight_key(dat, group = "lines")
dat.a_markers <- highlight_key(dat, group = "markers")

ui <- fluidPage(
  actionButton("reset", "Reset"),
  fluidRow(
    column(5, plotlyOutput("plot")),
    column(7, plotlyOutput("map"))
  )
)

server <- function(input, output, session) {
  # Render plotly figure
  output$plot <- renderPlotly({
    plot_ly() %>%
      add_trace(data = dat.a_lines,
                x = ~var.x, y = ~var.y,
                type = "scatter",
                text = ~name,
                alpha = 0.8,
                mode = 'lines',  
                color = I("#1f77b4"),
                showlegend = FALSE) %>%
      add_trace(data = dat.a_markers,
                x = ~var.x, y = ~var.y,
                type = "scatter",
                text = ~name,
                alpha = 0.8,
                mode = 'markers',
                color = I("#1f77b4"),
                showlegend = FALSE) %>%
      highlight(on = "plotly_selected",
                off = "plotly_deselect",
                opacityDim = 1,
                color = 'red')
  })
  
  # Render plotly map
  output$map <- renderPlotly({
    plot_ly(dat.a_markers) %>%
      add_trace(lon = ~longitude, lat = ~latitude,
                type = "scattermapbox",
                text = ~name,
                alpha = 0.8,
                mode = "markers",
                color = I("#1f77b4"),
                hoverinfo = ~name) %>%
      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",
                opacityDim = 1,
                color = 'red')
  })
  
  # Reset the plots when the button is clicked
  observeEvent(input$reset, {
    session$reload()
  })
}

shinyApp(ui, server)