使用用户选择的图层将传单地图保存为闪亮的

问题描述 投票：0回答：1

我有一个闪亮的应用程序，其中有一张传单地图。我已经设法让个人能够使用自己喜欢的缩放和边界保存地图（感谢this答案），并且可以删除保存图像中的缩放控件（感谢this答案）。但是，我现在希望能够使用用户自己选择的图层保存地图。

这是一个运行的简短示例代码：

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

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

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

  map <- reactive({
    leaflet() %>%
      setView(lng = -117, lat = 37, zoom = 7) %>%
      addTiles() %>%
      addMarkers(lng = -115.172813, lat = 36.114647,
                 group = "Vegas") %>%
      addMarkers(lng = -119.538330, lat = 37.865101,
                 group = "Yosemite") %>%
      addLayersControl(overlayGroups = c("Vegas", "Yosemite"),
                       options = layersControlOptions(collapsed = F)) %>%
      hideGroup("Yosemite")
  })

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

  output$save <- downloadHandler(
    filename = "map.png",
    content = function(file){
      latRng <- range(input$map_bounds$north,
                      input$map_bounds$south)
      lngRng <- range(input$map_bounds$east,
                      input$map_bounds$west)
      m <- map() %>%
        setView(lng = (lngRng[1] + lngRng[2])/2,
                lat = (latRng[1] + latRng[1])/2,
                zoom = input$map_zoom)
      m$x$options <- append(m$x$options, list("zoomControl" = F))
      mapshot(m, file = file)
    }
  )

}

shinyApp(ui, server)

在此应用程序中，当用户单击“下载”时创建的图像仅包含默认图层 Yosemite，即使也选择了 Vegas。

我也对在保存的图像中隐藏图层控制选项的方法感兴趣，但这对于我的主要问题来说是次要的。

r shiny r-leaflet
1个回答
1
投票

概述

创建一系列 if-else 控制语句，捕获用户在使用 Shiny 应用程序时添加或删除的组。

在下面，我测试当前检查了哪些

覆盖组 - 这些组存储为固有输入值/事件（在本例中为 input$MAPID_groups） - 并修改 map

 以显示已检查的组。我将这些修改存储在
user.map()
 中，这是一个
reactive() 表达式，因为对地图所做的修改会随着时间的推移而改变。

SS of Shiny App

Download on Leaflet Map

要删除图层控件出现在 PNG 文件中，请在修改

user.map() 时使用 removeLayersControl()

。

# load necessary packages library( shiny ) library( leaflet ) library( mapview ) ui <- fluidPage( leafletOutput(outputId = "map") , downloadButton(outputId = "save") ) server <- function(input, output, session) { # create foundational map map <- reactive({ leaflet() %>% setView(lng = -117, lat = 37, zoom = 7) %>% addTiles() %>% addMarkers( lng = -115.172813 , lat = 36.114647 , group = "Vegas") %>% addMarkers( lng = -119.538330 , lat = 37.865101 , group = "Yosemite" ) %>% addLayersControl( overlayGroups = c( "Vegas", "Yosemite" ) , options = layersControlOptions( collapsed = FALSE ) ) %>% hideGroup( group = "Yosemite") }) # render foundational map output$map <- renderLeaflet({ map() }) # create reactive leaflet maps # based on the user's actions # inside the Shiny app user.map <- reactive({ # create a series of if-else statements # that capture the click event of the user # adding/removing overlay groups # and modify the map to meet the user's # specifications if( is.null( input$map_groups ) ){ # show no markers when # no overlay groups are selected user.map <- map() %>% setView(lng = input$map_center$lng, lat = input$map_center$lat, zoom = input$map_zoom) %>% hideGroup( group = "Vegas" ) %>% hideGroup( group = "Yosemite" ) %>% removeLayersControl() # remove the zoom control # from the map user.map$x$options <- append( x = user.map$x$options , values = list("zoomControl" = FALSE ) ) # return user.map # to the Global Environment return( user.map ) } else if( identical( x = c( "Vegas", "Yosemite" ) , y = input$map_groups ) ){ # show all markers # when both groups are selected user.map <- map() %>% setView(lng = input$map_center$lng, lat = input$map_center$lat, zoom = input$map_zoom) %>% showGroup( group = "Vegas" ) %>% showGroup( group = "Yosemite" ) %>% removeLayersControl() # remove the zoom control # from the map user.map$x$options <- append( x = user.map$x$options , values = list("zoomControl" = FALSE ) ) # return user.map # to the Global Environment return( user.map ) } else if( input$map_groups == "Vegas" ){ # show only the Vegas group user.map <- map() %>% setView(lng = input$map_center$lng, lat = input$map_center$lat, zoom = input$map_zoom) %>% removeLayersControl() # remove the zoom control # from the map user.map$x$options <- append( x = user.map$x$options , values = list("zoomControl" = FALSE ) ) # return user.map # to the Global Environment return( user.map ) } else if( input$map_groups == "Yosemite" ){ # show only the Yosemite group user.map <- map() %>% setView(lng = input$map_center$lng, lat = input$map_center$lat, zoom = input$map_zoom) %>% hideGroup( group = "Vegas") %>% showGroup( group = "Yosemite") %>% removeLayersControl() # remove the zoom control # from the map user.map$x$options <- append( x = user.map$x$options , values = list("zoomControl" = FALSE ) ) # return user.map # to the Global Environment return( user.map ) } }) output$save <- downloadHandler( filename = "map.png", content = function(file){ # place the reactive leaflet map # inside of mapshot to # save and download the map as a png mapshot( x = user.map() , file = file ) } ) } # Run the shiny app shinyApp(ui, server) # end of script #

会议信息

R version 3.4.3 (2017-11-30) Platform: x86_64-apple-darwin15.6.0 (64-bit) Running under: macOS High Sierra 10.13.2 Matrix products: default BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib LAPACK: /Library/Frameworks/R.framework/Versions/3.4/Resources/lib/libRlapack.dylib locale: [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8 attached base packages: [1] stats graphics grDevices utils datasets [6] methods base other attached packages: [1] mapview_2.3.0 leaflet_1.1.0.9000 [3] shiny_1.0.5 loaded via a namespace (and not attached): [1] Rcpp_0.12.15 compiler_3.4.3 pillar_1.2.1 [4] plyr_1.8.4 R.methodsS3_1.7.1 R.utils_2.6.0 [7] base64enc_0.1-3 iterators_1.0.9 class_7.3-14 [10] tools_3.4.3 gdalUtils_2.0.1.7 digest_0.6.15 [13] jsonlite_1.5 viridisLite_0.3.0 satellite_1.0.1 [16] lattice_0.20-35 png_0.1-7 rlang_0.2.0 [19] foreach_1.4.4 DBI_0.8 crosstalk_1.0.0 [22] yaml_2.1.17 rgdal_1.2-16 e1071_1.6-8 [25] raster_2.6-7 htmlwidgets_1.0 webshot_0.5.0 [28] stats4_3.4.3 classInt_0.1-24 grid_3.4.3 [31] sf_0.6-0 R6_2.2.2 sp_1.2-7 [34] udunits2_0.13 magrittr_1.5 scales_0.5.0 [37] codetools_0.2-15 htmltools_0.3.6 units_0.5-1 [40] rsconnect_0.8.5 mime_0.5 xtable_1.8-2 [43] colorspace_1.3-2 httpuv_1.3.6.2 munsell_0.4.3 [46] R.oo_1.21.0
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.