✨ Add function to create segmented network

NAMESPACE

@@ -3,14 +3,19 @@
 S3method(extract_segmented_network_nodes,road_network)
 S3method(get_connected_links,road_network)
 S3method(plot,road_network)
+S3method(plot,segmented_network)
 S3method(print,road_network)
+S3method(print,segmented_network)
 S3method(split_linestring,LINESTRING)
 S3method(split_linestring,sfc_LINESTRING)
 S3method(summary,road_network)
+S3method(summary,segmented_network)
 export(bbox_to_polygon)
 export(create_bbox)
+export(create_graph)
 export(create_linestring)
 export(create_road_network)
+export(create_segmented_network)
 export(decompose_linestring)
 export(exclude_points)
 export(extract_road_endpoints)
@@ -31,6 +36,7 @@ export(transform_to_geographic)
 importFrom(igraph,"E<-")
 importFrom(igraph,E)
 importFrom(igraph,graph_from_data_frame)
+importFrom(igraph,is_directed)
 importFrom(lwgeom,st_endpoint)
 importFrom(lwgeom,st_split)
 importFrom(lwgeom,st_startpoint)
@@ -47,6 +53,7 @@ importFrom(sf,st_coordinates)
 importFrom(sf,st_crop)
 importFrom(sf,st_crs)
 importFrom(sf,st_distance)
+importFrom(sf,st_drop_geometry)
 importFrom(sf,st_equals)
 importFrom(sf,st_intersection)
 importFrom(sf,st_is_empty)

R/create-graph.R

@@ -0,0 +1,39 @@
+#' Create a graph from nodes and links
+#'
+#' This function creates a graph object from a set of nodes and links.
+#'
+#' @param nodes A `sf` object representing nodes.
+#' @param links A `sf` object representing links between nodes.
+#' @param directed A logical indicating whether the graph is directed.
+#' @return A `igraph` object.
+#' @export
+#' @examples
+#' # Create nodes and links
+#' nodes <- extract_road_network_nodes(demo_roads)
+#' links <- extract_road_network_links(demo_roads, nodes)
+#'
+#' # Create the graph
+#' graph <- create_graph(nodes, links)
+#'
+#' # Plot the graph
+#' plot(graph)
+create_graph <- function(nodes, links, directed = FALSE) {
+  # Create graph from nodes and links
+  edges <- st_drop_geometry(links)[, c("from", "to")]
+  node_coordinates <- st_coordinates(nodes)
+  vertices <- data.frame(
+    id = nodes$id,
+    x  = node_coordinates[, 1],
+    y  = node_coordinates[, 2]
+  )
+  graph <- graph_from_data_frame(
+    edges,
+    directed = directed,
+    vertices = vertices
+  )
+
+  # Set edge weights based on link length
+  E(graph)$weight <- st_length(links)
+
+  return(graph)
+}

R/create-road-network.R

@@ -11,30 +11,17 @@
 #' @examples
 #' # Create the road network
 #' road_network <- create_road_network(demo_roads)
+#' road_network
 #'
 #' # Plot the road network
 #' plot(road_network)
 create_road_network <- function(roads, directed = FALSE) {
-  # Extract nodes and links from road network
+  # Extract nodes and links of road network
   nodes <- extract_road_network_nodes(roads)
   links <- extract_road_network_links(roads, nodes)
 
   # Create graph from nodes and links
-  edges <- links[, c("from", "to")]
-  node_coordinates <- st_coordinates(nodes)
-  vertices <- data.frame(
-    id = nodes$id,
-    x  = node_coordinates[, 1],
-    y  = node_coordinates[, 2]
-  )
-  graph <- graph_from_data_frame(
-    edges,
-    directed = directed,
-    vertices = vertices
-  )
-
-  # Set edge weights based on link length
-  E(graph)$weight <- st_length(links)
+  graph <- create_graph(nodes, links, directed)
 
   # Construct the road network object
   road_network <- structure(list(

R/create-segmented-network.R

@@ -0,0 +1,82 @@
+#' Create a segmented road network
+#'
+#' This function creates a segmented road network by dividing each link of the
+#' input road network into segments of a specified length.
+#'
+#' @param road_network A `road_network` object representing the input road
+#'   network.
+#' @param segment_length A numeric value specifying the length of each segment.
+#' @return A `segmented_network` object.
+#' @export
+#' @examples
+#' # Create a road network
+#' road_network <- create_road_network(demo_roads)
+#'
+#' # Create a segmented road network
+#' segmented_network <- create_segmented_network(road_network)
+#' segmented_network
+#'
+#' # Plot the segmented road network
+#' plot(segmented_network)
+create_segmented_network <- function(road_network, segment_length = 1) {
+  # Extract nodes and links of segmented road network
+  nodes <- extract_segmented_network_nodes(road_network, segment_length)
+  links <- extract_segmented_network_links(road_network, nodes)
+
+  # Create graph from nodes and links
+  graph <- create_graph(
+    nodes,
+    links,
+    directed = is_directed(road_network$graph)
+  )
+
+  # Construct the road network object
+  segmented_network <- structure(list(
+    graph          = graph,
+    nodes          = nodes,
+    links          = links,
+    origin_network = road_network,
+    segment_length = segment_length
+  ), class = c("segmented_network"))
+
+  return(segmented_network)
+}
+
+#' @export
+print.segmented_network <- function(x, ...) {
+  cat("Segmented network\n")
+  cat("Segment length: ", x$segment_length, "\n")
+  cat("Nodes:\n")
+  if (nrow(x$nodes) <= 5) {
+    print(as.data.frame(x$nodes), ...)
+  } else {
+    print(as.data.frame(x$nodes)[1:5, ], ...)
+    cat("...", nrow(x$nodes) - 5, "more nodes\n")
+  }
+  cat("\n")
+  cat("Links:\n")
+  if (nrow(x$links) <= 5) {
+    print(as.data.frame(x$links), ...)
+  } else {
+    print(as.data.frame(x$links)[1:5, ], ...)
+    cat("...", nrow(x$links) - 5, "more links\n")
+  }
+}
+
+#' @export
+plot.segmented_network <- function(x, ...) {
+  plot(x$links$geometry, lwd = 1, ...)
+  plot(x$nodes$geometry, cex = 1, pch = 16, add = TRUE, ...)
+}
+
+#' @export
+summary.segmented_network <- function(object, ...) {
+  cat("Segmented network summary\n")
+  cat("Segment length:\n")
+  cat("  Desired: ", object$segment_length, "\n")
+  cat("  Max.   : ", max(st_length(object$links)), "\n")
+  cat("  Mean   : ", mean(st_length(object$links)), "\n")
+  cat("  Min.   : ", min(st_length(object$links)), "\n")
+  cat("Number of nodes: ", nrow(object$nodes), "\n")
+  cat("Number of links: ", nrow(object$links), "\n")
+}

R/pavement-package.R

@@ -5,6 +5,7 @@
 #' @importFrom igraph E
 #' @importFrom igraph E<-
 #' @importFrom igraph graph_from_data_frame
+#' @importFrom igraph is_directed
 #' @importFrom lwgeom st_endpoint
 #' @importFrom lwgeom st_split
 #' @importFrom lwgeom st_startpoint
@@ -21,6 +22,7 @@
 #' @importFrom sf st_crop
 #' @importFrom sf st_crs
 #' @importFrom sf st_distance
+#' @importFrom sf st_drop_geometry
 #' @importFrom sf st_equals
 #' @importFrom sf st_intersection
 #' @importFrom sf st_is_empty