简体   繁体   中英

Shiny mapshot to export leaflet into a knitted document

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
  

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM