问题描述

我有一个正在下载地图的应用程序。我很困惑为什么下载图像的空间范围/缩放与屏幕上显示的内容如此不同。寻找任何建议以使输出与应用程序本身中显示的地图尽可能接近...

library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)

# reproducible example of the shiny app
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){

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

    output$map <- renderLeaflet({
      mymap() })

    myfun <- function(map, df.in){
      addCircleMarkers(map, data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 4, color = "red")  
                                            }                           
    observe({
      leafletProxy("map") %>% myfun(df)
    })
    
    # map that will be downloaded
    mapdown <- reactive({
     mymap() %>% myfun(df) 
    })
                        
    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")), 
     mainPanel(leafletOutput("map")))

shinyApp(ui = ui, server = server)

编辑

按照@HubertL 的建议，我花了很长时间定义和重新定义视口大小（以及剪辑选项），并尝试了这个和那个，直到我最终发现我实际上只发生了这个问题myfun（函数实际上使情节）包括fitBounds，我需要用户能够在放大后导出图形。所以 - 我正在更新问题，代码显示答案中提出的剪辑完美无缺，除非是fitBounds()包括。如何在用户缩放后导出地图？

library(shiny)
library(dplyr)
library(leaflet)
library(mapview)
library(ggplot2)

df <- structure(list(Lon = c(-105.618, -105.505, -105.671, -105.737, -105.318, -105.747, -105.693, -105.126, -104.975, -105.297), Lat = c(23.851, 23.646, 24.085, 24.063, 23.378, 24.253, 23.965, 23.153, 23.127, 23.33), Size = c(4, 1, 4, 4, 2, 3, 4, 1, 1, 3)), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"))
            
ui <- navbarPage("My app", id = "nav", 
      fluidRow(column(width = 8, 
        leafletOutput("map", height = "800px")),
        column(width = 4, 
            downloadButton('ExportMap', label = "Download the map"))))          

myfun <- function(map, df.in, bounds){
    latRng <- range(bounds$north, bounds$south)
    lngRng <- range(bounds$east, bounds$west)
        
    clearShapes(map) %>%
        clearMarkers() %>%
        clearControls() %>%
        addCircleMarkers(data = df.in, lng = df.in$Lon, lat = df.in$Lat, radius = ~Size * 3) %>%
        ## This is the culprit - export works well if this is commented out
    #   fitBounds(min(lngRng), min(latRng), max(lngRng), max(latRng)) 
                              }
                                                                
server <- function(input, output, session){
    mymap <- reactive({
      leaflet(df, options = leafletOptions(
            attributionControl=FALSE)) %>%
        setView(lng = -105.5, lat = 23.7, zoom = 8) %>%
        addProviderTiles("Esri.WorldImagery", layerId = "basetile",
            options = providerTileOptions(minZoom = 7, opacity = 0.75))
                                }) 
    
    output$map <- renderLeaflet({
        mymap()
                                }) 
                                
bounds.calc <- reactive({
            bounds <- input$map_bounds
            zoom <- input$map_zoom
            cen <- input$map_center
            
            output <- list(bounds = bounds, zoom = zoom, center = cen)
                    })
                    
observe({
        leafletProxy("map") %>% myfun(df, bounds = bounds.calc()$bounds)        
                                    }) 

# map that will be downloaded
  mapdown <- reactive({
    mymap() %>% myfun(df, bounds = bounds.calc()$bounds) 
  })
  
output$ExportMap <- downloadHandler(
      filename = 'mymap.png',

      content = function(file) {
        owd <- setwd(tempdir())
        on.exit(setwd(owd))
        mapshot(mapdown(), file = file, cliprect = "viewport", vwidth= 800, vheight = 600)
                        })}

shinyApp(ui = ui, server = server)

标签： rshinyleaflet

r - 闪亮的传单 - 下载地图的范围

问题描述

编辑

解决方案

推荐阅读