I have a shiny app I'm using to visualize a variety of data. One of the plots produced is a map. I'm allowing the user to download all the plots at once as a single Word doc using a knitted document. I would like to include the map in the document, but can't figure out how to do that. I can export a png (or pdf) of the map itself with a separate downloadHandler, but ideally want the map included in the main doc. Any help would be high appreciated... If anyone has tips for the extent of the downloaded map (which does not seem to match the extent of the map on the screen), that would also be awesome.
I'm open to using officer to import the downloaded map into the newly created doc file, but can't figure out how to a) do it with a single downloadHandler, and b) tell R how to handle the name of the latest download of the map.
# reproducible example of the shiny app, mimicking the functionality and structure of the full app.
library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)
df <- structure(list(Lon = c(-111.584650079555, -112.17670350598, -111.585725614472, -112.173232931394, -111.772792415394), Lat = c(41.7797872701221, 43.0098749960118, 41.7489995541869, 43.0096673539034, 42.1053681392244), Size = c(1:5)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame"))
server = function(input, output){
# baseline map
mymap <- reactive({
leaflet(df) %>%
setView(lng = -111.6, lat = 41.8, zoom = 8) %>%
addProviderTiles("Esri.WorldImagery", layerId = "basetile",
options = providerTileOptions(minZoom = 8, opacity = 0.75)) })
# to be able to use leafletproxy
output$map <- renderLeaflet({
mymap() })
# quick plot to show how I'm exporting my actual plots
plot.calc <- reactive({
p <- ggplot(df) + geom_point(aes(x = Lon, y = Lat))
return(p) })
output$plot <- renderPlot({
plot.calc() })
# helper function to use with leafleproxy, to allow for export of the user-created map
myfun <- function(map, df.in, bounds){
bounds <- InBounds()$bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
addCircleMarkers(map, data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 4, color = "red") %>%
fitBounds(min(lngRng), min(latRng), max(lngRng), max(latRng))
}
# pull out data within the zoomed-in boundarier of the map
InBounds <- reactive({
req(input$map_bounds)
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
df.in <- df %>%
filter(Lat >= latRng[1], Lat <= latRng[2],
Lon >= lngRng[1], Lon <= lngRng[2])
output <- list(df.in = df.in, bounds = bounds)
})
# update map with the data within the map boundarier
observe({
leafletProxy("map") %>% myfun(InBounds()$df.in)
})
# map that will be downloaded
mapdown <- reactive({
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
mymap() %>% myfun(InBounds()$df.in)
})
# handler for downloading all plots (but not maps)
output$plot_down <- downloadHandler(
filename = 'Plots.docx',
content = function(file) {
src <- normalizePath(c('Plots.Rmd', 'template_word2.docx')) # SEE HERE
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, c('Plots.Rmd', 'template_word2.docx'), overwrite = TRUE) # SEE HERE
params <- list(Plot = plot.calc())
Sys.setenv(RSTUDIO_PANDOC="C:/Program Files/RStudio/bin/pandoc")
out <- rmarkdown::render('Plots.Rmd', output_file = file, params = params, envir = new.env(parent = globalenv()))
file.rename(out, file)
})
# handler showing that I can download a png of the map itself
output$map_down <- downloadHandler(
filename = 'mymap.png',
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
mapshot(mapdown(), file = file, cliprect = "viewport")
})}
ui <- fluidPage(
sidebarPanel(downloadButton('map_down', "Download map"),
downloadButton('plot_down', "Download plots")),
mainPanel(leafletOutput("map"),
plotOutput("plot")))
shinyApp(ui = ui, server = server)
Rmd file:
---
title: "Title"
output:
word_document:
reference_docx: template_word2.docx
params:
Plot: NA
---
```{r, echo = FALSE, warning = FALSE, fig.width = 6.4, fig.height = 3.5}
params$Plot
```
Plot exports ok
As you haven't included the .docx template, I've use a html file as example.
My strategy is to save the map as a temporary file where I know the path to. Then I can pass the path as an argument to the .Rmd file and include the image with knitr::include_graphics
App:
# reproducible example of the shiny app, mimicking the functionality and structure of the full app.
library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)
df <- structure(list(Lon = c(-111.584650079555, -112.17670350598, -111.585725614472, -112.173232931394, -111.772792415394), Lat = c(41.7797872701221, 43.0098749960118, 41.7489995541869, 43.0096673539034, 42.1053681392244), Size = c(1:5)), row.names = c(NA, -5L), class = c("tbl_df", "tbl", "data.frame"))
server = function(input, output){
# baseline map
mymap <- reactive({
leaflet(df) %>%
setView(lng = -111.6, lat = 41.8, zoom = 8) %>%
addProviderTiles("Esri.WorldImagery", layerId = "basetile",
options = providerTileOptions(minZoom = 8, opacity = 0.75)) })
# to be able to use leafletproxy
output$map <- renderLeaflet({
mymap() })
# quick plot to show how I'm exporting my actual plots
plot.calc <- reactive({
p <- ggplot(df) + geom_point(aes(x = Lon, y = Lat))
return(p) })
output$plot <- renderPlot({
plot.calc() })
# helper function to use with leafleproxy, to allow for export of the user-created map
myfun <- function(map, df.in, bounds){
bounds <- InBounds()$bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
addCircleMarkers(map, data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 4, color = "red") %>%
fitBounds(min(lngRng), min(latRng), max(lngRng), max(latRng))
}
# pull out data within the zoomed-in boundarier of the map
InBounds <- reactive({
req(input$map_bounds)
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
df.in <- df %>%
filter(Lat >= latRng[1], Lat <= latRng[2],
Lon >= lngRng[1], Lon <= lngRng[2])
output <- list(df.in = df.in, bounds = bounds)
})
# update map with the data within the map boundarier
observe({
leafletProxy("map") %>% myfun(InBounds()$df.in)
})
# map that will be downloaded
mapdown <- reactive({
bounds <- input$map_bounds
latRng <- range(bounds$north, bounds$south)
lngRng <- range(bounds$east, bounds$west)
mymap() %>% myfun(InBounds()$df.in)
})
# handler for downloading all plots (but not maps)
output$plot_down <- downloadHandler(
filename = 'Plots.html',
content = function(file) {
src <- normalizePath(c('Plots.Rmd')) # SEE HERE
owd <- setwd(tempdir())
on.exit(setwd(owd))
file.copy(src, c('Plots.Rmd'), overwrite = TRUE) # SEE HERE
# save map in tempfile
map_path <- paste0(tempdir(), "/map.png")
mapshot(mapdown(), file = map_path, cliprect = "viewport")
params <- list(Plot = plot.calc(),
Map = map_path)
Sys.setenv(RSTUDIO_PANDOC="C:/Program Files/RStudio/bin/pandoc")
out <- rmarkdown::render('Plots.Rmd', output_file = file, params = params, envir = new.env(parent = globalenv()))
file.rename(out, file)
})
# handler showing that I can download a png of the map itself
output$map_down <- downloadHandler(
filename = 'mymap.png',
content = function(file) {
owd <- setwd(tempdir())
on.exit(setwd(owd))
mapshot(mapdown(), file = file, cliprect = "viewport")
})}
ui <- fluidPage(
sidebarPanel(downloadButton('map_down', "Download map"),
downloadButton('plot_down', "Download plots")),
mainPanel(leafletOutput("map"),
plotOutput("plot")))
shinyApp(ui = ui, server = server)
Rmd:
---
title: "Untitled"
author: "test"
date: "23 3 2021"
output: html_document
params:
Plot: NA
Map: NA
---
```{r, echo = FALSE, warning = FALSE, fig.width = 6.4, fig.height = 3.5}
params$Plot
```
Plot exports ok
```{r, echo = FALSE, warning = FALSE, fig.width = 6.4, fig.height = 3.5}
knitr::include_graphics(params$Map)
```
Map exports ok