Overlay an image in a shiny leaflet observe event - r

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)

Related

R Shiny: Can't run JS code in a leafletProxy instance

I have shinyapp where I have a leaflet map. I want users to be able to click on the polygons and highlight them right away - while unhighlighting the previous polygon. I successfully do this using some JS code after the leaflet call with htmlwidgets::onRender:
library(shiny)
library(leaflet)
library(htmlwidgets)
library(sf)
library(dplyr)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "80%")
)
server <- function(input, output, session) {
data <- st_read(system.file("shape/nc.shp", package="sf")) %>% st_transform(4326)
output$map <- renderLeaflet({
pal <- colorNumeric(
palette = "Blues",
domain = data$AREA)
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(data = data,
fillColor = ~pal(data$AREA), fillOpacity = 0.5) %>%
htmlwidgets::onRender("
function(el, x) {
L.control.zoom({
position: 'topright'
}).addTo(this);
var map = this;
var prevLayerClicked = null;
map.eachLayer(function(layer) {
layer.on('click', function(e) {
if (prevLayerClicked == null) {
layer.setStyle({
fillOpacity: 1
});
} else if (prevLayerClicked !== null) {
layer.setStyle({
fillOpacity: 1
});
prevLayerClicked.setStyle({
fillOpacity: 0.5
});
}
prevLayerClicked = layer;
})
.addTo(map);
});
}
")
})
}
shinyApp(ui, server)
But my application has a lot of variables and I wanted to be able to change the map using leafletProxy. But as soon as I implement some observer with leafletProxy (in that case, I created a dummy button to reset the colors), the highlighting function stops working. Same previous example, but now with the observer:
library(shiny)
library(leaflet)
library(htmlwidgets)
library(sf)
library(dplyr)
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "80%"),
actionButton(inputId = "reset", label = "Reset Colors")
)
server <- function(input, output, session) {
data <- st_read(system.file("shape/nc.shp", package="sf")) %>% st_transform(4326)
output$map <- renderLeaflet({
pal <- colorNumeric(
palette = "Blues",
domain = data$AREA)
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addPolygons(data = data,
fillColor = ~pal(data$AREA), fillOpacity = 0.5) %>%
htmlwidgets::onRender("
function(el, x) {
L.control.zoom({
position: 'topright'
}).addTo(this);
var map = this;
var prevLayerClicked = null;
map.eachLayer(function(layer) {
layer.on('click', function(e) {
if (prevLayerClicked == null) {
layer.setStyle({
fillOpacity: 1
});
} else if (prevLayerClicked !== null) {
layer.setStyle({
fillOpacity: 1
});
prevLayerClicked.setStyle({
fillOpacity: 0.5
});
}
prevLayerClicked = layer;
})
.addTo(map);
});
}
")
})
observeEvent(c(input$reset), {
req(input$reset >= 1)
leafletProxy("map") %>%
clearShapes() %>%
addPolygons(data = data)
})
}
shinyApp(ui, server)
I have seen some hints like here and here, but couldn't understand the approaches.
Any idea how to solve this?

R - Leaflet WMTS layer is not rendering

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)

R Leaflet Offline Tiles within Shiny

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

Click event on Leaflet tile map in Shiny

Is it possible to get the lat long from a click event in leaflet/shiny (in R) from the tile map? (i.e. NOT from any loaded markers, polygons etc). Just to show positional (lat/long) info i guess.
I thought maybe from this qu it was possible but no luck.
ui <- bootstrapPage(
tags$style(type = "text/css", "html, body {width:100%;height:100%}"),
leafletOutput("map", width = "100%", height = "100%")
)
server <- function(input, output,session) {
output$map <- renderLeaflet({
leaflet() %>%
addProviderTiles("CartoDB.Positron")%>%
setView(lng = -4, lat= 52.54, zoom = 7)
})
#Show popup on click
observeEvent(input$map_marker_click, {
click <- input$map_marker_click
text<-paste("Lattitude ", click$lat, "Longtitude ", click$lng)
proxy <- leafletProxy("map")
proxy %>% clearPopups() %>%
addPopups(click$lng, click$lat, text)
})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
Ultimately i want to create a click marker for raster data (using the returned lat/long) in Leaflet & Shiny but this would be a good start (This qu seems to have done something but i cannot recreate it at all).

htmlwidget onRender function does not work in R Shiny

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

Resources