JS leaflet allows two maps to be synchronized. See an example of synchronized leaflet maps here.
I would like to implement synchronized leaflet maps in R and more specifially in Rmarkdown/knitr.
Preferably, the maps should shown next to each other horizontally (just like in the example).
Here is a minimal Rmarkdown (.Rmd) example of two maps I would like to sync.
The solution does not have to be based on the the mapview package. Any solution is welcome really (-:
---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---
```{r SETUP, include=FALSE}
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
```
```{r MAPS}
mapView(meuse, zcol="copper")#map # MAP 1
mapview(meuse, zcol="soil")#map # MAP 2
```
Here is a way to sync the two leaflet maps, but unfortunately it does not work in RStudio Viewer. This does work in Chrome and Firefox. There are lots of ways to make this much more robust. I tried to add comments in the R code below to explain what is happening.
---
title: "How to sync 2 leaflet maps"
author: "me"
date: "2 April 2016"
output: html_document
---
```{r SETUP, include=FALSE}
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
```
```{r MAPS}
mapView(meuse, zcol="copper")#map # MAP 1
mapview(meuse, zcol="soil")#map # MAP 2
```
```{r}
# crudely add the leaflet-sync plugin
# attachDependency with the rawgit gave me
# errors so just do this for now
# could easily add to a package
# or make a mini package to import this
# dependency
tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)
```
```{r}
# this is one of the new htmlwidgets methods
# to add some code after all htmlwidgets are rendered
# this is very useful since we need all htmlwidgets rendered
# before we can sync
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
```
Here is how we can do the same thing in straight R code.
# http://stackoverflow.com/questions/36373842/synchronizing-two-leaflet-maps-in-r-rmarkdown
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")#map # MAP 1
map2 <- mapview(meuse, zcol="soil")#map # MAP 2
tagList(
tags$head(tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)),
map1,
map2,
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
) %>%
browsable
And if you want it side-by-side, here is the basic way to accomplish. We could leverage shiny::fluidPage, fluidRow, and column to get boostrap, but the css/js is really heavy for just side-by-side placement.
# get the latest htmlwidgets
# devtools::install_github("ramnathv/htmlwidgets")
library("htmlwidgets")
library("htmltools")
library("shiny")
library("mapview")
library("sp")
# load example data
data(meuse)
coordinates(meuse) <- ~x+y
proj4string(meuse) <- CRS("+init=epsg:28992")
map1 <- mapView(meuse, zcol="copper")#map # MAP 1
map2 <- mapview(meuse, zcol="soil")#map # MAP 2
tagList(
tags$head(tags$script(
type="text/javascript",
src="https://cdn.rawgit.com/turban/Leaflet.Sync/master/L.Map.Sync.js"
)),
tags$div(style="display:inline;width:50%;float:left;",map1),
tags$div(style="display:inline;width:50%;float:left;",map2),
onStaticRenderComplete(
'
var leaf_widgets = Array.prototype.map.call(
document.querySelectorAll(".leaflet"),
function(ldiv){
return HTMLWidgets.find("#" + ldiv.id);
}
);
// make this easy since we know only two maps
leaf_widgets[0].sync(leaf_widgets[1]);
leaf_widgets[1].sync(leaf_widgets[0]);
'
)
) %>%
browsable
Note, we have implemented the answer provided by #timelyportfolio in package mapview so that this is now easily achievable using mapview::sync(). See ?mapview::sync for instructions and examples.
Related
I have a loop that clips to different features and the ceramic package downloads a basemap for each feature and then the map is printed using the tmap package. In an html or pdf output in Rmarkdown, I can use {r map, results = 'hide', fig.keep='all'} to hide ceramic's "Preparing to download..." messages. The maps print, but the messages don't (exactly what I want). However, using pagedreport, that method doesn't work. No maps print.
I tried wrapping the ceramic part suppressWarnings(suppressMessages(suppressPackageStartupMessages({basemap})))
And setting options(warn=-1) at the beginning of the chunk
Neither work. Any other suggestions?
You'd need your own mapbox API key to run this. The output is ugly, but gets the point across.
Reproducible loop:
---
title: "nc"
date: "`r Sys.Date()`"
output:
pagedreport::paged_windmill:
knit: pagedown::chrome_print
---
```
{r libs, include = F}
library(raster)
library(sp)
library(tidyverse)
library(ceramic)
library(tmap)
library(maps)
```
```
{r individual-maps, echo=FALSE, error=TRUE, message=FALSE, warning=FALSE, results='asis', fig.keep='all'}
#get practice shapefile
nc <- sf::read_sf(system.file("shape/nc.shp", package="sf"))
#get list of unique trail numbers
#unique_county_names <- unique(nc$NAME)
unique_county_names <- c("Ashe", "Alleghany", "Surry") # created a short list for simplicity
#set Mapbox API key for the session
Sys.setenv(MAPBOX_API_KEY = "need your own")
for (i in 1:length(unique_county_names)) {
county <-
filter(nc, NAME == unique_county_names[i])
# set basemap
basemap = ceramic::cc_location(loc =
extent(sf::st_transform(
county, 4326
)),
base_url = "https://api.mapbox.com/styles/v1/mapbox/outdoors-v12/tiles/{zoom}/{x}/{y}")
county_map <- tm_shape(basemap) +
tm_rgb() +
tm_shape(county) +
tm_polygons()
print(county_map)
}
```
I figured out it was a cat() output which then led me to this post How to hide or disable in-function printed message
and the answer by Ben, credited to Hadley Wickham:
quiet <- function(x) {
sink(tempfile())
on.exit(sink())
invisible(force(x))
}
so then I wrapped it around the basemap:
basemap = quiet(ceramic::cc_location(loc =
extent(sf::st_transform(
county, 4326
)),
base_url = "https://api.mapbox.com/styles/v1/mapbox/outdoors-v12/tiles/{zoom}/{x}/{y}"))
No more messages!
I am trying to mimic or figure out how a similar function as leafletProxy works in mapview package inside a Shiny app (flexdashboard). The idea is that I have a parameterized database query that fetches a sf dataset (~4200 polygons) based on user inputs and then plots in mapview. However, it appears that everytime this is done the entire map is redrawn?
Below is a reproducible example using the default franconia dataset and a shiny input to control the line opacity. I also include my code (commented out) to show an example of how it will be used as intended (i.e. to dynamically redraw a polygon layer based on a database fetch)
Is there a way in shiny to draw a "base" map of all the background maps stylings once and then only redraw the new polygon data as they are retrieved?
Thanks!
---
title: "MRE"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
runtime: shiny
---
```{r setup, include=FALSE}
library(flexdashboard)
library(mapview)
library(shiny)
library(leaflet)
#library(RSQLite)
#library(sf)
```
Sidebar {.sidebar}
-----------------------------------------------------------------------
```{r}
# This is shiny input that will trigger entire map redraw
sliderInput("gridlines", "Grid Line Opacity", 0, 1, 0, step = 0.1, ticks = FALSE)
```
```{r}
### THIS IS MY ACTUAL CODE...For reference
# sp_grid <- reactive({
# db <- "../data/modeldata.db"
# con <- dbConnect(SQLite(), db )
#
# # set the sql based on user input
# sql <- 'SELECT id, Time,Cell_I, Cell_J, Cell_K, Cell_Botdepth_M, Zmax, Salinity, WKT_GEOMETRY
# FROM vwGridTK
# WHERE Time = :time
# AND Cell_K = :layer'
#
# df.grid <- dbGetQuery(con, sql, params = list(time = 0,
# layer = 1))
# dbDisconnect(con)
#
# st_as_sf(df.grid, wkt = "WKT_GEOMETRY") %>% st_set_crs(4326)
#
# })
```
Column {data-width=500}
-----------------------------------------------------------------------
### Reproducible Example
NOTE the shiny input to control opacity
```{r}
renderLeaflet({
m <- mapview(franconia, zcol = "district", alpha = input$gridlines)
m#map
})
```
Column {data-width=500}
-----------------------------------------------------------------------
### My Example
```{r}
# renderLeaflet({
# m <- mapview(sp_grid(), zcol = "Salinity",
# legend = TRUE, alpha = input$gridlines)
#
# m#map
#
# })
```
I'm trying to create an interactive document like the tutorial on Shiny's website. However, I want the plot to be a Leaflet map. Following the Leaflet tutorial, it seems like the following should work using leaflet::renderLeaflet() instead of shiny::renderPlot().
Instead, I get an error when running the document: Error: object 'input' not found. Is there a special way to expose input to leaflet when using Shiny widgets inside an interactive Rmarkdown document?
---
runtime: shiny
output: html_document
---
```{r echo = FALSE}
library(magrittr)
shiny::selectInput(
"weight", label = "Weight:",
choices = c(1, 2, 3, 4, 5), selected = 5
)
```
```{r include = FALSE}
csa <- tigris::combined_statistical_areas(class = "sf")
```
```{r echo = FALSE}
leaflet::renderLeaflet({ # <- main difference from tutorial
leaflet::leaflet() %>%
leaflet::addTiles() %>%
leaflet::addPolylines(data = csa, color = '#333', weight = input$weight)
})
```
I can't confirm your issue. Your sample interactive document runs just fine:
I've been using the following library versions on R 3.6.1
leaflet_2.0.2
rmarkdown_1.16
shiny_1.4.0
I am currently fighting trying to get knitr to render my leaflet maps, taken from a collection to appear correctly in a rendered RMD html-output. I'm already aware about some potential problems when looping throug collections and generating graphical output with RMD/knitr, but still I can't figure out, how to make my example work for leaflet-maps.
Reproducible working example (Test_1.Rmd):
---
title: "test1"
author: "phabee"
date: "22 Mai 2018"
output: html_document
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r, fig.show='asis', echo=FALSE, results='asis'}
for (i in 1:4) {
cat("### Plot Number ", i, "\n")
plot(1,1)
# use plot.new() here to force rendering of potential plot-duplicates
plot.new()
cat("\n\n")
}
```
The above example renders as expected (at least after adding plot.new(), which I've learned here from Freedomtowin). But when I try to do the same with leaflet-maps, it doesn't work at all. No single map is being rendered:
Reproducible failing example (Test_2.Rmd)
---
title: "test2"
author: "phabee"
date: "22 Mai 2018"
output: html_document
---
```{r setup, include=FALSE}
library(leaflet)
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r, fig.show='asis', echo=FALSE, results='asis'}
for (i in 1:4) {
cat("### Map Number ", i, "\n")
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
cat("\n")
}
```
I would expect the second Rmd to render 4 times the same map, showing different titles ("Plot Number 1-4"). But the output doesn't render any map at all. The output looks as follows:
After inspecting the generated html-output the output, it can be seen that there is nothing rendered at all and it's not just a visibility-issue:
However, when I evaluate the leaflet-section within the 2nd Rmd directly by 'highlighting' the code and hitting ctrl-Enter, the map renders as expected:
I already tried to
convert the leaflet-statement to an assignment statement
introduce cat() or print() commands to force map-output
play around with additional newline-characters '\n' before and/or after the map output section
fiddle around with the 'asis' directives from fig.show or results
without any effect. Does anyone have a clue here?
You need to put things in a tagList, and have that list print from the chunk. This just uses default settings for fig.show and results; it also uses the htmltools::h3() function to turn the title into an HTML title directly, not using the Markdown ### marker. (You might want h2 or h4 instead.)
---
title: "test3"
output: html_document
---
```{r setup, include=FALSE}
library(leaflet)
library(htmltools)
knitr::opts_chunk$set(echo = TRUE)
```
## Title 1
```{r echo=FALSE}
html <- list()
for (i in 1:4) {
html <- c(html,
list(h3(paste0("Map Number ", i)),
leaflet() %>%
addTiles() %>% # Add default OpenStreetMap map tiles
addMarkers(lng=174.768, lat=-36.852, popup="The birthplace of R")
)
)
}
tagList(html)
```
Intro:
I am trying to embed a leaflet map into a revealjs presentation within an RMarkdown file. My example below is pretty close, but it is (1) missing tiles, (2) the popups are not displaying, and (3) the legend and font are way too big!
I am not too concerned with how the code blocks look at the moment. I'm planning on using the results = "hide" slide option for my final product.
Thanks in advance!
Reproducible Example:
---
title: "My Presentation"
author: Me
date: 2017-06-23
output:
revealjs::revealjs_presentation:
theme: black
---
## Loading in necessary packages:
```{r}
library(dplyr)
library(sp)
library(rgdal)
library(rgeos)
library(RColorBrewer)
library(classInt)
library(leaflet)
library(htmlwidgets)
```
## Defining our data:
```{r}
lat <- c(45.51158000, 45.50431159, 45.496539)
lon <- c(-122.548056, -122.54775, -122.54788)
no2 <- c(17.37, 25.61, 24.69)
dta <- data.frame(lat, lon, no2)
colnames(dta) <- c("lat","lon","no2")
```
## Create layer of spatial points:
```{r}
points <- SpatialPointsDataFrame(data.frame(x=dta$lon, y=dta$lat), data = data.frame(dta$no2))
plotclr <- (brewer.pal(7, "RdYlGn"))
class <- classIntervals(dta$no2, n = 7, style = "fixed", fixedBreaks = c(0,5,10,15,20,25,30))
colcode <- findColours(class, rev(plotclr))
plot(points, col=colcode, pch=19)
pop1<-paste0("<b>NO2:</b> ", dta$no2, " ppb",
"<br /> <b>Lat:</b> ", dta$lat,
"<br /> <b>Lon:</b> ", dta$lon)
```
## Creating the leaflet map:
```{r}
no2_map <-leaflet()%>%
addTiles('http://{s}.tiles.wmflabs.org/bw-mapnik/{z}/{x}/{y}.png') %>%
addCircleMarkers(data=points, color = "black", radius = dta$no2, fillColor = colcode, fillOpacity=0.7, weight=1, popup=pop1) %>%
addLegend(position = "bottomright", colors = rev(plotclr), labels = rev(c("30","25","20","15","10","5","0")), opacity = 0.9, title = "NO2 (ppb)")
```
---
```{r}
no2_map
saveWidget(no2_map, file="map.html")
```
Unfortunately, reveal.js and Leaflet don't play very well together, and the slide with your maps might be missing layers. This is due to Leaflet not being able to discern the size of the DOM element which serves as the container of the map, because reveal.js resizes all elements dinamically.
The easiest workaround is to just refresh the page when you're in a slide with a Leaflet map. You can also try a deferred call to map.invalidateSize() (by using setTimeout() in plain Javascript)