Creation of paths given a OD

[Urban-JonathanCohen]

Hi there! First all sorry about my newbie level here... but i was dealing with a similar issue to #100 "Unexpected results from dodgr_paths". The first thing that i noticed, was that @JimShady was looking at edges, when he should have been looking at nodes. I dont think that switching to another package is the solution here.... This is my first time doing a sort of contribution, sorry for lack of formatting and other. This post also produces a reproducible example. I wrote the following functions to create paths.... I would like to make them as a contribution... but don't know how to do this... so here it goes...hope it helps future people struggling with my same challenge. For this i created to functions that wrap parts of dodgr and handles data.

1. Get the data

I will be working with Buenos Aires.... so i first download the bbox and make a sf

bb_poly <- getbb(place_name = "Ciudad de Buenos Aires, Argentina")

bb_poly <- as.matrix(bb_poly)
n <- bb_poly[2,2]
s <- bb_poly[2,1]
w <- bb_poly[1,1]
e <- bb_poly[1,2]

bb_poly <- matrix(c(w, s, w, n, e, n, e, s, w, s), ncol = 2, 
               byrow = TRUE)
bb_poly <- st_sfc(st_polygon(list(bb_poly)), crs = 4326)

Now ill download a bunch of xys that represent public bike stations.... clean a bit and for time reasons... ill subset it

url <- "https://cdn.buenosaires.gob.ar/datosabiertos/datasets/transporte/estaciones-bicicletas-publicas/nuevas-estaciones-bicicletas-publicas.csv"

stations <- read.csv(url)

bike_stations <- sf::st_as_sf(x = stations, wkt = "WKT", crs=4326)
bike_stations$lon<-st_coordinates(bike_stations)[,1] # get coordinates
bike_stations$lat<-st_coordinates(bike_stations)[,2] # get coordinates

xy <- data.frame(lon = bike_stations$lon, lat=bike_stations$lat)

xy$id <- bike_stations$id

Short XY I tested the functions for the full set... it takes a while... so not recommend unless needed xy <- xy %>% sample_n(25)

2. Function to get the net

Now we have the area to get the network... and the OD matrix... lets start working... These are my functions...

create_w_net <- function ( sf_boundery, weight_profile = "motorcar")
{  

  osm_data <- sf_boundery %>%
    opq () %>%
    add_osm_feature (key = "highway") %>%
    osmdata_sf (quiet = FALSE)

  street_net <- osm_data$osm_lines
  print("Creating graph from OSM Streets")

  net_weighted <- weight_streetnet(street_net,
                                      wt_profile = weight_profile)

  print("islands will be removed...")

  net_weighted <- net_weighted[which(net_weighted$component == 1), ]

  return(net_weighted)
}

I use this first function to get the data... and create the network ba_net_weighted <- create_w_net(bb_poly, weight_profile = "motorcar")

Now with the network... i use the second function....

make_paths <- function(weighted_net, xy){

  # create the paths... in between nodes
  print("creating paths")
  distance_paths <- dodgr_paths(weighted_net, from = xy, to = xy)

  print("creating nodes")
  nodes <- dodgr_vertices(weighted_net)

  nodes <- st_as_sf(x = nodes, 
                    coords = c("x", "y"),
                    crs = 4326)

  # create an empty vessel
  all_paths = st_sf(st_sfc(crs=4326))

  print("creating routes")
  for (i in 1:length(distance_paths)){

    print(paste("ElEMENT: ", i,"!"))

    all_paths_a = st_sf(st_sfc(crs=4326))

    for (j in 1:length(distance_paths[[i]])) {

      distance_paths[[i]][[j]]
      the_path_nodes <- nodes[nodes$id %in% distance_paths[[i]][[j]],]

      if (is.null(distance_paths[[i]][[j]]) == FALSE) {

        the_path_nodes <- the_path_nodes %>%
          arrange(match(id, distance_paths[[i]][[j]]))

        the_path_nodes

        the_path_nodes <- the_path_nodes  %>% 
          sf::st_as_sf(coords = c("y","x")) %>% 
          sf::st_set_crs(4326)

        path <- the_path_nodes %>% st_coordinates()%>%
          sf_linestring() %>% sf::st_set_crs(4326)

        path$from <- names(distance_paths)[i]
        path$to   <- j
        path$from_to <- paste(path$from ,"-",path$to)

      }

      all_paths_a = rbind(all_paths_a, path)

    }

    all_paths <- rbind(all_paths, all_paths_a)

  }

  all_paths<- subset(all_paths, select=-c(id))

  print("Yours paths are ready")

  return(all_paths)

}

And now i create the paths... distance_paths <- make_paths(ba_net_weighted,xy)

3. Make a map with the results

mapview(distance_paths, zcol="from",
        color = c("violet", 
                  "green", 
                  "orange",
                  "red",
                  "blue"),
        legend = TRUE)

`

I guess this can be optimized by parsing a similar function to a list instead of looping and creating object by object.... for now this works..

[mpadge]

Thanks @Urban-JonathanCohen, and great to see the package being put to important use. Have you seen the "dodgr flows" vignette? There's a dodgr_flowmap() function for automating a lot of the plotting you seem to be doing here. The only trick is specifying an appropriate weighting scheme - see the docs for dodgr_flows_aggregate() for suggestions. Those routines are intended for use cases where you care about things like total numbers of trips made between OD pairs, and will plot aggregate values in the network based on OD counts.

In your case, it seems like you're just colouring the result by ID values of your "from" stations, rather than aggregating. In that case, you could simplify your code with something like the following (using the "hampi" data included in this package):

library (dodgr)
library (sf)
net <- weight_streetnet (hampi)
v <- dodgr_vertices (net)
set.seed (1)
xy <- v [sample (nrow (v), size = 10), ]

p <- dodgr_paths (graph, from = xy, to = xy)

# convert paths to sf-format:
p_sf <- lapply (p, function (i) {
    lapply (i, function (j) {
        path_ij <- v [match (j, v$id), ]
        st_linestring (as.matrix (path_ij [, c ("x", "y")])) |>
            st_sfc (crs = 4326)
        })
    })
# Then unlist to convert to single 'sfc' object:
p_sf <- lapply (p_sf, function (i) do.call (rbind, i))
p_sf <- do.call (rbind, p_sf)

# add 'from' and 'to' columns:
p_sf <- st_sf (
    from = rep (names (p), each = nrow (xy)),
    to = rep (names (p), times = nrow (xy)),
    geometry = p_sf [, 1],
    crs = 4326
)

... and then use whatever routines you like to plot p_sf, and colour paths by the from value. Let me know if that helps, and no worries at all about "newbie" questions:smile:

[Urban-JonathanCohen]

Thanks a lot!!! and great package!

[mpadge]

No worries! Good to close this issue now? Feel free to do so, thanks.