【问题标题】:Change the weight of an Edge of a path in a open street map based igraph based on a list of gps coordinates根据 gps 坐标列表更改基于开放街道地图的 igraph 中路径边缘的权重
【发布时间】:2020-10-03 23:15:22
【问题描述】:

我想根据 GPS 坐标更改部分路线的重量。 为此,我想获取计算路线边缘的 gps 坐标,然后将它们与我拥有的坐标列表进行比较,如果我的列表中的坐标与路线末端的坐标相匹配,我想更改权重那个边缘。 目前我有计算路线并改变整个路线权重的代码。 我得到了路线的坐标,但我无法获得返回图表所需的步骤。我的大脑只是关闭了:)

library(osmar)
library(igraph)

### Get data ----
src <- osmsource_api(url = "https://api.openstreetmap.org/api/0.6/")
muc_bbox <- center_bbox(11.575278, 48.137222, 1000, 1000)
muc <- get_osm(muc_bbox, src)

### Reduce to highways: ----
hways <- subset(muc, way_ids = find(muc, way(tags(k == "highway"))))
hways <- find(hways, way(tags(k == "name")))
hways <- find_down(muc, way(hways))
hways <- subset(muc, ids = hways)

#### Plot data ----
## Plot complete data and highways on top:
plot(muc)
plot_ways(muc, col = "lightgrey")
plot_ways(hways, col = "coral", add = TRUE)

### Define route start and end nodes: ----
id<-find(muc, node(tags(v %agrep% "Sendlinger Tor")))[1]
hway_start_node <-find_nearest_node(muc, id, way(tags(k == "highway"))) 
hway_start <- subset(muc, node(hway_start_node))

id <- find(muc, node(attrs(lon > 11.58 & lat > 48.15)))[1]
hway_end_node <- find_nearest_node(muc, id, way(tags(k == "highway")))
hway_end <- subset(muc, node(hway_end_node))

## Add the route start and and nodes to the plot:
plot_nodes(hway_start, add = TRUE, col = "red", pch = 19, cex = 2)
plot_nodes(hway_end, add = TRUE, col = "red", pch = 19, cex = 2)

### Create street graph ----
gr <- as.undirected(as_igraph(hways))

### Compute shortest route: ----
# Calculate route
route <- function(start_node,end_node) {
  get.shortest.paths(gr,
                     from = as.character(start_node),
                     to = as.character(end_node), 
                     mode = "all")[[1]][[1]]}
# Plot route
plot.route <- function(r,color) {
  r.nodes.names <- as.numeric(V(gr)[r]$name)
  r.ways <- subset(hways, ids = osmar::find_up(hways, node(r.nodes.names)))
  plot_ways(r.ways, add = TRUE, col = color, lwd = 2)
}


r <- route(hway_start_node,hway_end_node)
color <- colorRampPalette(c("springgreen","royalblue"))(nways)[numway]
plot.route(r,color)

route_nodes <- as.numeric(V(gr)[r]$name)
#We construct a newosmarobject containing only elements 
#related to the nodes defining the route:

route_ids <- find_up(hways, node(route_nodes))
route_muc <- subset(hways, ids = route_ids)

#Route details.
#In order to present route details like street names,
#distances, and directions we have to work directly on the internals of the osmar objects.
#We start by extracting the route’s node IDs (which are in the correct order) 
#and the way IDs       (whichwe have to order)
#where the nodes are members:

node_ids <- route_muc$nodes$attrs$id

way_ids <- local({
  w <- match(node_ids, route_muc$ways$refs$ref)
  route_muc$ways$refs$id[w]
})

#Then we extract the names of the ways in the correct order:>
way_names <- local({
  n <- subset(route_muc$ways$tags, k == "name")
  n[match(way_ids, n$id), "v"]
})

#The next step is to extract the nodes’ coordinates,>
node_coords <- route_muc$nodes$attrs[, c("lon", "lat")]

#and to compute the distances (meters) and the bearings (degrees) 
#between successive nodes (using thepackagegeosphere):

node_dirs <- local({
      n <- nrow(node_coords)
      from <- 1:(n - 1)
      to <- 2:n
      cbind(dist = c(0, distHaversine(node_coords[from,], node_coords[to,])),
            bear = c(0, bearing(node_coords[from,], node_coords[to,])))
    })



#Finally, we pack together all the information, 
#and additionally compute the cumulative distance

route_details <- data.frame(way_names, node_dirs)
route_details$cdist <- cumsum(route_details$dist)
route_details$coord <- node_coords
route_details$id <- node_ids
print(route_details)

#here we select randomly parts from the route

gps_points<-route_details[sample(1:nrow(route_details), 10,replace=FALSE),] 

在这里,我想根据选定的 gps 坐标更改图形部分的权重。 我找到了获取gps坐标点的方法,但我只是在这里挂断电话,回到图表以更改那里的权重。

# Currently i can only Modify current route weight
E(gr)[r]$weight <- E(gr)[r]$weight * 2

