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)

回答1:

The way I have approached this with maps is to use addPopupGraphs after adding the circle markers in renderLeaflet (as opposed to observeEvent detecting clicks on the markers).

In this case, you can create a list of your plots, such as:

p_all <- lapply(myData$id, chronogramme)

Then use p_all list as follows:

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'
      ) %>%
      addPopupGraphs(p_all, group = 'markers')
  })

And then you would not need observeEvent.

Would this work?

回答2:

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)

来源：https://stackoverflow.com/questions/58606560/r-leaflet-popupgraph-addpopupgraphs-on-map-marker-click