r-闪亮的mapshot将传单导出为针织文件

Question

我有一个闪亮的应用程序，用来可视化各种数据。其中一幅图是地图。我允许用户使用编织文档将所有绘图作为单个Word文档一次下载。我想把地图包括在文件中，但不知道怎么做。我可以用单独的downloadHandler导出地图本身的png(或pdf(，但理想情况下希望地图包含在主文档中。任何帮助都将不胜感激。。。如果有人对下载地图的范围有提示(这似乎与屏幕上地图的范围不匹配(，那也太棒了。

我对使用officer将下载的地图导入到新创建的文档文件持开放态度，但不知道如何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$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文件：

---
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

Answer 1

由于您还没有包含.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$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