R 将传单导出为针织文档的闪亮地图快照

我有一个闪亮的应用程序，用来可视化各种数据。其中一幅图是一张地图。我允许用户使用编织文档一次下载所有绘图，作为单个Word文档。我想在文档中包括地图，但不知道怎么做。我可以使用单独的

下载处理程序

导出地图本身的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)

---

由于您没有包含

.docx

模板，因此我使用了

html

文件作为示例

我的策略是将地图保存为一个临时文件，我知道它的路径。然后我可以将路径作为参数传递给

.Rmd

文件，并使用

knitr:：include_graphics

应用程序：

---

我希望这不足以证明它自己的问题——在本地运行时，您的答案非常有效，但我在knitr:：include_graphics:找不到文件“/tmp/RtmpgOjQ2k/map.png”错误，一旦我在shinyapps.io上运行应用程序。有关于解决此问题的提示吗？没关系，解决了它-显然缺少

webshot

依赖项（）

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

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

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