R/simplify.R

In cppRouting: Algorithms for Routing and Solving the Traffic Assignment Problem

#' Reduce the number of edges by removing non-intersection nodes, duplicated edges and isolated loops in the graph.
#'
#' @param Graph  An object generated by \link{makegraph} function.
#' @param keep Character or integer vector. Nodes of interest that will not be removed. Default to \code{NULL}
#' @param rm_loop Logical. if \code{TRUE}, isolated loops as removed. Default to \code{TRUE}
#' @param iterate Logical. If \code{TRUE}, process is repeated until only intersection nodes remain in the graph. Default to FALSE
#' @param silent Logical. If \code{TRUE} and iterate set to \code{TRUE}, number of iteration and number of removed nodes are printed to the console.
#' @return The simplified cppRouting graph
#' @details To understand why process can be iterated, see the package description : \url{https://github.com/vlarmet/cppRouting/blob/master/README.md}
#' @note Additional edge attributes like \code{aux}, \code{alpha}, \code{beta} and \code{capacity} will be removed.
#' The first iteration usually eliminates the majority of non-intersection nodes and is therefore faster.
#' @examples
#' #Simple directed graph
#' edges<-data.frame(from=c(1,2,3,4,5,6,7,8),
#'                   to=c(0,1,2,3,6,7,8,5),
#'                   dist=c(1,1,1,1,1,1,1,1))
#'
#' #Plot
#' if(requireNamespace("igraph",quietly = TRUE)){
#' igr<-igraph::graph_from_data_frame(edges)
#' plot(igr)
#' }
#'
#' #Construct cppRouting graph
#' graph<-makegraph(edges,directed=TRUE)
#'
#' #Simplify the graph, removing loop
#' simp<-cpp_simplify(graph, rm_loop=TRUE)
#'
#' #Convert cppRouting graph to data frame
#' simp<-to_df(simp)
#'
#' #Plot
#' if(requireNamespace("igraph",quietly = TRUE)){
#' igr<-igraph::graph_from_data_frame(simp)
#' plot(igr)
#' }
#'
#' #Simplify the graph, keeping node 2 and keeping loop
#' simp<-cpp_simplify(graph,keep=2 ,rm_loop=FALSE)
#'
#' #Convert cppRouting graph to data frame
#' simp<-to_df(simp)
#'
#' #Plot
#' if(requireNamespace("igraph",quietly = TRUE)){
#' igr<-igraph::graph_from_data_frame(simp)
#' plot(igr)
#' }
#'

cpp_simplify<-function(Graph,keep=NULL,rm_loop=TRUE,iterate=FALSE,silent=TRUE){

  #Nodes to keep
  to_keep<-rep(0,Graph$nbnode)
  if (!is.null(keep)) {
    keep<-as.character(keep)
    to_keep[Graph$dict$ref %in% keep]<-1
  }


  simp <- cppsimplify(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,
                      keep = to_keep, rm_loop=rm_loop, iterate, !silent)
  simp <- data.frame(simp)
  colnames(simp) <- c("from","to","dist")


  if (nrow(simp)==0) stop("All nodes have been removed")

  Nodes=unique(c(simp[,1],simp[,2]))


  dict<-Graph$dict[Graph$dict$id %in% Nodes,]
  dict$idnew<-0:(nrow(dict)-1)
  simp[,1]<-dict$idnew[match(simp[,1],dict$id)]
  simp[,2]<-dict$idnew[match(simp[,2],dict$id)]
  simp<-as.data.frame(simp)
  simp[,1]<-as.integer(simp[,1])
  simp[,2]<-as.integer(simp[,2])
  colnames(simp)<-c("from","to","dist")
  if (!is.null(Graph$coords)){
    coords<-Graph$coords
    coords<-coords[match(dict$id,Graph$dict$id),]
  }
  else coords=NULL

  dict<-dict[,-2]
  colnames(dict)<-c("ref","id")




  return (list(data=simp,
               coords=coords,
               nbnode=length(Nodes),
               dict=dict,
               attrib = list(aux = NULL, alpha = NULL, beta = NULL, cap = NULL)))

}