我一直在看addDrawToolbar 的不错的附加功能。在 Leaflet/Shiny 中,它允许自定义绘制形状等。
但是我对通过访问绘制形状的几何形状来设置空间数据感兴趣,这是如何完成的?有一些努力here和 here但无论如何我都无法让他们工作。
我想也许 plot brush 的巧妙功能可能适用于传单 map ,但 Joe Cheng suggested last year它没有到位。
那么,这方面有什么发展或解决方法吗?或者有没有人设法使用 addDrawToolbar 访问绘制矩形的几何图形?
最佳答案
您可以使用 addDrawToolbar
来自 leaflet.extras
包裹。
文档很少,但这个 page有 Leaflet.draw
的代码 Shiny 的绑定(bind)。您可以查找具有 Shiny.onInputChange
的行在应用程序的服务器部分,使用相应的 input$event
获取传递给 Shiny.onInputChange
的数据.
这是一个最小的示例,您可以在城市周围绘制多边形,多边形中的城市名称将显示在 map 下方:
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)
编辑:
添加了对用户绘制圆圈的支持。
关于r - 在 Shiny Leaflet 中为空间子集绘制刷亮或访问绘制的形状几何图形,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/42528400/