R Leaflet PopupGraph - addPopupGraphs на карте_маркер_клик

Question

Я хотел бы открыть всплывающее окно с уникальным графиком для каждого из моих маркеров в нем на map_marker_click с использованием листовки r и библиотеки leafpop.

Для каждой точки, когда пользователь нажимает на них график, чтобыдисплей вычисляется.

Ниже приведен воспроизводимый код, но он не возвращает ошибок.
Есть идеи?

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)

Answer 1

Я подошел к этому с помощью карт, используя addPopupGraphs после добавления круговых маркеров в renderLeaflet (в отличие от observeEvent обнаружения щелчков на маркерах).

В этом случаеВы можете создать список своих графиков, например:

p_all <- lapply(myData$id, chronogramme)

Затем используйте список p_all следующим образом:

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

И тогда вам не понадобится observeEvent.

Будет ли это работать?

Answer 2

Спасибо за ваш ответ, проблема в том, что у меня много данных в моем приложении, поэтому повторение всего графика не работает.

Однако я нашел другое решение: сохранить каждый созданный графиквременно как svg, и отобразите их с помощью 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)