如何从R（Shiny）下载在leaflet.draw中绘制的多边形作为GeoJson文件

Question

我使用 R-shiny 和 leaflet.extra 包创建了一个应用程序，我在其中放置了一个地图，我的用户可以在地图上绘制多边形，我的目标是能够下载用户绘制的多边形作为 GeoJson 或 Shapefil (.shp) 文件。 我的应用程序如下所示：

ui <- fluidPage(


textOutput("text"),leafletOutput("mymap")  )

和服务器：

poly<-reactiveValues(poligonos=list()) #save reactiveValues



output$mymap <- renderLeaflet({

     leaflet("mymap") %>%
      addProviderTiles(providers$Stamen.TonerLite, #map type or map theme. -default($Stame.TonerLite)
                       options = providerTileOptions(noWrap = TRUE) 

      )%>% addDrawToolbar(
        targetGroup='draw',
        editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()))  %>%
      addLayersControl(overlayGroups = c('draw'), options =
                         layersControlOptions(collapsed=FALSE)) %>%
      addStyleEditor()




  })  

 polygons<- eventReactive(input$mymap_draw_all_features, {

   features<-input$mymap_draw_all_features
   poly$poligonos<-c(poly$poligonos,features)

   return(poly$poligonos)

  })

名为“polygons”的eventReactive函数负责记录绘制的多边形（坐标），但我不知道如何保存它们或将其转换为GeoJson或shapefile格式。

- Sebastian Diaz

---

试试mapedit包。它会为你完成所有的工作。请参考http://r-spatial.org/r/2017/06/09/mapedit_0-2-0.html了解如何在shiny应用程序中使用它。 - TimSalabim

Answer 1

你可以使用DrawToolbar创建的多边形坐标，将它们用于在reactiveValues SpatialPolygonsDataFrame中创建多边形。你可以将该SPDF导出为shapefile(使用下面的示例，您需要发布到服务器才能使下载选项工作。它无法从R Studio中工作)。

ui <- fluidPage(

textOutput("text"),leafletOutput("mymap"),
downloadButton('downloadData', 'Download Shp'))

--

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

output$mymap <- renderLeaflet({

  leaflet("mymap") %>%
   addProviderTiles(providers$Stamen.TonerLite, #map type or map theme. -default($Stame.TonerLite)
                 options = providerTileOptions(noWrap = TRUE)) %>% 
   addDrawToolbar(targetGroup = "drawnPoly", 
                    rectangleOptions = F, 
                    polylineOptions = F, 
                    markerOptions = F, 
                    editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()), 
                    circleOptions=F,
                    polygonOptions=drawPolygonOptions(showArea=TRUE, repeatMode=F  , shapeOptions=drawShapeOptions( fillColor="red",clickable = TRUE))) %>%

    addStyleEditor()

  })



latlongs<-reactiveValues()   #temporary to hold coords
latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0))

#########
#empty reactive spdf
value<-reactiveValues()
SpatialPolygonsDataFrame(SpatialPolygons(list()), data=data.frame (notes=character(0), stringsAsFactors = F))->value$drawnPoly

#fix the polygon to start another

observeEvent(input$mymap_draw_new_feature, {

  coor<-unlist(input$mymap_draw_new_feature$geometry$coordinates)

  Longitude<-coor[seq(1,length(coor), 2)] 

  Latitude<-coor[seq(2,length(coor), 2)]

  isolate(latlongs$df2<-rbind(latlongs$df2, cbind(Longitude, Latitude)))

  poly<-Polygon(cbind(latlongs$df2$Longitude, latlongs$df2$Latitude))
  polys<-Polygons(list(poly),    ID=input$mymap_draw_new_feature$properties$`_leaflet_id`)
  spPolys<-SpatialPolygons(list(polys))


  #
  value$drawnPoly<-rbind(value$drawnPoly,SpatialPolygonsDataFrame(spPolys, 
                                                                 data=data.frame(notes=NA, row.names=
                                                                                row.names(spPolys))))

###plot upon ending draw
 observeEvent(input$mymap_draw_stop, {

 #replot it - take off the DrawToolbar to clear the features and add it back and use the values from the SPDF to plot the polygons
  leafletProxy('mymap') %>%  removeDrawToolbar(clearFeatures=TRUE) %>% removeShape('temp') %>% clearGroup('drawnPoly') %>% addPolygons(data=value$drawnPoly, popup="poly",   group='drawnPoly', color="blue", layerId=row.names(value$drawnPoly)) %>% 

  addDrawToolbar(targetGroup = "drawnPoly", 
                 rectangleOptions = F, 
                 polylineOptions = F, 
                 markerOptions = F, 
                 editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()), 
                 circleOptions=F,
                 polygonOptions=drawPolygonOptions(showArea=TRUE, repeatMode=F  , shapeOptions=drawShapeOptions( fillColor="red",clickable = TRUE)))

})

 latlongs$df2 <- data.frame(Longitude = numeric(0), Latitude = numeric(0))   #clear df

 })

########################
### edit polygons / delete polygons

observeEvent(input$mymap_draw_edited_features, {

 f <- input$mymap_draw_edited_features

  coordy<-lapply(f$features, function(x){unlist(x$geometry$coordinates)})

  Longitudes<-lapply(coordy, function(coor) {coor[seq(1,length(coor), 2)] })

  Latitudes<-lapply(coordy, function(coor) { coor[seq(2,length(coor), 2)] })

  polys<-list()
  for (i in 1:length(Longitudes)){polys[[i]]<- Polygons(
list(Polygon(cbind(Longitudes[[i]], Latitudes[[i]]))), ID=f$features[[i]]$properties$layerId
  )}

  spPolys<-SpatialPolygons(polys)


  SPDF<-SpatialPolygonsDataFrame(spPolys, 
                             data=data.frame(notes=value$drawnPoly$notes[row.names(value$drawnPoly) %in% row.names(spPolys)], row.names=row.names(spPolys)))

  value$drawnPoly<-value$drawnPoly[!row.names(value$drawnPoly) %in% row.names(SPDF),]
value$drawnPoly<-rbind(value$drawnPoly, SPDF)

  })

 observeEvent(input$mymap_draw_deleted_features, { 

   f <- input$mymap_draw_deleted_features

   ids<-lapply(f$features, function(x){unlist(x$properties$layerId)})


      value$drawnPoly<-value$drawnPoly[!row.names(value$drawnPoly) %in% ids ,]

 }) 



  #write the polys to .shp
  output$downloadData<-downloadHandler(

  filename = 'shpExport.zip',
 content = function(file) {
  if (length(Sys.glob("shpExport.*"))>0){
  file.remove(Sys.glob("shpExport.*"))
}

  proj4string(value$drawnPoly)<-"+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
   writeOGR(value$drawnPoly, dsn="shpExport.shp", layer="shpExport", driver="ESRI Shapefile")
  zip(zipfile='shpExport.zip', files=Sys.glob("shpExport.*"))
  file.copy("shpExport.zip", file)
   if (length(Sys.glob("shpExport.*"))>0){
    file.remove(Sys.glob("shpExport.*"))
   }
 }
 )

}

--

 shinyApp(ui=ui,server=server)

- LAD

---

需要添加以下内容使此代码正常工作：require(sp) require(leaflet) require(leaflet.extras) - dca

加上 require(rgdal) - dca

截至2022年1月，R包leaflet.extras已被废弃（请参阅其GitHub存储库），并被视为潜在的安全风险。 - bathyscapher