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
Related
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.
I'm working on adding a WMTS layer to my R Leaflet map using this url:
https://mrdata.usgs.gov/mapcache/wmts?layer=alteration&service=WMTS&request=GetCapabilities&version=1.0.0
I add the url into my code under the "addWMSTiles" option in R Leaflet like such:
library(shiny)
library(leaflet)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4) %>%
addWMSTiles("https://mrdata.usgs.gov/mapcache/wmts?layer=alteration&service=WMTS&request=GetCapabilities&version=1.0.0",
layers = "sim3340",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
When I run this code the map will display in the browser but all that displays is the base leaflet (OpenStreets) Map (image below).
When there should be some coloring around CA and AZ since that's that WMTS layer is highlighting.
At first I thought it may be due to there being 3 different projection matrices in the WMTS layer but even if I call crs = "EPSG:6.3:3857" in the addWMSTiles options it still shows up as the base map.
What do I need to change or add to make this WMTS layer show up on the map?
Thank you and as always any help is appreciated!
This should do it. The call to your baseUrl was not correct.
library(shiny)
library(leaflet)
ui <- shinyUI(
fluidPage(
leafletOutput("map", width = "100%", height = "900px")
)
)
server <- function(input, output) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
setView(-93.65, 42.0285, zoom = 4) %>%
addWMSTiles(baseUrl = "https://mrdata.usgs.gov/mapcache/wms/",
layers = "sim3340",
options = WMSTileOptions(format = "image/png", transparent = TRUE),
attribution = "")
})
}
app <- shinyApp(ui = ui, server = server)
runApp(app, launch.browser = TRUE)
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)
Is it possible to load offline/local leaflet map tiles within a Shiny app? I am able to load the tiles in an interactive R session as shown here, but I now want to try and load them for use in a Shiny app. Here's an example of what I have so far. I'm thinking it has something to do with Shiny running through an IP and port and needing to load the tiles through an IP and port as well. I've tried a few things to change IPs and ports (making them the same) as explained here but haven't figured out anything that works. I can also get it to work using online tiles, but I need it to work with local map tiles.
library(shiny)
library(leaflet)
library(RColorBrewer)
library(RgoogleMaps)
options(shiny.port = 8000)
(bwi <- getGeoCode("BWI;MD"))
df <- as.data.frame(rbind(bwi))
df$col <- c("orange")
df$name <- c("BWI")
icons <- awesomeIcons(
icon = 'ios-close',
iconColor = 'black',
library = 'ion',
markerColor = df$col
)
#################################################################################
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%"),
absolutePanel(top = 10, right = 10,
style = "padding: 8px; background: #FFFFEE; opacity:.9",
checkboxInput("markers", "Show Markers?", TRUE)
)
)
#################################################################################
server <- function(input, output, session) {
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "http:/localhost:8000/C:/Users/OTAD USER/Documents/mapTiles/ESRIWorldTopoMap/{z}_{x}_{y}.png") %>%
setView(lat = bwi[1], lng = bwi[2], zoom = 8)
})
observe({
proxy <- leafletProxy("map", data = df)
# Remove/show any markers
proxy %>% clearMarkers()
if (input$markers) {
proxy %>% addAwesomeMarkers(lat = df$lat, lng = df$lon,
icon = icons, label = df$name)
}
})
}
#Put the ui and server together and run
runApp(shinyApp(ui = ui,
server = server), launch.browser=TRUE
)
1- You have to authorize shiny to serve tiles in that folder by providing an "alias" on the ressource with addResourcePath
2- then use that alias as the base URL in addTiles
server <- function(input, output, session) {
addResourcePath("mytiles", "C:/Users/OTAD USER/Documents/mapTiles/ESRIWorldTopoMap")
output$map <- renderLeaflet({
leaflet() %>%
addTiles(urlTemplate = "/mytiles/{z}_{x}_{y}.png") %>%
setView(lat = bwi[1], lng = bwi[2], zoom = 8)
})
...