另请参阅问题传单插件和 leafletProxy。
我想在 R 的传单中 使用polylineDecorator 插件。
按照如何使用 R 中的传单插件的说明,如果我将该方法与leaflet()
. 请参阅第一个示例,它按我想要的方式工作。但如果我尝试使用相同的方法leafletProxy()
,它不会做任何事情,我只会得到没有装饰器的线。请参阅第二个示例。
我的问题是如何将传单插件与 R 一起使用leafletProxy()
。
示例 1:有效的版本,不使用 lefletProxy。
library(shiny)
library(leaflet)
library(htmltools)
download.file(
'https://raw.githubusercontent.com/bbecquet/Leaflet.PolylineDecorator/master/dist/leaflet.polylineDecorator.js',
'leaflet.polylineDecorator.js')
polylineDecoratorPlugin <- htmlDependency('Leaflet.PolylineDecorator',
'1.6.0',
src = normalizePath('.'),
script = 'leaflet.polylineDecorator.js')
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output) {
dat <- data.frame(lat0=c(29,29.1),lat1=c(30,30.1), lng0=c(-96,-96.1),lng1=c(-95,-95.1))
output$map <- renderLeaflet({
m <- leaflet() %>%
# addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
setView(lat=29.762778, lng=-95.383056, zoom=8) %>% # Houston
registerPlugin(polylineDecoratorPlugin) %>%
addPolylines(lat=c(dat$lat0[1], dat$lat1[1]), lng=c(dat$lng0[1],dat$lng1[1])) %>%
addPolylines(lat=c(dat$lat0[2], dat$lat1[2]), lng=c(dat$lng0[2],dat$lng1[2])) %>%
htmlwidgets::onRender("function(el,x,data) {
for(var i=0; i < data.lat0.length; i++) {
var dec = L.polylineDecorator([[data.lat0[i],data.lng0[i]],[data.lat1[i],data.lng1[i]]], {
patterns: [
{offset: 0, repeat: 20, symbol: L.Symbol.arrowHead({pixelSize:15, pathOptions:{stroke:true}})}
]
}).addTo(this);
}
}",
data=dat)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)
这是我从上面的代码中得到的结果,这也是我所期望的。
示例 2:不显示装饰器的版本,仅显示行,使用 lefletProxy():
library(shiny)
library(leaflet)
library(htmltools)
download.file(
'https://raw.githubusercontent.com/bbecquet/Leaflet.PolylineDecorator/master/dist/leaflet.polylineDecorator.js',
'leaflet.polylineDecorator.js')
polylineDecoratorPlugin <- htmlDependency('Leaflet.PolylineDecorator',
'1.6.0',
src = normalizePath('.'),
script = 'leaflet.polylineDecorator.js')
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output) {
dat <- data.frame(lat0=c(29,29.1),lat1=c(30,30.1), lng0=c(-96,-96.1),lng1=c(-95,-95.1))
output$map <- renderLeaflet({
m <- leaflet() %>%
# addProviderTiles(providers$OpenStreetMap.BlackAndWhite) %>%
setView(lat=29.762778, lng=-95.383056, zoom=8) # Houston
})
observe({
# THIS DOESNT WORK with PROXY!!!
leafletProxy('map') %>%
registerPlugin(polylineDecoratorPlugin) %>%
addPolylines(lat=c(dat$lat0[1], dat$lat1[1]), lng=c(dat$lng0[1],dat$lng1[1])) %>%
addPolylines(lat=c(dat$lat0[2], dat$lat1[2]), lng=c(dat$lng0[2],dat$lng1[2])) %>%
htmlwidgets::onRender("function(el,x,data) {
for(var i=0; i < data.lat0.length; i++) {
var dec = L.polylineDecorator([[data.lat0[i],data.lng0[i]],[data.lat1[i],data.lng1[i]]], {
patterns: [
{offset: 0, repeat: 20, symbol: L.Symbol.arrowHead({pixelSize:15, pathOptions:{stroke:true}})}
]
}).addTo(this);
}
}",
data=dat)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)
这是示例 2 的结果。如您所见,没有装饰器,只有线条,尽管我尝试使用htmlwidgets::onRender
几乎相同的方式。
好吧,我可能已经确定了。
我必须做的是:
呼叫htmlwidgets::onRender
与leaflet
,不与leafletProxy
。当我制作地图时,我必须预测会发生什么。
当我使用添加折线时lealetProxy
,我指导自己添加额外的选项 need_decorator=TRUE。
回调函数htmlwidgets::onRender
应将事件侦听器添加到地图。在下面的代码中是这部分:myMap.on('layeradd', function(e) {...} );
。所以装饰器会在添加图层时添加。
我们想向折线添加装饰器。if ('need_decorator' in lyr.options)
因此,如果触发事件的图层是我想要装饰器的折线,我需要进行此测试。如果没有这个测试,折线装饰器将触发事件并无限循环地调用自身。
下面的示例代码生成了我想要的内容。这对于有 javascript 经验的人来说可能是显而易见的,但是很多像我这样的 R 用户对这种事件类型的事情没有太多经验......
我想处理折线被修改/删除的情况,但我想想法是一样的。
请告诉我是否有更简单的方法来做到这一点。
library(shiny)
library(leaflet)
library(htmltools)
download.file(
'https://raw.githubusercontent.com/bbecquet/Leaflet.PolylineDecorator/master/dist/leaflet.polylineDecorator.js',
'leaflet.polylineDecorator.js')
polylineDecoratorPlugin <- htmlDependency('Leaflet.PolylineDecorator',
'1.6.0',
src = normalizePath('.'),
script = 'leaflet.polylineDecorator.js')
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output) {
dat <- data.frame(lat0=c(29,29.1),lat1=c(30,30.1), lng0=c(-96,-96.1),lng1=c(-95,-95.1))
output$map <- renderLeaflet({
m <- leaflet() %>%
registerPlugin(polylineDecoratorPlugin) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
setView(lat=29.762778, lng=-95.383056, zoom=8) %>% # Houston
htmlwidgets::onRender(
"function(el,x,data) {
var myMap = this;
// I have to wrap the decoration addition code with map.on() function
// wait for polyline layer to be added before i add decorator
myMap.on('layeradd',
function(e) {
var lyr = e.layer;
// among whatever layers added to the map, i look for
// 'need_decorator' property which i tell myself to add as an options
// when adding polyline
if ('need_decorator' in lyr.options) {
var dec = L.polylineDecorator(lyr, {
patterns: [
{offset: 0, repeat: 20, symbol: L.Symbol.arrowHead({pixelSize:15, pathOptions:{stroke:true}})}
]
}).addTo(myMap);
}
}
);
}",
data=dat)
})
observe({
leafletProxy('map') %>%
# I am adding need_decorator = TRUE as an option. This shows up as, when
# event got triggered, event.layer.options.need_decorator in Javascript
addPolylines(lat=c(dat$lat0[1], dat$lat1[1]), lng=c(dat$lng0[1],dat$lng1[1]), options = list(need_decorator = T)) %>%
addPolylines(lat=c(dat$lat0[2], dat$lat1[2]), lng=c(dat$lng0[2],dat$lng1[2]), options = list(need_decorator = T))
})
}
# Run the application
shinyApp(ui = ui, server = server)
Run Code Online (Sandbox Code Playgroud)
编辑 (2020-04-30)openstreetmap 提供程序图块不再存在,所以我更改为 cartodb。确认它仍然有效。