用传单绘制并导出

Question

问题

我一直在开发一个闪亮的应用程序，用户可以在其中绘制单个多边形并导出为 shapefile 或 geojson。我似乎无法弄清楚如何组合多个多边形并导出为一个形状文件，其中每一行代表一个多边形。下面的例子有效。

我尝试过的事情

在服务器顶部，添加功能<- reactiveVal(list()) and append new polygon from input$map_draw_new_feature to reactiveVal list. I couldn't quite figure out how to bind them all using dplyr::bind_rows or base rbind.

工作示例

library(sf)
library(dplyr)
library(shiny)
library(leaflet)
library(shinyalert)
library(leaflet.extras)

ui <- fluidPage(
  fluidRow(
    column(width = 2,
           br(),
           h4("Control Panel"),
           hr(),
           textInput(inputId = "name", label = "Feature/Polygon Name:"),
           hr(),
           radioButtons(inputId = "filetype", label = "Output Type:", choices = c("Shapefile","GEOJson"), selected = NULL),
           textInput(inputId = "filename", value = "", label = "Filename:"),
           actionButton("download","Download Shape")
           ),
    column(width = 10, leafletOutput("map", width = "98%", height = 1000))
  )
)

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

  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -117.88111674347516, lat = 33.6953612425539, zoom = 12) %>%
      addProviderTiles(providers$Esri.WorldImagery, options = providerTileOptions(noWrap = TRUE)) %>%
      addDrawToolbar()
  })
  
  polygon_data <- reactive({input$map_draw_new_feature$geometry$coordinates[[1]]})

  shapefile <- reactive({
    longitude = lapply(polygon_data(), `[[`, 1)
    latitude = lapply(polygon_data(), `[[`, 2)

    shp <- st_as_sf(tibble(lon = longitude, lat = latitude),
                   coords = c("lon", "lat"),
                   crs = 4326) %>%
      summarise(geometry = st_combine(geometry)) %>%
      st_cast("POLYGON") %>%
      mutate(Name = input$name)

    return(shp)
  })
  
  observeEvent(input$download,{
    
    if(input$filetype == "Shapefile"){
      st_write(shapefile(), paste0("output\\", input$filename, ".shp"))
    } else {
      st_write(shapefile(), paste0("output\\", input$filename, ".geojson"))
    }
    
    if(input$filetype == "Shapefile"){
      st_write(sf_polygons, paste0("output\\", input$filename, ".shp"))
    } else {
      st_write(sf_polygons, paste0("output\\", input$filename, ".geojson"))
    }
    
    shinyalert(
      title = "Shapefile has been generated.",
      text = "You may now return to map.",
      size = "s", 
      closeOnEsc = TRUE,
      closeOnClickOutside = FALSE,
      html = FALSE,
      type = "info",
      showConfirmButton = TRUE,
      showCancelButton = FALSE,
      confirmButtonText = "OK",
      confirmButtonCol = "#113A72",
      timer = 0,
      imageUrl = "",
      animation = TRUE
    )
  })
  
}

shinyApp(ui = ui, server = server)

Answer 1

您可以观察

map_draw_new_feature

事件并将形状收集到

reactiveValues()

:

shapes <- reactiveValues()
observeEvent(input$map_draw_new_feature, {
  shapes[[input$name]] <- input$map_draw_new_feature
})

并在保存/下载时从形状列表中创建一个

sf

对象：

sf_polygons <- 
  reactiveValuesToList(shapes) %>%
  lapply(jsonlite::toJSON, auto_unbox = TRUE) %>%
  lapply(st_read, quiet = TRUE) %>%
  bind_rows(.id = "Name")

map_draw_new_feature

数据是GeoJSON转换为R列表，当转换回JSON字符串时，

st_read()

可以处理它。

---

完整的应用程序供参考：

library(dplyr)
library(shiny)
library(leaflet)
library(shinyalert)
library(leaflet.extras)

# define / create ouput directory
output_dir <- fs::dir_create("output")

ui <- fluidPage(
  fluidRow(
    column(width = 2,
           br(),
           h4("Control Panel"),
           hr(),
           textInput(inputId = "name", label = "Feature/Polygon Name:"),
           hr(),
           radioButtons(inputId = "filetype", label = "Output Type:", choices = c("Shapefile","GEOJson"), selected = NULL),
           textInput(inputId = "filename", value = "", label = "Filename:"),
           actionButton("download","Download Shape")
    ),
    column(width = 10, leafletOutput("map", width = "98%", height = 1000))
  )
)

server <- function(input, output, session) {
  
  output$map <- renderLeaflet({
    leaflet() %>%
      setView(lng = -117.88111674347516, lat = 33.6953612425539, zoom = 12) %>%
      addProviderTiles(providers$Esri.WorldImagery, options = providerTileOptions(noWrap = TRUE)) %>%
      addDrawToolbar()
  })
  # collect created shapes to reactiveValues, nemes from input$name,
  # using the same name overwrites existing shape
  shapes <- reactiveValues()
  observeEvent(input$map_draw_new_feature, {
    shapes[[input$name]] <- input$map_draw_new_feature
  })
  
  observeEvent(input$download,{
    # build sf object from all shapes;
    # map_draw_new_feature is a R list of GeoJSON, 
    # convert it back to JSON string and sf::st_read can read it as-is;
    # with bind_rows(.id = "Name"), list names end up in a Name column
    sf_polygons <- 
      reactiveValuesToList(shapes) %>%
      lapply(jsonlite::toJSON, auto_unbox = TRUE) %>%
      lapply(st_read, quiet = TRUE) %>%
      bind_rows(.id = "Name")
    print(sf_polygons)
    
    out_name <- fs::path(output_dir, input$filename)
    if(input$filetype == "Shapefile"){
      st_write(sf_polygons, fs::path_ext_set(out_name, "shp"))
    } else {
      st_write(sf_polygons, fs::path_ext_set(out_name, "geojson"))
    }

    shinyalert(
      title = "Shapefile has been generated.",
      text = "You may now return to map.",
      size = "s", 
      closeOnEsc = TRUE,
      closeOnClickOutside = FALSE,
      html = FALSE,
      type = "info",
      showConfirmButton = TRUE,
      showCancelButton = FALSE,
      confirmButtonText = "OK",
      confirmButtonCol = "#113A72",
      timer = 0,
      imageUrl = "",
      animation = TRUE
    )
  })
  
}

shinyApp(ui = ui, server = server)