将传单导出到编织文档中的闪亮地图
Shiny mapshot to export leaflet into a knitted document
我有一个闪亮的应用程序，用于可视化各种数据。生成的地块之一是地图。我允许用户使用编织文档将所有图表一次性下载为单个 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$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
由于您没有包含 .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)
路径：
---
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
我有一个闪亮的应用程序，用于可视化各种数据。生成的地块之一是地图。我允许用户使用编织文档将所有图表一次性下载为单个 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$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
由于您没有包含 .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)
路径：
---
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