Add files via upload

Author: vlarmet

R/RcppExports.R

@@ -13,6 +13,14 @@ Bidir <- function(dep, arr, gfrom, gto, gw, NbNodes) {
     .Call(`_cppRouting_Bidir`, dep, arr, gfrom, gto, gw, NbNodes)
 }
 
+NBA <- function(dep, arr, gfrom, gto, gw, NbNodes, lat, lon, k) {
+    .Call(`_cppRouting_NBA`, dep, arr, gfrom, gto, gw, NbNodes, lat, lon, k)
+}
+
+NBA_path <- function(dep, arr, gfrom, gto, gw, NbNodes, lat, lon, k, dict) {
+    .Call(`_cppRouting_NBA_path`, dep, arr, gfrom, gto, gw, NbNodes, lat, lon, k, dict)
+}
+
 Bidir_path <- function(dep, arr, gfrom, gto, gw, NbNodes, dict) {
     .Call(`_cppRouting_Bidir_path`, dep, arr, gfrom, gto, gw, NbNodes, dict)
 }

R/get_distance_pair.R

@@ -3,14 +3,14 @@
 #' @param Graph  An object generated by cppRouting::makegraph() function.
 #' @param from A vector of one or more vertices from which distances are calculated (origin).
 #' @param to A vector of one or more vertices (destination).
-#' @param algorithm character. "Dijkstra" for uni-directional Dijkstra, "bi" for bi-directional Dijkstra or "A*".Default to "Dijkstra"
+#' @param algorithm character. "Dijkstra" for uni-directional Dijkstra, "bi" for bi-directional Dijkstra, "A*" or "NBA" for New bi-directional A star .Default to "Dijkstra"
 #' @param constant numeric. Constant to maintain the heuristic function admissible in A* algorithm. 
 #' Default to 1, when cost is expressed in the same unit than coordinates. See details
 #' @param allcores Logical. If TRUE, all cores are used.
 #' @return Vector of shortest distances.
 #' @note 'from' and 'to' must be the same length.
 #' @details To perform A*, projected coordinates should be provided in the Graph object.  
-#' In A* algorithm, euclidean distance is used as heuristic function.
+#' In A* algorithms, euclidean distance is used as heuristic function.
 #' To understand how A star algorithm work, see https://en.wikipedia.org/wiki/A*_search_algorithm .
 #' To understand the importance of constant parameter, see the package description : https://github.com/vlarmet/cppRouting
 #'
@@ -31,7 +31,7 @@ get_distance_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1,allcor
 
 
   if (!is.null(Graph$coords)){
-
+    if (algorithm %in% c("NBA","A*","bi")){
    if (algorithm=="A*"){
       message("Running A* ...")
       if (allcores==FALSE) res<-Astar(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,Graph$coords[,2],Graph$coords[,3],constant)
@@ -51,6 +51,27 @@ get_distance_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1,allcor
         return(res)
       }
    }
+    if (algorithm=="NBA"){
+      message("Running NBA* ...")
+      if (allcores==FALSE) res<-NBA(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,Graph$coords[,2],Graph$coords[,3],constant)
+      else {
+        numWorkers <- parallel::detectCores()
+        cl <- parallel::makeCluster(numWorkers, type = "PSOCK")
+        parallel::clusterEvalQ(cl = cl,library("cppRouting"))
+        chunks <- parallel::splitIndices(length(from), ncl = numWorkers)
+        mylist<-lapply(chunks,function(x) from_id[x])
+        mylist2<-lapply(chunks,function(x) to_id[x])
+        
+        
+        res<-parallel::clusterMap(cl,NBA,dep=mylist,arr=mylist2,
+                                  MoreArgs = list(gfrom=Graph$data$from,gto=Graph$data$to,gw=Graph$data$dist,NbNodes=Graph$nbnode,lat=Graph$coords$X,lon=Graph$coords$Y,k=constant))
+        parallel::stopCluster(cl)
+        res<-c(unlist(res))
+        return(res)
+      }
+    }
+    
+    
     if (algorithm=="bi"){
       message("Running bidirectional Dijkstra...")
       if (allcores==FALSE) res<-Bidir(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode)
@@ -68,8 +89,9 @@ get_distance_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1,allcor
         return(res)
       }
     }
+    }
 
-    if (!algorithm %in% c("A*","bi")) {
+    else {
       message("Running Dijkstra ...")
       if (allcores==FALSE) res<-Dijkstra_early_stop(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode)
       else {

R/get_path_pair.R

@@ -3,13 +3,13 @@
 #' @param Graph  An object generated by cppRouting::makegraph() 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 algorithm character. "Dijkstra" for uni-directional Dijkstra, "bi" for bi-directional Dijkstra or "A*".Default to "Dijkstra"
+#' @param algorithm character. "Dijkstra" for uni-directional Dijkstra, "bi" for bi-directional Dijkstra, "A*" or "NBA" for New bi-directional A star .Default to "Dijkstra"
 #' @param constant numeric. Constant to maintain the heuristic function admissible in A* algorithm. 
 #'Default to 1, when cost is expressed in the same unit than coordinates. See details
 #' @return List containing shortest path between from and to.
 #' @note 'from' and 'to' must be the same length.
 #' @details To perform A*, projected coordinates should be provided in the Graph object.  
-#' In A* algorithm, euclidean distance is used as heuristic function.
+#' In A* algorithms, euclidean distance is used as heuristic function.
 #' To understand how A star algorithm work, see https://en.wikipedia.org/wiki/A*_search_algorithm .  
 #' To understand the importance of constant parameter, see the package description : https://github.com/vlarmet/cppRouting .
 #'
@@ -27,19 +27,26 @@ get_path_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1){
 
 
   if (!is.null(Graph$coords)){
-
+    if (algorithm %in% c("NBA","A*","bi")){
     if (algorithm=="A*"){
       message("Running A* ...")
       res<-Astar_paths(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,from_id,to_id,Graph$coords[,2],Graph$coords[,3],constant,Graph$dict$ref)
     }
 
+    if (algorithm=="NBA"){
+      message("Running NBA* ...")
+      res<-NBA_path(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,Graph$coords[,2],Graph$coords[,3],constant,Graph$dict$ref)
+    }
+    
+    
      if (algorithm=="bi"){
       message("Running bidirectional Dijkstra...")
       res<-Bidir_path(from_id,to_id,Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode)
 
+     }
     }
 
-    if (!algorithm %in% c("A*","bi")) {
+    else {
       message("Running Dijkstra ...")
       res<-Dijkstra_early_stop_path(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,from_id,to_id,Graph$dict$ref)