R/get_isochrone.R

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

#' Compute isochrones/isodistances from nodes.
#'
#' @param Graph  An object generated by \link{makegraph} or \link{cpp_simplify} function.
#' @param from numeric or character. A vector of one or more vertices from which isochrones/isodistances are calculated.
#' @param lim numeric. A vector of one or multiple breaks.
#' @param setdif logical. If \code{TRUE} and \code{length(lim) > 1}, nodes that are reachable in a given break will not appear in a greater one.
#' @param keep numeric or character. Vertices of interest that will be returned.
#' @param long logical. If \code{TRUE}, a long \code{data.frame} is returned instead of a \code{list}.
#' @return \code{list} or a \code{data.frame} containing reachable nodes below cost limit(s).
#' @note \code{get_isochrone()} recursively perform Dijkstra algorithm for each \code{from} nodes and stop when cost limit is reached.
#' @details If \code{length(lim) > 1}, value is a \code{list} of \code{length(from)}, containing \code{list}s of \code{length(lim)}.
#'
#' All algorithms are \strong{multithreaded.} Please use \code{RcppParallel::setThreadOptions()} to set the number of threads.
#'
#' For large graph, \code{keep} argument can be used for saving memory.
#' @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))
#'
#' #Construct directed graph
#' directed_graph<-makegraph(edges,directed=TRUE)
#'
#' #Get nodes reachable around node 4 with maximum distances of 1 and 2
#' iso<-get_isochrone(Graph=directed_graph,from = "4",lim=c(1,2))
#'
#' #With setdif set to TRUE
#' iso2<-get_isochrone(Graph=directed_graph,from = "4",lim=c(1,2),setdif=TRUE)
#' print(iso)
#' print(iso2)

get_isochrone<-function(Graph,from,lim,setdif=FALSE,keep=NULL,long=FALSE){

  if (length(Graph) != 5) stop("Input should be generated by makegraph() or cpp_simplify() function")

  if (any(is.na(from))) stop("NAs are not allowed in origin nodes")
  from<-as.character(from)
  if (sum(from %in% Graph$dict$ref)<length(from)) stop("Some nodes are not in the graph")

  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
  lim<-as.numeric(lim)
  if (any(is.na(lim))) stop("NAs are not allowed in cost value(s)")

  #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)
  }



  if (length(lim) > 1){
    lim<-sort(lim)

    res <- cpppathmat(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,
                      Graph$dict$ref, to_keep, from_id, c(0,0), lim , setdif, 1, FALSE)
    for (i in 1:length(res)) names(res[[i]])<-as.character(lim)
    names(res)<-from
    if (long){
      res<-lapply(res,function(x){
        return(stack(setNames(x,names(x))))
      })
      res<-data.table::rbindlist(res,idcol=TRUE)
      res$ind<-as.character(res$ind)
      colnames(res)<-c("origin","node","lim")
      res<-data.frame(res)
    }
  }
  else {
    res <- cpppath(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,
                   c(0,0), c(0,0), 1, Graph$dict$ref, to_keep, from_id, c(0,0), lim , 4)
    names(res)<-from
    if (long){
      res<-stack(setNames(res,names(res)))
      res$ind<-as.character(res$ind)
      res$lim<-lim
      res<-res[,c(2,1,3)]
      colnames(res)<-c("origin","node","lim")
    }
  }



  return(res)
}