从 shiny.io 上托管的闪亮应用程序下载传单地图

Question

我有一个闪亮的应用程序，它显示传单包中的地图。 我有兴趣将闪亮应用程序中的地图保存为 PNG 文件或 HTML 文件。在本地运行并使用以下代码在浏览器上打开闪亮的应用程序时，我设法将其保存为 PNG 文件：

library(shiny)
library(leaflet)
library( mapview)


ui <- fluidPage(
      leafletOutput(outputId = "eiffelmap")
       , downloadButton(outputId = "savemap")
       )

server <- function(input, output, server){




   name <- 'EIFFEL TOWER'
   longitude <- 2.2945
   latitude <- 48.8583
   location <- data.frame(name,longitude,latitude)

   icon.pop <- awesomeIcons(icon = 'thumb-tack',
                         markerColor = 'blue',
                         library = 'fa',
                         iconColor = 'black')
  map <- reactive({  
  name <- 'EIFFEL TOWER'
  longitude <- 2.2945
  latitude <- 48.8583
  location <- data.frame(name,longitude,latitude)

  icon.pop <- awesomeIcons(icon = 'thumb-tack',
                           markerColor = 'blue',
                           library = 'fa',
                           iconColor = 'black')

  leaflet(location) %>%
  addProviderTiles(providers$Stamen.TonerLite,
                   options = providerTileOptions(noWrap = TRUE)
  ) %>%

  addAwesomeMarkers(~longitude, ~latitude, label = ~name, icon=icon.pop) 

})

output$eiffelmap <- renderLeaflet({

          map()

       })

output$savemap <- downloadHandler(
    filename = "eiffelmap.png",
    content = function(file){


     mapshot(
      x = map()
      , file = file
    )
  }
)

}

shinyApp(ui, server)

我的问题是为什么当应用程序托管在 shiny.io 上时下载不起作用，但在浏览器上本地打开时却可以下载？我的代码有什么问题？ 还有关于如何将传单地图保存为可以放大和缩小的交互式 HTML 的任何见解？ 非常欢迎和赞赏任何见解或帮助。

Answer 1

我不确定您是单独询问还是作为应用程序的一部分询问，但如果您想将地图保存为交互式 HTML，只需运行这部分代码并在查看器窗格中选择导出选项，然后保存作为网页...

library(leaflet)
name <- 'EIFFEL TOWER'
longitude <- 2.2945
latitude <- 48.8583
location <- data.frame(name,longitude,latitude)

icon.pop <- awesomeIcons(icon = 'thumb-tack',
                         markerColor = 'blue',
                         library = 'fa',
                         iconColor = 'black')

leaflet(location) %>%
  addProviderTiles(providers$Stamen.TonerLite,
                   options = providerTileOptions(noWrap = TRUE)
  ) %>%

  addAwesomeMarkers(~longitude, ~latitude, label = ~name, icon=icon.pop) 

更新：

请试试这个（使用htmlwidgets::saveWidget()）

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


ui <- fluidPage(
  leafletOutput(outputId = "eiffelmap")
  , downloadButton(outputId = "savemap")
)

server <- function(input, output, server){




  name <- 'EIFFEL TOWER'
  longitude <- 2.2945
  latitude <- 48.8583
  location <- data.frame(name,longitude,latitude)

  icon.pop <- awesomeIcons(icon = 'thumb-tack',
                           markerColor = 'blue',
                           library = 'fa',
                           iconColor = 'black')
  map <- reactive({  
    name <- 'EIFFEL TOWER'
    longitude <- 2.2945
    latitude <- 48.8583
    location <- data.frame(name,longitude,latitude)

    icon.pop <- awesomeIcons(icon = 'thumb-tack',
                             markerColor = 'blue',
                             library = 'fa',
                             iconColor = 'black')

    leaflet(location) %>%
      addProviderTiles(providers$Stamen.TonerLite,
                       options = providerTileOptions(noWrap = TRUE)
      ) %>%

      addAwesomeMarkers(~longitude, ~latitude, label = ~name, icon=icon.pop) 

  })

  output$eiffelmap <- renderLeaflet({

    map()

  })

  output$savemap <- downloadHandler(
    filename = "eiffelmap.html",
    content = function(file){


      saveWidget(
        widget = map()
        , file = file
      )
    }
  )

}

shinyApp(ui, server)