rshinypopupgoogle-maps-markersr-leaflet

How to add a new marker on the map with the popup already opened?


I have a shiny app that displays a leaflet map. One of the functionalities of the app allows users to add a new geographic marker on the map. However, I would like to make the popup of such marker already opened as soon as it is added on the map, but always keeping the possibility to close it with the "x" button or by clicking on the map.

I've read the "Marker" guide of the leaflet documentation (sub-section "Popup methods inherited from Layer", the very detailed guide is, apparently, not available in the R language) and I've found this option openPopup(). Unfortunately, this doesn't seem to work for my code. Here's a simple example:

library(leaflet)

leaflet() %>% 
  addTiles() %>% 
  addMarkers(lng = -100,
             lat = 50,
             popup = "ALE",
             options = popupOptions(openPopup = TRUE))

The expected behaviour is the one shown in this online tool that uses leaflet. Please try to search for an address and look as the new marker has its own popup immediately open.


Solution

  • Code

    I guess a bit of JavaScript will be needed as the interface seems not to support this feature.

    Below a working shiny example:

    library(shiny)
    library(leaflet)
    library(shinyjs)
    
    js_save_map_instance <- HTML(
       paste(
          "var mapsPlaceholder = [];",
          "L.Map.addInitHook(function () {",
          "   mapsPlaceholder.push(this); // Use whatever global scope variable you like.",
          "});", sep = "\n"
       )
    )
    
    js_open_popup <- HTML(
       paste("function open_popup(id) {",
             "   console.log('open popup for ' + id);",
             "   mapsPlaceholder[0].eachLayer(function(l) {",
             "      if (l.options && l.options.layerId == id) {",
             "         l.openPopup();",
             "      }",
             "   });",
             "}", sep = "\n"
       )
    )
    
    ui <- fluidPage(
       tags$head(
          tags$script(type = "text/javascript",
                      js_save_map_instance,
                      js_open_popup),
          useShinyjs()
       ),
       wellPanel(
          fluidRow(
             sliderInput("lng", "Longitude:", 10, 60, 35, 0.01),
             sliderInput("lat", "Latitude:", 35, 75, 42.5, 0.01),
             actionButton("add", "Add Marker")
          )
       ),
       fluidRow(
          leafletOutput("map")
       )
    )
    
    server <- function(input, output, session) {
       map <- leaflet() %>% 
          addTiles() %>%
          fitBounds(10, 35, 60, 75)
       
       output$map <- renderLeaflet(
          map
       )
       
       observeEvent(input$add, {
          id <- paste0("marker", input$add)
          leafletProxy("map") %>%
             addMarkers(input$lng, input$lat, id,
                        "mymarkers", 
                        popup = sprintf("%.2f / %.2f: %s", input$lng, input$lat, 
                                        id))
          runjs(sprintf("setTimeout(() => open_popup('%s'), 10)", id))
       })
    }
    
    shinyApp(ui, server)
    

    Remarks

    Results

    Popup on creation