Updating for new release 1.0.4

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rsppfp
 Title: R's Shortest Path Problem with Forbidden Subpaths
-Version: 1.0.3
+Version: 1.0.4
 Authors@R: c(person("Melina", "Vidoni", email = "[email protected]", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-4099-1430")),
              person("Aldo", "Vecchietti", email = "[email protected]", role = "aut"))
 Maintainer: Melina Vidoni <[email protected]>
@@ -19,7 +19,7 @@ Imports: dplyr,
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 6.1.0
+RoxygenNote: 6.1.1
 Suggests: knitr,
     rmarkdown,
     testthat,

NAMESPACE

@@ -13,6 +13,7 @@ importFrom(foreach,"%do%")
 importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
 importFrom(igraph,E)
+importFrom(igraph,edge_attr)
 importFrom(igraph,graph_from_data_frame)
 importFrom(igraph,shortest_paths)
 importFrom(parallel,makeCluster)

NEWS.md

@@ -1,3 +1,12 @@
+## RSPPFP 1.0.4
+Stable release with minor bug fixes. Released February 2019.
+
+### Minor Bug Fixes and Improvements
+ - Fixed bugs for missing nodes on both transformation algorithms.
+ - The numeric or integer attributes on graphs with multiple attributes are no longer converted to characters. They are parsed to the generic numeric format.
+ - Minor wording changes on warnings and error messages.
+ - Updates to the `get_shortest_path()` function, to improve its functionality.
+
 ## RSPPFP 1.0.3
 Stable release of advanced implementation of rsppfp, with minor bug fixes. Released November 2018.
 

R/hsu.R

@@ -379,8 +379,8 @@ modify_graph_hsu <- function(g, f, cores = 1L) {
   }
 
   # Remove deleted arcs from here
-  g <- g[!(g$from %in% firstOutput[[2]]$from & g$to %in% firstOutput[[2]]$to),]
-  g <- g[!(g$from %in% secondOutput[[2]]$from & g$to %in% secondOutput[[2]]$to),]
+  g <- dplyr::anti_join(g, firstOutput[[2]], by = c("from", "to"))
+  g <- dplyr::anti_join(g, secondOutput[[2]], by = c("from", "to"))
 
   # Now add the new arcs and return
   return(unique(rbind(g, firstOutput[[1]]) %>% rbind(g, secondOutput[[1]]) %>% rbind(thirdOutput)))

R/igraph.R

@@ -33,6 +33,7 @@
 #' @importFrom igraph graph_from_data_frame
 #' @importFrom igraph shortest_paths
 #' @importFrom igraph E
+#' @importFrom igraph edge_attr
 #' @importFrom foreach %do%
 #' @importFrom foreach foreach    
 #'
@@ -51,29 +52,44 @@
 #' get_shortest_path(gStar, "s", "v", "weight")                                                 
 #'
 #'
-get_shortest_path <- function(g, origin, dest, weightColName) {
-  #If there is no weight column
-  if(!weightColName %in% colnames(g)) {
+get_shortest_path <- function(g, origin, dest, weightColName = NULL) {
+  #If there is no weight column specified, assume equal weights
+  if(is.null(weightColName)) {
     g$weight <- 1
     weightColName <- "weight"
+  # If the column could not be found...
+  } else if(!weightColName %in% colnames(g)) {
+    #Show an error
+    stop(weightColName, " is not a variable in `g`.")
   }
 
   # Convert the graph
   g.i <- graph_from_data_frame(g)
 
-
   # Get all nodes where for the destination is the destination
   destEq <- get_all_nodes(g, dest)
 
-  # Find shortest paths from "s" to all N* corresponding to "w"
-  sp <- shortest_paths(g.i, from = origin, to = destEq, 
-                       weights = g$weightColName, output = "both")
+  # Find shortest paths from `origin` to all N* corresponding to `dest`
+  # - suppress warning if not all destinations reachable
+  sp <- suppressWarnings(shortest_paths(g.i, from = origin, to = destEq,
+                                        weights = edge_attr(g.i, weightColName),
+                                        output = "both"))
 
+  # Filter out zero-length paths (return if nothing left)
+  zero_length <- lengths(sp$epath) == 0
+  if (all(zero_length)) {
+    warning("There is no path from ", origin, " to ", dest, ".\n")
+    return (character(0))
+  } else {
+    sp <- lapply(sp, function(element) element[!zero_length])
+  }
 
-  # Find shortest of these paths
-  dist <- vapply(sp$epath, function(path) sum(path$weightColName), numeric(1)) 
+  # Find shortest of remaining paths
+  dist <- vapply(sp$epath, 
+                 function(path) sum(edge_attr(g.i, weightColName, path)),
+                 numeric(1)) 
   shortestPath <- sp$vpath[[which.min(dist)]]
-
+  
   # Convert path with nodes from N* to path with nodes from N
   return( parse_vpath(names(shortestPath)) )
 }

R/privates.R

@@ -41,7 +41,14 @@
 #'    from a controlled space, it assumes that the arc always exists.
 #'
 .get_arc_attributes <- function(g, f, t) {
-  subset(g, from == f & to == t)[1,3:length(colnames(g))]
+  ss <- subset(g, from == f & to == t)[1,3:length(colnames(g))] %>% as.data.frame()
+
+  for(i in 3:ncol(g)) {
+    if(is.numeric(g[,i]) | is.integer(g[,i]))
+      ss[,(i-2)] <- as.numeric(ss[,(i-2)])
+  }
+
+  return(ss)
 }
 
 

R/villeneuve.R

@@ -74,7 +74,7 @@ modify_graph_vd <- function(g, f, cores = 1L) {
   }
   # Check that there are no subpaths in f, otherwise halt the algo
   if(.hasSubpaths(f)) {
-    stop("There are subpaths of some forbidden paths that belong to another subpaths. Use modify_graph_hsu() instead.")
+    stop("There are subpaths of some forbidden paths that belong to another forbidden paths. Use modify_graph_hsu() instead.")
   }
 
 
@@ -128,7 +128,7 @@ modify_graph_vd <- function(g, f, cores = 1L) {
     list(tempNewArcs, tempDelete, tempBannedArcs)
   }
   # Remove deleted arcs from here
-  g <- g[!(g$from %in% firstOutput[[2]]$from & g$to %in% firstOutput[[2]]$to),]
+  g <- dplyr::anti_join(g, firstOutput[[2]], by = c("from", "to"))
 
 
   # Now through the new nodes