From a5b6194157b9682cf946c30ce30cb27c9d3fcca1 Mon Sep 17 00:00:00 2001
From: Keisuke ANDO <ando@maslab.aitech.ac.jp>
Date: Fri, 30 Aug 2024 22:02:26 +0900
Subject: [PATCH] :sparkles: Add function to create midpoint network

---
 NAMESPACE                    |  3 ++
 R/create-graph-links.R       | 15 ++++++++--
 R/create-graph-nodes.R       | 37 ++++++++++++++++++++++++
 R/create-graph.R             | 13 +++------
 R/create-midpoint-graph.R    | 56 ++++++++++++++++++++++++++++++++++++
 R/pavement-package.R         |  1 +
 man/create_graph_nodes.Rd    | 36 +++++++++++++++++++++++
 man/create_midpoint_graph.Rd | 31 ++++++++++++++++++++
 8 files changed, 180 insertions(+), 12 deletions(-)
 create mode 100644 R/create-graph-nodes.R
 create mode 100644 R/create-midpoint-graph.R
 create mode 100644 man/create_graph_nodes.Rd
 create mode 100644 man/create_midpoint_graph.Rd

diff --git a/NAMESPACE b/NAMESPACE
index 356f003..81a77f0 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -13,7 +13,9 @@ export(bbox_to_polygon)
 export(create_bbox)
 export(create_graph)
 export(create_graph_links)
+export(create_graph_nodes)
 export(create_linestring)
+export(create_midpoint_graph)
 export(create_road_network)
 export(create_segmented_network)
 export(decompose_linestring)
@@ -48,6 +50,7 @@ importFrom(sf,st_agr)
 importFrom(sf,st_as_sf)
 importFrom(sf,st_boundary)
 importFrom(sf,st_cast)
+importFrom(sf,st_centroid)
 importFrom(sf,st_collection_extract)
 importFrom(sf,st_contains)
 importFrom(sf,st_coordinates)
diff --git a/R/create-graph-links.R b/R/create-graph-links.R
index dd5c6b9..9f1d3fc 100644
--- a/R/create-graph-links.R
+++ b/R/create-graph-links.R
@@ -9,6 +9,7 @@
 #'   If `TRUE`, the links are directed.
 #' @param unique_links If `TRUE`, the default, the links are unique.
 #'   Duplicate links are removed. If `FALSE`, duplicate links are retained.
+#' @param link_ids A vector of link IDs.
 #' @return A data frame of graph links with columns `from` and `to`.
 #' @export
 #' @examples
