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)
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
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.
How do I add polygons from Global Administrative areas, so they are clickable.
The simple way describe in the docs that I tried is
adm <- getData('GADM', country='UKR', level=1)
leaflet() %>% addTiles() %>% addPolygons(data=adm, weight = 3, fillColor = col)
But imagine I want a leaflet map that will have onClick actions later.
Based on SuperZip, I need to have something similar to
map <- createLeafletMap(session, "map")
session$onFlushed(once=TRUE, function() {
map$addPolygon(...)
})
However, there is no addPolygon method and I am confused how will it work for SpartialPolygons.
I also tried converting to geoJSON, similar to https://ropensci.org/blog/2013/10/23/style-geojson-polygon/ or this SO question, but doing
polys <- fromJSON(<json data file>)
map <- createLeafletMap(session, "map")
session$onFlushed(once=TRUE, function() {
map$geoJson(polys)
})
Gives me an error
Error in func() : attempt to apply non-function
Is there a way to do it? Or what am I doing wrong?
I am not sure I really understand the problem, although I read through the question a couple of times. However the code below seems to work for me, as it can easily be combined with a simple onClick event, like a pop up displaying the name of each adm. unit:
---
title: "Ukraine"
runtime: shiny
output: html_document
---
```{r, echo=FALSE, message=F, warning=F}
library(leaflet)
library(raster)
adm <- getData('GADM', country='UKR', level=1)
popup <- paste0("<strong>Name: </strong>",
adm$NAME_1)
leaflet() %>%
addTiles() %>%
addPolygons(data=adm, weight = 2, fillColor = "yellow", popup=popup)
```