我一直在查看 Leaflet/Shiny 中 addDrawToolbar 的新增功能，它允许自定义绘制形状等。
但是我对通过访问绘制形状的几何形状来子设置空间数据感兴趣，这是如何完成的？ 这里和这里做了一些努力，但无论如何我都无法让它们发挥作用。
我认为也许绘图笔的巧妙功能可以与传单地图一起使用，但 Joe Cheng 去年表示它还没有到位。
那么，这方面有什么进展或解决方法吗？或者有人设法使用 addDrawToolbar 访问绘制矩形的几何形状？
您可以使用
addDrawToolbarleaflet.extras文档很少，但是这个page有
Leaflet.drawShiny.onInputChangeinput$eventShiny.onInputChange这是一个最小的示例，您可以在城市周围绘制多边形，多边形中城市的名称将显示在地图下方：
rm(list=ls())
library(shiny)
library(leaflet)
library(leaflet.extras)
cities <- structure(list(AccentCity = c("Saint Petersburg", "Harare", "Qingdao",
"Addis Abeba", "Xian", "Anshan", "Rongcheng", "Kinshasa", "New York",
"Sydney", "Lubumbashi", "Douala", "Bayrut", "Luanda", "Ludhiana"
), Longitude = c(30.264167, 31.0447222, 120.371944, 38.749226,
108.928611, 122.99, 116.364159, 15.3, -74.0063889, 151.205475,
27.466667, 9.7, 35.5097222, 13.233174, 75.85), Latitude = c(59.894444,
-17.8177778, 36.098611, 9.024325, 34.258333, 41.123611, 23.528858,
-4.3, 40.7141667, -33.861481, -11.666667, 4.0502778, 33.8719444,
-8.836804, 30.9)), class = "data.frame", row.names = c(NA, -15L
), .Names = c("AccentCity", "Longitude", "Latitude"))
cities_coordinates <- SpatialPointsDataFrame(cities[,c("Longitude","Latitude")],cities)
ui <- fluidPage(
leafletOutput("mymap"),
textOutput("selected_cities")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
setView(0,0,2) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addMarkers(data=cities,lat=~Latitude,lng=~Longitude,label=~AccentCity) %>%
addDrawToolbar(
targetGroup='draw',
polylineOptions=FALSE,
markerOptions = FALSE,
circleOptions = TRUE) %>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
})
output$selected_cities <- renderText({
#use the draw_stop event to detect when users finished drawing
req(input$mymap_draw_stop)
print(input$mymap_draw_new_feature)
feature_type <- input$mymap_draw_new_feature$properties$feature_type
if(feature_type %in% c("rectangle","polygon")) {
#get the coordinates of the polygon
polygon_coordinates <- input$mymap_draw_new_feature$geometry$coordinates[[1]]
#transform them to an sp Polygon
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){c(x[[1]][1],x[[2]][1])})))
#use over from the sp package to identify selected cities
selected_cities <- cities_coordinates %over% SpatialPolygons(list(Polygons(list(drawn_polygon),"drawn_polygon")))
#print the name of the cities
cities[which(!is.na(selected_cities)),"AccentCity"]
} else if(feature_type=="circle") {
#get the coordinates of the center of the cirle
center_coords <- matrix(c(input$mymap_draw_new_feature$geometry$coordinates[[1]],input$mymap_draw_new_feature$geometry$coordinates[[2]]),ncol=2)
#calculate the distance of the cities to the center
dist_to_center <- spDistsN1(cities_coordinates,center_coords,longlat=TRUE)
#select the cities that are closer to the center than the radius of the circle
cities[dist_to_center < input$mymap_draw_new_feature$properties$radius/1000,"AccentCity"]
}
})
}
shinyApp(ui, server)
编辑： 添加了对用户绘制圆圈的支持。
借鉴并改编上面 NicE 的答案（已接受），这就是我使用绘制的矩形对栅格进行子集化和区域求和的方法。
最重要的是我必须换过来
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){**c(x[[2]][1],x[[1]][1]**)})))drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){**c(x[[1]][1],x[[2]][1]**)})))leaf.proj <- "+proj=merc +lon_0=0 +k=1 +x_0=0 +y_0=0 +a=6378137 +b=6378137 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"
LL <- "+proj=longlat +ellps=WGS84 +datum=WGS84 +no_defs"
r <- raster("myraster.tif")
ui <- fluidPage(
leafletOutput("mymap"),
textOutput("selected_cities")
)
server <- function(input, output, session) {
output$mymap <- renderLeaflet({
leaflet() %>%
setView(0,0,4) %>%
addProviderTiles(providers$CartoDB.Positron) %>%
addRasterImage(r,project=FALSE, layerId="rasimg") %>%
addDrawToolbar(
targetGroup='draw',
polylineOptions=FALSE,
markerOptions = FALSE,
circleOptions = FALSE,
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions()))%>%
addLayersControl(overlayGroups = c('draw'), options =
layersControlOptions(collapsed=FALSE))
})
output$rastersum <- renderText({
#use the draw_stop event to detect when users finished drawing
req(input$mymap_draw_stop)
# get the coordinates of the polygon and make SpatialPolygons object
polygon_coordinates <- input$mymap_draw_new_feature$geometry$coordinates[[1]]
drawn_polygon <- Polygon(do.call(rbind,lapply(polygon_coordinates,function(x){c(x[[1]][1],x[[2]][1])})))
sp <- SpatialPolygons(list(Polygons(list(drawn_polygon),"drawn_polygon")))
# set coords as latlong then transform to leaflet projection
proj4string(sp) <- LL
polyre <- spTransform(sp, leaf.proj)
e <- extract(r,polyre)
sum(unlist(e),na.rm=T)
})
}
runApp(shinyApp(ui, server), launch.browser = TRUE)
我包括了
editOptions = editToolbarOptions(selectedPathOptions = selectedPathOptions())