在R Shiny中保存leaflet地图

4
我创建了一个应用程序,用户可以修改leaflet地图,我想在PDF报告中使用此地图。我已经: 1. 安装了leaflet、webshot和htmlwidget包 2. 安装了PhantomJS
以下是简化版本的代码。

server.R:

    library(shiny)
    library(leaflet)
    library(htmlwidgets)
    library(webshot)

    shinyServer(function(input, output, session) {

      output$amap <- renderLeaflet({
      leaflet() %>%
        addProviderTiles("Stamen.Toner",
                     options = providerTileOptions(noWrap = TRUE,      reuseTiles=TRUE))
  })

  observe({
    leafletProxy("amap") %>%
    clearShapes() %>%
    addCircles(lng = c(22,-2), lat = c(42,65))
  })



  observeEvent(input$saveButton,{
    themap<- leafletProxy("amap")
    saveWidget(themap, file="temp.html", selfcontained = F) 
    webshot("temp.html", file = "Rplot.png",
          cliprect = "viewport")

  })
})

ui.R:

fluidPage(
  leafletOutput("amap", height="600px", width="600px"),
  br(),
  actionButton("saveButton", "Save")
  )

我得到了这个错误消息:
警告:Error in system.file: 'package' 必须是长度为 1 的向量 堆栈追踪(最内层的先显示): 73: system.file 72: readLines 71: paste 70: yaml.load 69: yaml::yaml.load_file 68: getDependency 67: widget_dependencies 66: htmltools::attachDependencies 65: toHTML 64: saveWidget 63: observeEventHandler [C:\R files\test/server.R#24] 1: shiny::runApp 当保存按钮被激活时。 如果我像这样定义保存按钮,savewidget 就可以正常工作:
  observeEvent(input$saveButton,{
    themap<-leaflet() %>%
      addProviderTiles("Stamen.Toner",
                       options = providerTileOptions(noWrap = TRUE, reuseTiles=TRUE))

    saveWidget(themap, file="temp.html", selfcontained = F) 
    webshot("temp.html", file = "Rplot.png",
          cliprect = "viewport")

  })

但我真的希望用户在网页截图中所做的更改能够被保留下来。有人可以帮忙吗?

你希望用户能够保存文件吗?我认为这最好由JavaScript处理。我会尝试为您制作一个示例。 - timelyportfolio
好吧,我的聪明解决方案被跨域问题搞得一团糟。我会尝试想出另一种处理方式。 - timelyportfolio
1个回答

5

这并不是完美的解决方案,但是可以使用库html2canvas来实现。请注意归属、许可证和版权问题。同时,这种方法无法在RStudio Viewer中工作,但有办法使其正常运行。

library(leaflet)
library(htmltools)

lf <- leaflet() %>%
  addProviderTiles(
    "Stamen.Toner",
    options = providerTileOptions(
      noWrap = TRUE,
      reuseTiles=TRUE
    )
  )


#  add the mapbox leaflet-image library
#   https://github.com/mapbox/leaflet-image
#lf$dependencies[[length(lf$dependencies)+1]] <- htmlDependency(
#  name = "leaflet-image",
#  version = "0.0.4",
#  src = c(href = "http://api.tiles.mapbox.com/mapbox.js/plugins/leaflet-image/v0.0.4/"),
#  script = "leaflet-image.js"
#)

lf$dependencies[[length(lf$dependencies)+1]] <- htmlDependency(
  name = "html2canvas",
  version = "0.5.0",
  src = c(href="https://cdn.rawgit.com/niklasvh/html2canvas/master/dist/"),
  script = "html2canvas.min.js"
)



browsable(
  tagList(
    tags$button("snapshot",id="snap"),
    lf,
    tags$script(
'
document.getElementById("snap").addEventListener("click", function() {
  var lf = document.querySelectorAll(".leaflet");
  html2canvas(lf, {
    useCORS: true,
    onrendered: function(canvas) {
      var url = canvas.toDataURL("image/png");
      var downloadLink = document.createElement("a");
      downloadLink.href = url;
      downloadLink.download = "map.png"

      document.body.appendChild(downloadLink);
      downloadLink.click();
      document.body.removeChild(downloadLink); 
    }
  });
});
'      
    )
  )
)

非常感谢您的快速回复。我还没有在我的 Shiny 应用程序中使其正常工作。我对 JavaScript 不是很熟悉......我会在本周晚些时候回来处理它。感谢您到目前为止所做的工作。 - Mette Laegdsmand

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