Please refer also to a question leaflet plugin and leafletProxy.
I want to use polylineDecorator Plugin in leaflet for R.
Following instruction for how to use leaflet plugin from R, I can use it if I use the approach togeher with leaflet(). See the first example, which works as i wanted. But if i try to use the same approach with leafletProxy(), it just doesn't do anything I only get line without decorator. See the second example.
My question is how I can use leaflet plugin with R's leafletProxy().
Example 1: Version that works, not using the 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)
Here's what I get from the code above, and this is what I expected.
Example 2: Version that does not show the decorator, just line, using 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)
And here is the the results from example 2. As you see there is no decorator, only lines, though i attempted to use htmlwidgets::onRender pretty much the same way.
Alright, I may have nailed it down.
What I had to do are:
Call htmlwidgets::onRender with leaflet, not with leafletProxy. I have to anticipate what to come when I make map.
When I add polylines using lealetProxy, i dicipline myself to add extra option need_decorator=TRUE.
Call back function for htmlwidgets::onRender should add event listener to the map. in the code below it is this part: myMap.on('layeradd', function(e) {...} );. So the decorator is going to be added when layer is added.
We want to add decorator to polyline. So i need if ('need_decorator' in lyr.options) this testing if the layer which triggered event was polyline that i want to have decorator. Without this test, polyline decorator is going to trigger the event and goes infinite loop of calling itself.
Sample code below generates what I wanted. This may have been obvious to people with experience with javascript, but a lot of R user like me don't have much experience with this event kind of thing...
I want to deal with cases when polyline got modified/deleted, but I guess idea would be the same.
Please let me know if there is simpler way to do this.
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)
EDIT
(2020-04-30)
openstreetmap provider tile doesnt exist anymore, so i change to cartodb. Confirmed that it is still working.
Related
I'm finding it impossible to add the popups that are possible to add in JS via R's Leaflet.MapBoxGL library. This library lacks native popup functionality.
Can anyone give me some pointers on how I might augment the code so as to do this in R. I'd rather not scrap my work and start over in JS if at all possible.
library(shiny)
library(leaflet)
library(leaflet.mapboxgl)
ui <- fluidPage(
titlePanel("Panel"),
leafglOutput("map")
)
server = function(input, output, session) {
map = createLeafletMap(session, 'map')
session$onFlushed(once = T, function() {
output$map <- renderLeaflet({
leaflet(quakes) %>%
addProviderTiles(providers$Stamen.TonerLite,
options = pathOptions(pane = "background_map")) %>%
addMapboxGL(style = "mapbox://styles/thirdhuman/cjzn4e0xz1ed41cnq6ni0qckl",
,group = "Rural"
,layerId = "Rural"
,popup = paste0(
"<b>Country: </b>")
,option = pathOptions(pane = "Rural"))
})
})
}
shinyApp(ui, server)
Error:
Warning: Error in addMapboxGL: unused argument (popup = paste0("<b>Country:
</b>"))
I'd like to figure out some way to make this work. Above is minimal example, but my real code has multiple layers of these MapBoxGL style layers.
Leaflet provides an option, when setting up your map, to hide the zoom controls
leaflet(options = leafletOptions(zoomControl = FALSE)
However, I would like to call this option after having already created a map so that a user can download the map without the zoom controls and without me having to re-create a different version of the map from scratch.
Here's a simple version of my app at the moment:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom) %>%
### HERE ###
mapshot(file = file)
}
)
}
shinyApp(ui, server)
I'd like to be able to add a line of code where I've commented ### HERE ### that would turn off zoom controls. In my actual code the displayed map is really complex with lots of options and I wouldn't want to have all that code twice just for the sake of removing zoom controls in the initial call to leaflet().
Thanks
You can do it like so:
library(shiny)
library(tidyverse)
library(leaflet)
library(mapview)
ui <- fluidPage(
fluidPage(
leafletOutput(outputId = "map"),
downloadButton(outputId = "save")
)
)
server <- function(input, output, session) {
map <- reactive({
leaflet() %>%
addTiles()
})
output$map <- renderLeaflet({
map()
})
output$save <- downloadHandler(
filename = "map.jpeg",
content = function(file){
latRng <- range(input$map_bounds$north,
input$map_bounds$south)
lngRng <- range(input$map_bounds$east,
input$map_bounds$west)
m = map() %>%
setView(lng = (lngRng[1] + lngRng[2])/2,
lat = (latRng[1] + latRng[1])/2,
zoom = input$map_zoom)
m$x$options = append(m$x$options, list("zoomControl" = FALSE))
mapshot(m, file = file)
}
)
}
shinyApp(ui, server)
which is updating the leaflet options after map creation. I will incorporate this in the mapshot function to optionally remove the zoomControl.
I have a shiny app where I need to add a png image in the instance of an observe event.
I can achieve this outside of Shiny, however, not within an observe function. I assume it has something to do with the map already being rendered?
I've simplified the example (hence just one png), but ideally I want to be able to quickly insert additional png's (i.e radar images)
library(shiny)
library(leaflet)
library(htmlwidgets)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "80%"),
p(),
actionButton("recalc", "Action")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
# Use leaflet() here, and only include aspects of the map that
# won't need to change dynamically (at least, not unless the
# entire map is being torn down and recreated).
leaflet() %>%
setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton")
})
points2 <- eventReactive(input$recalc, {
TRUE
}, ignoreNULL = FALSE)
# Use the onRender function to add a png
observe({
points <- points2()
leafletProxy("map") %>%
htmlwidgets::onRender("
function(el, x) {
console.log(this);
var myMap = this;
var imageUrl = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png';
var imageBounds = [[-25.58,150.71], [-30,155.88]];
L.imageOverlay(imageUrl, imageBounds).addTo(myMap);
}
")
print("pass")
})
}
shinyApp(ui, server)
### Working outside of leaflet
leaflet() %>%
setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton") %>%
htmlwidgets::onRender("
function(el, x) {
console.log(this);
var myMap = this;
var imageUrl = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png';
var imageBounds = [[-25.58,150.71], [-30,155.88]];
L.imageOverlay(imageUrl, imageBounds).addTo(myMap);
}
")
As is seems, the leafletProxy does not provide a means of accessing the Leaflet Api from the R side.
onRender definitely won't work since the whole point of leafletProxy is to not rerender the map.
The solution I found was to add a custom event handler on creation of the leaflet, using the onRender such that we have access to the Leaflet Api later on.
Using messages is of course kind of restricting, but if the way you want to render images (giving src and bounds) is always the same, it should suffice.
library(shiny)
library(leaflet)
library(htmlwidgets)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "80%"),
actionButton("recalc", "Action")
)
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
setView(lng = 153.240001, lat = -27.717732, zoom = 7) %>%
addProviderTiles(providers$OpenStreetMap) %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=153.240001, lat=-27.717732, popup="Mt Stapylton") %>%
htmlwidgets::onRender("
function(el, x) {
var myMap = this;
// Saving a copy of the overlay to remove it when the next one comes.
var overlay;
Shiny.addCustomMessageHandler('setOverlay', function(message) {
if (myMap.hasLayer(overlay)) myMap.removeLayer(overlay);
overlay = L.imageOverlay(message.src, message.bounds);
overlay.addTo(myMap);
});
}
")
})
observeEvent(input$recalc, {
session$sendCustomMessage("setOverlay", list(
src = 'https://www.google.com.au/images/branding/googlelogo/1x/googlelogo_color_272x92dp.png',
bounds = list(list(-25.58,150.71), list(-30,155.88))
))
})
}
shinyApp(ui, server)
I have an output from plotOutput and when there is a double click on the map, I want to see an output from leafletoutput. In the code below, when there is a double click on the map, the leaflet map shows below the google map. Before double click the the first image shows but after double clicking, I want to see the leaflet map only. Any suggestions on how to do this?
library(shiny)
library(shinydashboard)
library(leaflet)
library(dismo)
library(ggmap)
library(dplyr)
shinyApp(
ui = dashboardPage(
dashboardHeader(title=""),
dashboardSidebar(width = 200 ),
dashboardBody(
fluidRow(
plotOutput("USA_GoogleMap",dblclick='plot_dblclick'),
leafletOutput("leaflet_map")
)
)),
server=function(input, output, session) {
double_clicked <- reactiveValues(
center = NULL
)
# Handle double clicks on the plot
observeEvent(input$plot_dblclick, {
double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)
})
output$USA_GoogleMap<-renderPlot({
statesMap = map_data("state")
xy=cbind(statesMap$long,statesMap$lat)
y=c(36.4,41.5,42.25,27.7,32.77)
x=c(-115.5,-100,-75,-81.5,-97.45)
state=c("Nevada","Nebraska","New York","Florida","Texas")
bases=cbind(x,y)
bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)
g = gmap(xy, type='satellite',zoom=4)
plot(g, inter=TRUE)
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)
})
output$leaflet_map <- renderLeaflet({
if(!is.null(double_clicked$center)){
leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
}
})
}
)
shinyApp(ui = ui, server = server)
First Image
Second image
Let me first preface this by saying - there's a better way to do this than I'm showing. I just haven't found one yet. I'm sure a much better programmer than I would know of it, but at least I can say this works. Even though it's hideous. The key to hiding the plot was using conditionalPanel (which I was previously unfamiliar with).
I have a text trigger for identifying whether or not the plot was double-clicked, and use that to trigger whether or not to show the panel. However, I couldn't get the text to initialize without calling it with textOutput... so I have a textOutput call with a font size of zero. Again, there must be a much better way of triggering that than I'm doing it... but again, at least it works. Hopefully it will help.
library('shiny')
library('shinydashboard')
library('leaflet')
library('dismo')
library('ggmap')
library('dplyr')
shinyApp(
ui = dashboardPage(
dashboardHeader(title=""),
dashboardSidebar(width = 200 ),
dashboardBody(
fluidRow(
conditionalPanel(
condition = 'output.condition == 0',
plotOutput("USA_GoogleMap",dblclick='plot_dblclick')
),
leafletOutput("leaflet_map"),
textOutput('condition'),
tags$head(tags$style("#condition{font-size: 0px}"))
)
)),
server=function(input, output, session) {
double_clicked <- reactiveValues(
center = NULL
)
# Handle double clicks on the plot
observeEvent(input$plot_dblclick, {
double_clicked$center <- c(input$plot_dblclick$x,input$plot_dblclick$y)
})
output$USA_GoogleMap<-renderPlot({
if(is.null(double_clicked$center)){
statesMap = map_data("state")
xy=cbind(statesMap$long,statesMap$lat)
y=c(36.4,41.5,42.25,27.7,32.77)
x=c(-115.5,-100,-75,-81.5,-97.45)
state=c("Nevada","Nebraska","New York","Florida","Texas")
bases=cbind(x,y)
bases_mercator=data_frame(Mercator_X=Mercator(bases)[,1],Mercator_Y=Mercator(bases)[,2],State=state)
g = gmap(xy, type='satellite',zoom=4)
plot(g, inter=TRUE)
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("white", alpha=0.2))
points(Mercator(bases) , pch=20,cex=16, col=adjustcolor("yellow", alpha=0.4))
text(bases_mercator$Mercator_X,bases_mercator$Mercator_Y,state)
}
})
output$leaflet_map <- renderLeaflet({
if(!is.null(double_clicked$center)){
leaflet()%>%setView(lng = -71.0589, lat = 42.3601, zoom = 12)%>%addTiles()
}
})
output$condition <- renderText({
ifelse(!is.null(double_clicked$center), 1, 0)
})
}
)
I'm trying to put a pulsing marker from a leaflet plugin on a Shiny App Map.
It works very well on a basic R Studio Console, see here : Add a popup when clicked through to a 'plugin' pulsing marker in R Leaflet
But the following do not :
library(shiny)
library(leaflet)
library(htmltools)
library(htmlwidgets)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output, session) {
#js and css plugin files are stored locally, but you can access to them here :
# https://raw.githubusercontent.com/mapshakers/leaflet-icon-pulse/master/src/L.Icon.Pulse.js
# https://raw.githubusercontent.com/mapshakers/leaflet-icon-pulse/master/src/L.Icon.Pulse.css
esriPlugin <- htmlDependency("leaflet-icon-pulse",version = "1.0",
src = "C:/HOME/",
script = "L.Icon.Pulse.js",stylesheet ="L.Icon.Pulse.css")
registerPlugin <- function(map, plugin) {
map$dependencies <- c(map$dependencies, list(plugin))
map
}
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.DarkMatter") %>% setView(-122.4105513,37.78250256, zoom = 12) %>%
registerPlugin(esriPlugin) %>%
onRender("function(el,x) {
var pulsingIcon = L.icon.pulse({iconSize:[5,5],color:'red',heartbeat:0.5});
var pulsingIcon2 = L.icon.pulse({iconSize:[10,10],color:'orange',heartbeat:2});
var marker = L.marker([37.78,-122.41],{icon: pulsingIcon}).bindPopup('<b>Hello world!</b><br>I am a popup.').openPopup().addTo(this);
var marker = L.marker([37.75,-122.39],{icon: pulsingIcon2}).addTo(this);}")
})
}
shinyApp(ui, server)
Anyone see why it do not work?
This looks like indeed a bug in Shiny (or htmlwidgets), I created a reproducible example and filed an issue
https://github.com/rstudio/shiny/issues/1389