Prevent map_marker_click on certain layer but allow label

Question

I have a function showPopup() which allows me to add popups on my map via a map_marker_click. That function is meant to work with the layer blue (myData) and not with the red (myData). I could use option = interactive : False to prevent the red layer from displaying the popup but I still need that layer to display it's label.

How can I prevent a layer to be interactive with it's label but not with the map_marker_click event? since it's applied to all the layer of my map?

Here is a reproducible example:

library(tidyverse)
library(ggplot2)
library(shiny)
library(leaflet)
library(leafpop)
library(lattice)


id <- c(1,1,1,1,2,2,3,3,3,4)
lat <- c(49.823, 49.823, 49.823, 49.823, 58.478, 58.478, 57.478 , 57.478 , 57.478, 38.551)
lng <- c(-10.854, -10.854, -10.854, -10.854, -11.655, -11.655, 2.021 , 2.021 , 2.021, 5.256)
type <- c("A","C","B","B","C","A","B","A","C","B")
date <- c(152.5,307.5,145,481,152,109.5,258.5,107.5,186.5,150)
start <- c(123,235,135,192,149,101,205,75,155,100)
stop <- c(182,380,155,289,155,218,312,140,218,200)
myData <- data.frame(id,type,date,start,stop,lat,lng)

name <- c("AAA","BBB","CCC","DDD")
lat2 <- c(48,47,45,46)
lng2 <- c(-10,-12,-14,-16)
myData2 <- data.frame(name,lat2,lng2)

folder <- tempfile()
dir.create(folder)

chronogramme<- function(dataId){
  
  dataFiltered<-filter(myData,id==dataId)
  
  p<- ggplot(dataFiltered,aes(type,date))+
    geom_linerange(aes(ymin=start,ymax=stop),size=5)+
    coord_flip()
  return(p)
}


ui <- fluidPage(
  leafletOutput("map")
)


server <- function(input, output, session) {
  
  #Sortie map
  output$map <- renderLeaflet({
    leaflet()%>%
      addProviderTiles(providers$CartoDB.Positron) %>% 
      addCircleMarkers(
        layerId=~id,
        data = myData,
        lat = myData$lat,
        lng = myData$lng,
        radius = 5,
        color = 'blue',
        stroke = FALSE,
        fillOpacity = 1
      )%>% 
      addCircleMarkers(
        data = myData2,
        lat = myData2$lat,
        lng = myData2$lng,
        radius = 5,
        color = 'red',
        stroke = FALSE,
        fillOpacity = 1,
        label = ~as.character(name),
      )
  })
  
  # When map is clicked, show a popup with city info
  showPopup <- function(id, lat, lng) {
    chrngr <- chronogramme(id)
    svg(filename= paste(folder,"plot.svg", sep = "/"), 
        width = 500 * 0.005, height = 300 * 0.005)
    print(chrngr)
    dev.off()
    
    content <- paste(readLines(paste(folder,"plot.svg",sep="/")), collapse = "")
    
    leafletProxy("map") %>% addPopups(lng, lat, content, layerId = id)
  }
  
  observe({
    leafletProxy("map") %>% clearPopups()
    event <- input$map_marker_click
    if (is.null(event))
      return()
    
    isolate({
      showPopup(event$id, event$lat, event$lng)
    })
  })
  
}



# Create Shiny app ----
shinyApp(ui = ui, server = server)

Answer 1

I think you had already 90% of the solution. For blue circle markers you initialized the slot id using the code line:

addCircleMarkers(
  layerId=~id   ## Here!

while you did not add any id to the red markers. Now, in the reactive part of your code where you observe the click, simply test if the slot id is NULL or not:

observe({
  leafletProxy("map") %>% clearPopups()
  event <- input$map_marker_click
  if(is.null(event) || is.null(event$id))  # Here is the change.
    return()

Is that working for you?

---

Btw, I find your question inspirational for my work. Thanks!