R/get_multi_paths.R

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

#' Compute all shortest paths between origin and destination nodes.
#'
#' @param Graph  An object generated by \link{makegraph} or \link{cpp_simplify} function.
#' @param from A vector of one or more vertices from which shortest paths are calculated (origin).
#' @param to A vector of one or more vertices (destination).
#' @param keep numeric or character. Vertices of interest that will be returned.
#' @param long logical. If \code{TRUE}, a long data.frame is returned instead of a list.
#' @return List or a data.frame containing shortest paths.
#' @details \code{get_multi_paths()} recursively perform Dijkstra algorithm for each 'from' nodes. It is the equivalent of \link{get_distance_matrix}, but it return the shortest path node sequence instead of the distance.
#'
#' This algorithm is \strong{multithreaded.} Please use \code{RcppParallel::setThreadOptions()} to set the number of threads.
#'
#' @note Be aware that if 'from' and 'to' have consequent size, output will require much memory space.
#' @seealso  \link{get_path_pair}, \link{get_isochrone}, \link{get_detour}
#' @examples
#' #Choose number of cores used by cppRouting
#' RcppParallel::setThreadOptions(numThreads = 1)
#'
#' #Data describing edges of the graph
#' edges<-data.frame(from_vertex=c(0,0,1,1,2,2,3,4,4),
#'                   to_vertex=c(1,3,2,4,4,5,1,3,5),
#'                   cost=c(9,2,11,3,5,12,4,1,6))
#'
#' #Get all nodes
#' nodes<-unique(c(edges$from_vertex,edges$to_vertex))
#'
#' #Construct directed graph
#' directed_graph<-makegraph(edges,directed=TRUE)
#'
#' #Get all shortest paths (node sequences) between all nodes
#' dir_paths<-get_multi_paths(Graph=directed_graph, from=nodes, to=nodes)
#' print(dir_paths)
#'
#' #Get the same result in data.frame format
#' dir_paths_df<-get_multi_paths(Graph=directed_graph, from=nodes, to=nodes, long = TRUE)
#' print(dir_paths_df)


get_multi_paths<-function(Graph, from ,to ,keep=NULL, long=FALSE){

  if (length(Graph) != 5) stop("Input should be generated by makegraph() or cpp_simplify() function")
  if (any(is.na(cbind(from,to)))) stop("NAs are not allowed in origin/destination nodes")


  from<-as.character(from)
  to<-as.character(to)
  allnodes<-c(from,to)
  if (sum(allnodes %in% Graph$dict$ref)<length(allnodes)) stop("Some nodes are not in the graph")

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

  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
  to_id<-Graph$dict$id[match(to,Graph$dict$ref)]

  if (length(from_id) > length(to_id)){

    res <- cpppathmat(Graph$data$to, Graph$data$from, Graph$data$dist, Graph$nbnode, Graph$dict$ref, to_keep, to_id, from_id, 0, FALSE, 0, TRUE)

  } else{

    res <- cpppathmat(Graph$data$from, Graph$data$to, Graph$data$dist, Graph$nbnode, Graph$dict$ref, to_keep, from_id, to_id, 0, FALSE, 0, FALSE)


  }

  names(res)<-from

  for (i in 1:length(res)) names(res[[i]])<-to

  if (long){
    res<-lapply(res,function(x){
      return(stack(setNames(x,names(x))))
    })
    res<-data.table::rbindlist(res,idcol=TRUE)
    res<-res[,c(1,3,2)]
    res$ind<-as.character(res$ind)
    colnames(res)<-c("from","to","node")
    res<-data.frame(res)
  }

  return(res)
}