Search code examples
rshinyr-leaflet

Creating popups one by one 'on demand'


Inserting popups in addCirclemarkers caused lengthy calculation time for data of thousands of points to be mapped. I am assuming all popups have to be calculated before showing the map.

I searched online for a way to only add/create the popup if a point/circle/marker is clicked. Currently, I am at the below code. If you run this code, you will see that the popup is created, but the string to extract from the data is not shown. What am I doing wrong?

library(shiny)
library(leaflet)
library(htmltools)
library(sp)

data <- data.frame(
  "name"=c("Place 1","Place 2","Place 3"),
  "lat"=c(50,51,52),
  "lng"=c(3,4,5), stringsAsFactors = FALSE)

ui = fluidPage(
  fluidRow(column(8, offset = 2, leafletOutput("map", width = "100%", height = "650px")))
  )                             

server = function(input, output, session) {

  pts <- reactive({
    pts <- data
    coordinates(pts) <- ~lng+lat
    pts
  })

  output$map <- renderLeaflet({
    leaflet(pts()) %>%
      addTiles(group="OSM") %>%
      addCircleMarkers()
  })

  observeEvent(input$map_marker_click, {
    leafletProxy("map") %>% clearPopups()
    event <- input$map_marker_click
    if (is.null(event))
      return()
    isolate({
      pts2 <- pts()
      sgh <- pts2[row.names(pts2) == event$id,]
      # sgh <- pts2[pts2$name == event$id,]
      content <-  htmlEscape(paste("This place is",as.character(sgh$name)))
      leafletProxy("map") %>% addPopups(event$lng, event$lat, content, layerId = event$id)
    })
  })

}

shinyApp(ui = ui, server = server, options = list(launch.browser=TRUE))

Solution

  • With you code event$id is NULL, so the sgh <- pts2[row.names(pts2) == event$id,] line return NULL as well.

    You have to add the layerId to the CircleMarkers (and is not necessary to add it to the Popup.
    This also let access it wothout needing to 'merge' it with the original data:

    output$map <- renderLeaflet({
        leaflet(pts()) %>%
            addTiles(group="OSM") %>%
            addCircleMarkers(layerId = ~name)
    })
    
    observeEvent(input$map_marker_click, {
        leafletProxy("map") %>% 
            clearPopups()
        event <- input$map_marker_click
        if (is.null(event))
            return()
        isolate({
            content <-  htmlEscape(paste("This place is", event$id))
    
            leafletProxy("map") %>% 
                addPopups(event$lng, event$lat, content)
        })
    })