♻️ Simplify function to create line graph

NAMESPACE

@@ -22,8 +22,8 @@ export(create_coordinates)
 export(create_graph)
 export(create_graph_links)
 export(create_graph_nodes)
+export(create_line_graph)
 export(create_linestring)
-export(create_midpoint_graph)
 export(create_points)
 export(create_polygon)
 export(create_road_network)
@@ -51,9 +51,14 @@ importFrom(graphics,axis)
 importFrom(graphics,par)
 importFrom(graphics,segments)
 importFrom(igraph,"E<-")
+importFrom(igraph,"V<-")
 importFrom(igraph,E)
+importFrom(igraph,V)
+importFrom(igraph,as_edgelist)
+importFrom(igraph,ends)
 importFrom(igraph,graph_from_data_frame)
 importFrom(igraph,is_directed)
+importFrom(igraph,make_line_graph)
 importFrom(lwgeom,st_endpoint)
 importFrom(lwgeom,st_split)
 importFrom(lwgeom,st_startpoint)

R/create-graph.R

@@ -14,21 +14,35 @@
 #'
 #' # Create the graph
 #' graph <- create_graph(nodes, links)
+#' graph
 #'
 #' # Plot the graph
 #' plot(graph)
 create_graph <- function(nodes, links, directed = FALSE) {
-  # Create graph from nodes and links
-  graph_links <- st_drop_geometry(links)[, c("from", "to", "id")]
-  graph_nodes <- create_graph_nodes(nodes$id, nodes$geometry)
+  # Create graph nodes
+  node_coordinates <- st_coordinates(nodes$geometry)
+  graph_nodes <- data.frame(
+    name = nodes$id,
+    x    = node_coordinates[, "X"],
+    y    = node_coordinates[, "Y"]
+  )
+
+  # Create graph links
+  link_cooridnates <- st_coordinates(st_centroid(links$geometry))
+  graph_links <- data.frame(
+    from   = links$from,
+    to     = links$to,
+    name   = links$id,
+    x      = link_cooridnates[, "X"],
+    y      = link_cooridnates[, "Y"],
+    weight = st_length(links$geometry)
+  )
+
   graph <- graph_from_data_frame(
     graph_links,
     directed = directed,
     vertices = graph_nodes
   )
 
-  # Set edge weights based on link length
-  E(graph)$weight <- st_length(links)
-
   return(graph)
 }

R/create-line-graph.R

@@ -0,0 +1,40 @@
+#' Create a line graph from a network
+#'
+#' This function creates a line graph where nodes represent the midpoints
+#' of links in the input network.
+#'
+#' @param network A `road_network` or `segmented_network` object.
+#' @return A `igraph` object representing the midpoint graph.
+#' @export
+#' @examples
+#' # Create a road network
+#' network <- create_road_network(sample_roads)
+#'
+#' # Plot the road network
+#' plot(network$graph)
+#'
+#' # Create a midpoint graph from a road network
+#' graph <- create_line_graph(network)
+#'
+#' # Plot the midpoint graph
+#' plot(graph)
+create_line_graph <- function(network) {
+  line_graph <- make_line_graph(network$graph)
+
+  V(line_graph)$name <- E(network$graph)$name
+  V(line_graph)$x <- E(network$graph)$x
+  V(line_graph)$y <- E(network$graph)$y
+
+  E(line_graph)$name <- apply(as_edgelist(line_graph), 1, function(links) {
+    edge_1_nodes <- ends(network$graph, E(network$graph)[links[1]])
+    edge_2_nodes <- ends(network$graph, E(network$graph)[links[2]])
+    intersect(edge_1_nodes, edge_2_nodes)
+  })
+  E(line_graph)$x <- V(network$graph)[E(line_graph)$name]$x
+  E(line_graph)$y <- V(network$graph)[E(line_graph)$name]$y
+  E(line_graph)$weight <- apply(as_edgelist(line_graph), 1, function(links) {
+    (E(network$graph)[links[1]]$weight + E(network$graph)[links[2]]$weight) / 2
+  })
+
+  return(line_graph)
+}

R/pavement-package.R

@@ -6,10 +6,15 @@
 #' @importFrom graphics par
 #' @importFrom graphics segments
 #' @importFrom grDevices heat.colors
+#' @importFrom igraph as_edgelist
 #' @importFrom igraph E
 #' @importFrom igraph E<-
+#' @importFrom igraph ends
 #' @importFrom igraph graph_from_data_frame
 #' @importFrom igraph is_directed
+#' @importFrom igraph make_line_graph
+#' @importFrom igraph V
+#' @importFrom igraph V<-
 #' @importFrom lwgeom st_endpoint
 #' @importFrom lwgeom st_split
 #' @importFrom lwgeom st_startpoint

pkgdown/_pkgdown.yml

@@ -75,7 +75,7 @@ reference:
     with high event frequency with these functions.
   contents:
   - assign_event_to_link
-  - create_midpoint_graph
+  - create_line_graph
   - starts_with("compute_")
 
 - title: Geometry manipulation