Search code examples
rshinypopupr-leaflet

R Leaflet PopupGraph - addPopupGraphs on map_marker_click


I would like to open a popup with a unique plot for each of my marker in it on a map_marker_click using r leaflet and the leafpop library.

For each point when the user click on them the plot to display is computed.

Below is a reproductible code but it doesn't return any error.
Any ideas?

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


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)


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"),
  plotOutput("plot")
)


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,
        group = 'markers'
      )
  })

  observeEvent(input$map_marker_click,{
    p <- chronogramme(input$map_marker_click$id)
    isolate({
      leafletProxy("map") %>% addPopupGraphs(list(p), group = 'markers')
    })
  })

}

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

Solution

  • Thank you for your response, the problem is that I have many many data on my application so iterate all the plot doesn't work.

    However, I've found another solution : store each created plot temporarily as svg, and display them with addPopus() :

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