R Leaflet PopupGraph - map_marker_click 上的 addPopupGraphs
R Leaflet PopupGraph - addPopupGraphs on map_marker_click
我想使用 r leaflet 和 leafpop 库在 map_marker_click 上为我的每个标记打开一个带有独特图的弹出窗口。
当用户点击每个点时,将计算要显示的绘图。
下面是一个可重现的代码,但它 return 没有任何错误。
有什么想法吗?
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)
我用地图处理这个问题的方法是在 renderLeaflet
中添加圆圈标记后使用 addPopupGraphs
(而不是 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
。
这行得通吗?
感谢您的回复,问题是我的应用程序中有很多数据,所以迭代所有绘图都不起作用。
但是,我找到了另一种解决方案:将每个创建的图临时存储为 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)
我想使用 r leaflet 和 leafpop 库在 map_marker_click 上为我的每个标记打开一个带有独特图的弹出窗口。
当用户点击每个点时,将计算要显示的绘图。
下面是一个可重现的代码,但它 return 没有任何错误。
有什么想法吗?
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)
我用地图处理这个问题的方法是在 renderLeaflet
中添加圆圈标记后使用 addPopupGraphs
(而不是 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
。
这行得通吗?
感谢您的回复,问题是我的应用程序中有很多数据,所以迭代所有绘图都不起作用。
但是,我找到了另一种解决方案:将每个创建的图临时存储为 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)