概述

Question

我有一个闪亮的应用程序，我有一个传单地图。我已设法包含个人使用自己的首选缩放和边界保存地图的功能（感谢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，即使已选择“拉斯维加斯”也是如此。

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

由于

Answer 1

概述

Create a series of if-else control statements，可在使用Shiny应用时捕获the groups您的用户添加或删除的内容。

在下面，我测试当前检查了哪个overlay groups - stored as an inherent input value/events（在这种情况下，输入$ MAPID_groups） - 并修改map以显示已检查的组。我将这些修改存储在user.map()中，这是reactive()表达式，因为对地图所做的修改会随着时间的推移而发生变化。

要删除图层控件显示在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 #

Session Info

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

使用用户选择的图层保存传单中的传单地图

1 个答案:

概述

Session Info