gpt4 book ai didi

r - 如何从 R (Shiny) 下载在 leaflet.draw 中绘制的多边形作为 GeoJson 文件

转载 作者:行者123 更新时间:2023-12-05 09:18:19 26 4
gpt4 key购买 nike

我在 R-shiny 中创建了一个应用程序,使用 leaflet.extra 包,我放了一张 map ,我的用户可以在其中绘制多边形,我的目标是能够下载我的用户绘制的多边形作为 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 格式。

最佳答案

您可以获取使用 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)

关于r - 如何从 R (Shiny) 下载在 leaflet.draw 中绘制的多边形作为 GeoJson 文件,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/44979900/

26 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com