问题描述
我有一个闪亮的应用程序，用于可视化各种数据。产生的图之一是地图。我允许用户使用编织文档将所有绘图作为单个 Word 文档一次下载。我想在文档中包含地图，但不知道如何做到这一点。我可以使用单独的 downloadHandler 导出地图本身的 png（或 pdf），但理想情况下希望将地图包含在主文档中。任何帮助将不胜感激...如果有人对下载的地图范围（似乎与屏幕上的地图范围不匹配）有任何提示，那也太棒了。
我愿意使用 officer 将下载的地图导入到新创建的 doc 文件中，但不知道如何 a) 使用单个 downloadHandler 来完成，以及 b)告诉R如何处理最新下载的地图名称。
# 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$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 文件：
---
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
解决方法
由于您没有包含 .docx 模板，我使用 html 文件作为示例。
我的策略是将地图保存为我知道路径的临时文件。然后我可以将路径作为参数传递给 .Rmd 文件，并使用 knitr::include_graphics
应用：
# 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$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$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,fig.height = 3.5}
knitr::include_graphics(params$Map)
```
Map exports ok