@@ -21,11 +22,16 @@
 create_graph_links <- function(source_nodes,
                                target_nodes,
                                directed     = FALSE,
-                               unique_links = TRUE) {
+                               unique_links = TRUE,
+                               link_id      = NULL) {
   # Check if the number of source and target nodes are the same
   if (length(source_nodes) != length(target_nodes)) {
     stop("number of source and target nodes must be the same")
   }
+  # Check if the number of link IDs are the same as the number of links
+  if (!is.null(link_id) && length(link_id) != length(source_nodes)) {
+    stop("number of link IDs must be the same as the number of links")
+  }
 
   # Create links matrix of links
   links_mat <- cbind(source_nodes, target_nodes)
@@ -37,10 +43,13 @@ create_graph_links <- function(source_nodes,
   if (unique_links) links_mat <- unique(links_mat)
 
   # Create a data frame of links
-  links <- data.frame(
+  graph_links <- data.frame(
     from = links_mat[, 1],
     to   = links_mat[, 2]
   )
 
-  return(links)
+  # Add link ID if provided
+  if (!is.null(link_id)) graph_links$id <- link_id
+
+  return(graph_links)
 }
diff --git a/R/create-graph-nodes.R b/R/create-graph-nodes.R
new file mode 100644
index 0000000..a1ec7e2
--- /dev/null
+++ b/R/create-graph-nodes.R
@@ -0,0 +1,37 @@
+#' Create a data frame of nodes for a graph
+#'
+#' This function creates a data frame of nodes for a graph from a set of node
+#' IDs and geometries.
+#'
+#' @param node_ids A vector of node IDs.
+#' @param node_geometries A `sfc_POINT` object containing node geometries.
+#' @return A data frame of nodes with columns `id`, `x`, and `y`.
+#' @export
+#' @examples
+#' library(sf)
+#'
+#' # Create node IDs and geometries
+#' node_ids <- c("jn_000001", "jn_000002", "jn_000003")
+#'
+#' # Create some node geometries
+#' node_geometries <- st_sfc(
+#'   st_point(c(0, 1)),
+#'   st_point(c(1, 0)),
+#'   st_point(c(2, 1))
+#' )
+#'
+#' # Create a data frame of nodes
+#' create_graph_nodes(node_ids, node_geometries)
+create_graph_nodes <- function(node_ids, node_geometries) {
+  # Extract node coordinates
+  coordinates <- st_coordinates(node_geometries)
+
+  # Create a data frame of nodes
+  graph_nodes <- data.frame(
+    id = node_ids,
+    x  = coordinates[, 1],
+    y  = coordinates[, 2]
+  )
+
+  return(graph_nodes)
+}
diff --git a/R/create-graph.R b/R/create-graph.R
index b701d47..39ff415 100644
--- a/R/create-graph.R
+++ b/R/create-graph.R
@@ -19,17 +19,12 @@
 #' 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_links <- st_drop_geometry(links)[, c("from", "to", "id")]
+  graph_nodes <- create_graph_nodes(nodes$id, nodes$geometry)
   graph <- graph_from_data_frame(
-    edges,
+    graph_links,
     directed = directed,
-    vertices = vertices
+    vertices = graph_nodes
   )
 
   # Set edge weights based on link length
diff --git a/R/create-midpoint-graph.R b/R/create-midpoint-graph.R
new file mode 100644
index 0000000..6751ce0
--- /dev/null
+++ b/R/create-midpoint-graph.R
@@ -0,0 +1,56 @@
+#' Create a midpoint graph from a network
+#'
+#' This function creates a midpoint 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(demo_roads)
+#'
+#' # Plot the road network
+#' plot(network$graph)
+#'
+#' # Create a midpoint graph from a road network
+#' graph <- create_midpoint_graph(network)
+#'
+#' # Plot the midpoint graph
+#' plot(graph)
+create_midpoint_graph <- function(network) {
+  # Get adjacent links for each link
+  adjacent_links <- get_adjacent_links(
+    network,
+    network$links$id,
+    reachable_only = TRUE
+  )
+
+  # Create a data frame of links for midpoint graph
+  midpoint_graph_links <- create_graph_links(
+    rep(network$links$id, lengths(adjacent_links)),
+    unlist(adjacent_links),
+    directed     = is_directed(network$graph),
+    unique_links = TRUE
+  )
+
+  # Create a data frame of nodes for midpoint graph
+  midpoint_graph_nodes <- create_graph_nodes(
+    network$links$id,
+    st_centroid(network$links$geometry)
+  )
+
+  # Create a midpoint graph from the links and nodes
+  midpoint_graph <- graph_from_data_frame(
+    midpoint_graph_links,
+    directed = is_directed(network$graph),
+    vertices = midpoint_graph_nodes
+  )
+
+  # Calculate weights for each edge
+  link_indices <- match(as.matrix(midpoint_graph_links), network$links$id)
+  link_length <- st_length(network$links$geometry[link_indices])
+  E(midpoint_graph)$weight <- rowMeans(matrix(link_length, ncol = 2))
+
+  return(midpoint_graph)
+}
diff --git a/R/pavement-package.R b/R/pavement-package.R
index 62866cc..eb657b7 100644
--- a/R/pavement-package.R
+++ b/R/pavement-package.R
@@ -16,6 +16,7 @@
 #' @importFrom sf st_as_sf
 #' @importFrom sf st_boundary
 #' @importFrom sf st_cast
+#' @importFrom sf st_centroid
 #' @importFrom sf st_collection_extract
 #' @importFrom sf st_contains
 #' @importFrom sf st_coordinates
diff --git a/man/create_graph_nodes.Rd b/man/create_graph_nodes.Rd
new file mode 100644
index 0000000..7555381
--- /dev/null
+++ b/man/create_graph_nodes.Rd
@@ -0,0 +1,36 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/create-graph-nodes.R
+\name{create_graph_nodes}
+\alias{create_graph_nodes}
+\title{Create a data frame of nodes for a graph}
+\usage{
+create_graph_nodes(node_ids, node_geometries)
+}
+\arguments{
+\item{node_ids}{A vector of node IDs.}
+
+\item{node_geometries}{A \code{sfc_POINT} object containing node geometries.}
+}
+\value{
+A data frame of nodes with columns \code{id}, \code{x}, and \code{y}.
+}
+\description{
+This function creates a data frame of nodes for a graph from a set of node
+IDs and geometries.
+}
+\examples{
+library(sf)
+
+# Create node IDs and geometries
+node_ids <- c("jn_000001", "jn_000002", "jn_000003")
+
+# Create some node geometries
+node_geometries <- st_sfc(
+  st_point(c(0, 1)),
+  st_point(c(1, 0)),
+  st_point(c(2, 1))
+)
+
+# Create a data frame of nodes
+create_graph_nodes(node_ids, node_geometries)
+}
diff --git a/man/create_midpoint_graph.Rd b/man/create_midpoint_graph.Rd
new file mode 100644
index 0000000..b275a3f
--- /dev/null
+++ b/man/create_midpoint_graph.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/create-midpoint-graph.R
+\name{create_midpoint_graph}
+\alias{create_midpoint_graph}
+\title{Create a midpoint graph from a network}
+\usage{
+create_midpoint_graph(network)
+}
+\arguments{
+\item{network}{A \code{road_network} or \code{segmented_network} object.}
+}
+\value{
+A \code{igraph} object representing the midpoint graph.
+}
+\description{
+This function creates a midpoint graph where nodes represent the midpoints
+of links in the input network.
+}
+\examples{
+# Create a road network
+network <- create_road_network(demo_roads)
+
+# Plot the road network
+plot(network$graph)
+
+# Create a midpoint graph from a road network
+graph <- create_midpoint_graph(network)
+
+# Plot the midpoint graph
+plot(graph)
+}