首页 文章

在Shiny中保存传单 Map

提问于
浏览
14

我在Shiny应用程序中创建了一个传单 Map . 现在我需要一个下载按钮,以便用户可以下载当前显示的 Map ,包括所有标记,多边形等作为pdf文件 .

我找到了这个解决方案如何在R中保存传单 Map :How to save Leaflet in R map as png or jpg file?

但它在Shiny中如何运作?我保持示例代码简单,但想到它,好像在用户想要将 Map 保存为pdf之前,通过leafletProxy()对 Map 进行了大量更改 .

这是我的尝试,但它不起作用 .

server.R

library(shiny)
library(leaflet)
library(devtools)
install_github("wch/webshot") # first install phantomjs.exe in your directory

library(htmlwidgets)
library(webshot)

server <- function(input, output){

  output$map <- renderLeaflet({
    leaflet() %>% addTiles()
  })

 observe({
    if(input$returnpdf == TRUE){
      m <- leafletProxy("map")
      saveWidget(m, "temp.html", selfcontained = FALSE)
      webshot("temp.html", file = "plot.pdf", cliprect = "viewport")
    }
  })

  output$pdflink <- downloadHandler(
    filename <- "map.pdf",
    content <- function(file) {
      file.copy("plot.pdf", file)
    }
  )
}

ui.R

ui <- fluidPage(
     sidebarPanel(
     checkboxInput('returnpdf', 'output pdf?', FALSE), 
     conditionalPanel(
       condition = "input.returnpdf == true",
       downloadLink('pdflink')
      ) 
     ), 
     mainPanel(leafletOutput("map"))
)

1 回答

  • 7

    我已经更新了我之前的答案,以便更清楚地说明如何使用包 mapview 中的mapshot . 此外,按照下面的Jake的问题,我注意到可能需要指定一个指向图块的链接(在addTiles中),或者可能会以灰色背景下载 Map .

    服务器

    server = function(input, output){
    
        mymap <- reactive({
          # here I have specified a tile from openstreetmap
          leaflet() %>% addTiles('http://{s}.tile.openstreetmap.de/tiles/osmde/{z}/{x}/{y}.png')
        })
    
        output$map <- renderLeaflet({
          mymap()
        })
    
        # function with all the features that we want to add to the map
        myfun <- function(map){
          addCircles(map,12.5,42,radius=500) %>% addMarkers(12,42,popup="Rome")
        }
    
        observe({
          leafletProxy("map") %>% myfun()
        })
    
        # map that will be downloaded
        mapdown <- reactive({
          # we need to specify coordinates (and zoom level) that we are currently viewing
          bounds <- input$map_bounds
          latRng <- range(bounds$north, bounds$south)
          lngRng <- range(bounds$east, bounds$west)
          mymap() %>% myfun() %>% setView(lng = (lngRng[1]+lngRng[2])/2, lat = (latRng[1]+latRng[2])/2, zoom = input$map_zoom)
        })
    
        output$map_down <- downloadHandler(
          filename = 'mymap.pdf',
    
          content = function(file) {
            # temporarily switch to the temp dir, in case you do not have write
            # permission to the current working directory
            owd <- setwd(tempdir())
            on.exit(setwd(owd))
    
            # using saveWidget and webshot (old)
            saveWidget(mapdown(), "temp.html", selfcontained = FALSE)
            webshot("temp.html", file = file, cliprect = "viewport")
    
            # using mapshot we can substitute the above two lines of code
            # mapshot(mapdown(), file = file, cliprect = "viewport")
          }
        )
      }
    

    UI

    ui <- fluidPage(
         sidebarPanel(
         checkboxInput('returnpdf', 'output pdf?', FALSE), 
         conditionalPanel(
           condition = "input.returnpdf == true",
           downloadButton('map_down')
          ) 
         ), 
         mainPanel(leafletOutput("map"))
    

相关问题