Add files via upload

Author: vlarmet

R/RcppExports.R

@@ -41,6 +41,10 @@ Dijkstra_multi_path <- function(gfrom, gto, gw, NbNodes, dep, arr, dict) {
     .Call(`_cppRouting_Dijkstra_multi_path`, gfrom, gto, gw, NbNodes, dep, arr, dict)
 }
 
+Remove_duplicate <- function(gfrom, gto, gw, NbNodes) {
+    .Call(`_cppRouting_Remove_duplicate`, gfrom, gto, gw, NbNodes)
+}
+
 Isochrone <- function(gfrom, gto, gw, NbNodes, dep, max_limit, dict) {
     .Call(`_cppRouting_Isochrone`, gfrom, gto, gw, NbNodes, dep, max_limit, dict)
 }
@@ -49,3 +53,7 @@ Isochrone_multi <- function(gfrom, gto, gw, NbNodes, dep, limit_vec, max_limit,
     .Call(`_cppRouting_Isochrone_multi`, gfrom, gto, gw, NbNodes, dep, limit_vec, max_limit, setdif, dict)
 }
 
+Simplify2 <- function(gfrom, gto, gw, NbNodes, loop, keep, dict) {
+    .Call(`_cppRouting_Simplify2`, gfrom, gto, gw, NbNodes, loop, keep, dict)
+}
+

R/get_distance_pair.R

@@ -43,8 +43,12 @@ get_distance_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1,allcor
   if (any(is.na(cbind(from,to)))) stop("NAs are not allowed in origin/destination nodes")
 
   from<-as.character(from)
-  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
+  
   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")
+  
+  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
   to_id<-Graph$dict$id[match(to,Graph$dict$ref)]
 
 

R/get_isochrone.R

@@ -29,6 +29,8 @@ get_isochrone<-function(Graph,from,lim,setdif=FALSE){
 
   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)")

R/get_path_pair.R

@@ -41,8 +41,12 @@ get_path_pair<-function(Graph,from,to,algorithm="Dijkstra",constant=1){
 
   if (any(is.na(cbind(from,to)))) stop("NAs are not allowed in origin/destination nodes")
   from<-as.character(from)
-  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
+  
   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")
+  
+  from_id<-Graph$dict$id[match(from,Graph$dict$ref)]
   to_id<-Graph$dict$id[match(to,Graph$dict$ref)]
 
 

R/simplify.R

@@ -0,0 +1,83 @@
+cpp_simplify<-function(Graph,keep=NULL,new_edges=FALSE,rm_loop=TRUE,iterate=FALSE,silent=TRUE){
+  
+  #Nodes to keep
+  to_keep<-rep(0,Graph$nbnode)
+  if (!is.null(keep)) {
+    to_keep[Graph$dict$ref %in% keep]<-1
+  }
+  
+  
+  simp<-Simplify2(Graph$data$from,Graph$data$to,Graph$data$dist,Graph$nbnode,loop=rm_loop,keep = to_keep,dict = Graph$dict$ref)
+  
+  
+  
+  if (new_edges==TRUE)edges<-list(simp[[3]])
+  else edges<-NULL
+
+  
+  
+  
+  #Because removing nodes can create other nodes to remove
+  counter<-1
+  while(iterate==TRUE){
+    if (counter==1 & silent==FALSE) message(paste("  iteration :",counter,"-",Graph$nbnode-simp[[2]],"nodes removed"))
+    
+    if (simp[[2]]==Graph$nbnode) break
+    count<-simp[[2]]
+    
+    
+    
+    rd<-Remove_duplicate(simp[[1]][,1],simp[[1]][,2],simp[[1]][,3],Graph$nbnode)
+    simp<-Simplify2(rd[,1],rd[,2],rd[,3],Graph$nbnode,loop=rm_loop,keep = to_keep,dict = Graph$dict$ref)
+    
+    counter<-counter+1
+    
+    
+    
+    
+    if (count == simp[[2]]) break
+    
+    if(silent==FALSE) message(paste("  iteration :",counter,"-",count-simp[[2]],"nodes removed"))
+    
+    
+    
+    if (new_edges==TRUE) edges[[length(edges)+1]]<-simp[[3]]
+    
+  }
+  
+  rd<-Remove_duplicate(simp[[1]][,1],simp[[1]][,2],simp[[1]][,3],Graph$nbnode)
+
+  
+  simp<-rd
+  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(graph=list(data=simp,
+                         coords=coords,
+                         nbnode=length(Nodes),
+                         dict=dict),
+              new_edges=edges))
+  
+  }

R/to_df.R

@@ -0,0 +1,6 @@
+to_df<-function(Graph){
+  dat<-Graph$data
+  dat$from<-Graph$dict$ref[match(dat$from,Graph$dict$id)]
+  dat$to<-Graph$dict$ref[match(dat$to,Graph$dict$id)]
+  return(dat)
+}