如何在Shiny中保存一个leaflet地图

7

继承于这个问题,我想要将一个leaflet地图保存并下载成png或jpeg格式的图片。我有以下代码但是一直收到错误信息。

ui <- fluidPage(
  leafletOutput("map"),
  downloadButton("dl")
)

server <- function(input, output, session) {
  output$map <- renderLeaflet({
    leaflet() %>% 
      addTiles()
  })

  output$dl <- downloadHandler(
    filename = "map.png",

    content = function(file) {
      mapshot(input[["map"]], file = file)
    }
  )
}

shinyApp(ui = ui, server = server)

当我尝试通过点击按钮下载时,出现的错误是:
Warning: Error in system.file: 'package' must be of length 1
Stack trace (innermost first):
    65: system.file
    64: readLines
    63: paste
    62: yaml.load
    61: yaml::yaml.load_file
    60: getDependency
    59: widget_dependencies
    58: htmltools::attachDependencies
    57: toHTML
    56: <Anonymous>
    55: do.call
    54: mapshot
    53: download$func [#11]
     4: <Anonymous>
     3: do.call
     2: print.shiny.appobj
     1: <Promise>
Error : 'package' must be of length 1

如果您能告诉我如何在leafletProxy中使用这一功能,那就更好了。
2个回答

8

概览

由于“leaflet”地图是交互式的,因此在mapview::mapshot()函数中使用的leaflet对象也必须是交互式的。这样做可以允许用户在Shiny应用程序中保存自己版本的leaflet地图。

# install necessary packages
install.packages( c( "shiny", "leaflet", "mapview" ) )

# load necessary packages
library( shiny )
library( leaflet )
library( mapview )

ui <- fluidPage(
  leafletOutput( outputId = "map"),
  downloadButton( outputId = "dl")
)

server <- function(input, output, session) {
  
  # Create foundational leaflet map
  # and store it as a reactive expression
  foundational.map <- reactive({
    
    leaflet() %>% # create a leaflet map widget
      
      addTiles( urlTemplate = "https://{s}.tile.openstreetmap.se/hydda/base/{z}/{x}/{y}.png" ) # specify provider tile and type
    
  }) # end of foundational.map()
  
  # render foundational leaflet map
  output$map <- leaflet::renderLeaflet({
    
    # call reactive map
    foundational.map()
    
  }) # end of render leaflet
  
  # store the current user-created version
  # of the Leaflet map for download in 
  # a reactive expression
  user.created.map <- reactive({
    
    # call the foundational Leaflet map
    foundational.map() %>%
      
      # store the view based on UI
      setView( lng = input$map_center$lng
               ,  lat = input$map_center$lat
               , zoom = input$map_zoom
      )
    
  }) # end of creating user.created.map()
  
  
  
  # create the output file name
  # and specify how the download button will take
  # a screenshot - using the mapview::mapshot() function
  # and save as a PDF
  output$dl <- downloadHandler(
    filename = paste0( Sys.Date()
                       , "_customLeafletmap"
                       , ".pdf"
    )
    
    , content = function(file) {
      mapshot( x = user.created.map()
               , file = file
               , cliprect = "viewport" # the clipping rectangle matches the height & width from the viewing port
               , selfcontained = FALSE # when this was not specified, the function for produced a PDF of two pages: one of the leaflet map, the other a blank page.
      )
    } # end of content() function
  ) # end of downloadHandler() function
  
} # end of server

# run the Shiny app
shinyApp(ui = ui, server = server)

# end of script #

最终结果

运行Shiny应用程序后,在新窗口中打开应用程序。

RStudio View

在浏览器中,单击下载。这大约需要3秒钟。

Chrome View

一旦单击了下载,您会立即看到PDF文件存储在您机器上下载的文件所在的位置。

Final output

参考文献

我的想法来自以下帖子:


1
太棒了!非常有帮助。您还可以使用input$map_center$lng和input$map_center$lat获取地图中心。因此,您可以只使用setView(lng = input$map_center$lng, lat = input$map_center$lat, zoom = input$map_zoom)。 - Hallie Swan
3
当然可以!我通常会在服务器上使用 renderPrint({reactiveValuesToList(input)}),在UI界面上使用 verbatimTextOutput 来查看所有可用的输入。那就是我看到 input$map_center 选项的地方。 - Hallie Swan
1
@blondeclover - 现在这太棒了!哈哈,这正是我想要的:所有可用输入的列表。谢谢你向我展示这个。我已经添加了一个截图和打印出这些输入事件所需的代码。我希望其他人在开发Shiny应用程序中的leaflet地图时也会发现这个有用! - Cristian E. Nuno
1
@mpetric - 没问题!就您的情况而言,我不确定为什么当您发布Shiny应用程序时,下载按钮会返回空白HTML而不是PDF文件。我的建议是您制作一个可重现的示例,链接到此解决方案,并提出一个新问题。由于这篇文章已经快3年了,为R社区发布一个更新的问题可能是有益的。 - Cristian E. Nuno
1
@Christian E. Nuno - 通过在导言中包含:webshot :: install_phantomjs(force = TRUE)解决了这个问题。 - mpetric
显示剩余4条评论

5
也许这会有所帮助:
  server <- function(input, output, session) {

    map <- reactiveValues(dat = 0)

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

      output$dl <- downloadHandler(
        filename = "map.png",

        content = function(file) {
          mapshot(map$dat, file = file)
        }
      )
    }

谢谢您的建议,但对我来说不起作用。 - nathaneastwood
这段代码对你有效吗? library(mapview) m <- leaflet() %>% addTiles() mapshot(m, file = "map.png") - SBista
啊 - 它正在工作,只是需要一段时间才能运行。有趣的是它只下载了一个灰色的屏幕... - nathaneastwood
然后尝试运行webshot::install_phantomjs(),然后再运行上面的代码。希望这样能够正常工作。 - SBista
让我们在聊天中继续这个讨论 - nathaneastwood

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接