感谢您的帮助! 最好的问候。

【问题讨论】:

    标签: r navigation igraph osrm osmar


    【解决方案1】:

    以下脚本查找与坐标列表 (wished.coord) 相邻的边的 ID,以便您可以修改权重:

    library(osmar)
    library(igraph)
    library(tidyr)
    library(dplyr)
    
    ### Get data ----
    src <- osmsource_api(url = "https://api.openstreetmap.org/api/0.6/")
    muc_bbox <- center_bbox(11.575278, 48.137222, 1000, 1000)
    muc <- get_osm(muc_bbox, src)
    
    ### Reduce to highways: ----
    hways <- subset(muc, way_ids = find(muc, way(tags(k == "highway"))))
    hways <- find(hways, way(tags(k == "name")))
    hways <- find_down(muc, way(hways))
    hways <- subset(muc, ids = hways)
    
    #### Plot data ----
    ## Plot complete data and highways on top:
    plot(muc)
    plot_ways(muc, col = "lightgrey")
    plot_ways(hways, col = "coral", add = TRUE)
    
    ### Define route start and end nodes: ----
    id<-find(muc, node(tags(v %agrep% "Sendlinger Tor")))[1]
    hway_start_node <-find_nearest_node(muc, id, way(tags(k == "highway"))) 
    hway_start <- subset(muc, node(hway_start_node))
    
    id <- find(muc, node(attrs(lon > 11.58 & lat > 48.15)))[1]
    hway_end_node <- find_nearest_node(muc, id, way(tags(k == "highway")))
    hway_end <- subset(muc, node(hway_end_node))
    
    ## Add the route start and and nodes to the plot:
    plot_nodes(hway_start, add = TRUE, col = "red", pch = 19, cex = 2)
    plot_nodes(hway_end, add = TRUE, col = "red", pch = 19, cex = 2)
    
    ### Create street graph ----
    gr <- as.undirected(as_igraph(hways))
    
    ### Compute shortest route: ----
    # Calculate route
    route <- function(start_node,end_node) {
      get.shortest.paths(gr,
                         from = as.character(start_node),
                         to = as.character(end_node), 
                         mode = "all")[[1]][[1]]}
    # Plot route
    plot.route <- function(r,color) {
      r.nodes.names <- as.numeric(V(gr)[r]$name)
      r.ways <- subset(hways, ids = osmar::find_up(hways, node(r.nodes.names)))
      plot_ways(r.ways, add = TRUE, col = color, lwd = 2)
    }
    nways <-  1
    numway <- 1
    r <- route(hway_start_node,hway_end_node)
    
    # Plot route
    
    color <- colorRampPalette(c("springgreen","royalblue"))(nways)[numway]
    plot.route(r,color)
    
    
    ## Route details ----
    # Construct a new osmar object containing only elements 
    # related to the nodes defining the route:
    route_nodes <- as.numeric(V(gr)[r]$name)
    route_ids <- find_up(hways, node(route_nodes))
    
    osmar.route <- subset(hways, ids = route_ids)
    osmar.nodes.ids <- osmar.route$nodes$attrs$id
    
    # Extract the nodes’ coordinates,
    osmar.nodes.coords <- osmar.route$nodes$attrs[, c("lon", "lat")]
    osmar.nodes <- cbind(data.frame(ids = osmar.nodes.ids),
                         data.frame(ids_igraph = as.numeric(V(gr)[r]) ),
                         osmar.nodes.coords) 
    
    
    ## Find edges ids containing points of interest ----
    wished.coords <- data.frame(wlon = c(11.57631),
                                wlat = c(48.14016)) 
    
    
    # Calculate all distances
    distances <- crossing(osmar.nodes,wished.coords) %>%
                 mutate(dist = geosphere::distHaversine(cbind(lon,lat),cbind(wlon,wlat)))
    
    
    # Select nodes below maximum distance :
    mindist <- 50 #m
    
    wished.nodes <- distances %>% filter(dist < mindist)
    
    # Select edges incident to these nodes :
    selected.edges <- unlist(incident_edges(gr,V(gr)[wished.nodes$ids_igraph]))
    
    # Weight of selected edges
    E(gr)[selected.edges]$weight
    

    【讨论】:

    • 谢谢:我在会员(社区)中收到错误费勒:无法计算社区会员
    • 脚本的哪个命令出现这个错误?
    • # 计算所有距离% mutate(dist = geosphere::distHaversine(cbind(lon,lat),cbind(wlon,wlat) ))
    • 您是否加载了 tidyr 包,您的计算机上是否安装了 geosphere?
    • 那些是我加载的包: library(osmar) library(igraph) library(tidyr) library(dplyr) library(geosphere)
    猜你喜欢
    • 2014-04-13
    • 1970-01-01
    • 2019-10-17
    • 1970-01-01
    • 1970-01-01
    • 2016-11-29
    • 1970-01-01
    • 1970-01-01
    • 2023-01-09
    相关资源
    最近更新 更多