-
Notifications
You must be signed in to change notification settings - Fork 2
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge pull request #21 from EvolEcolGroup/test_dijkstra_from
Simplify dijkstra code and add tests
- Loading branch information
Showing
14 changed files
with
407 additions
and
144 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -163,51 +163,58 @@ setMethod("dijkstraBetween", "gGraph", function(x, from, to) { | |
| #' @rdname dijkstra-methods | ||
| #' @export | ||
| setMethod("dijkstraBetween", "gData", function(x) { | ||
| ## temp <- function(x){ # for debugging | ||
| # we transform the gData object to gGraph, extracting the nodes from the gData object. | ||
| # The node ids are found in the @nodes.id of the gData object: in this case we | ||
| # can call getNodes(). | ||
| # Then simply pass the new gGraph object to the method for gGraph. | ||
|
|
||
| ## some checks ## | ||
| if (!require(RBGL)) stop("RBGL is required.") | ||
| if (!is.gData(x)) stop("x is not a valid gData object") | ||
| if (!exists(x@gGraph.name, envir = .GlobalEnv)) stop(paste("gGraph object", x@gGraph.name, "not found.")) | ||
| if (length(x@nodes.id) == 0) stop("No assigned nodes ([email protected] is empty).") | ||
| if (!isConnected(x)) stop("Not all locations are connected by the graph.") | ||
| # if (!isConnected(x)) stop("Not all locations are connected by the graph.") | ||
|
|
||
| ## build the wrapper ## | ||
| # @TODO check labels to keep | ||
| myGraph <- get(x@gGraph.name, envir = .GlobalEnv) | ||
| coords <- getCoords(myGraph) # store xy coords for later | ||
| myGraph <- getGraph(myGraph) # don't do this before getCoords | ||
|
|
||
| ## build indices of all pairwise combinations ## | ||
| pairIdStart <- integer() | ||
| pairIdStop <- integer() | ||
|
|
||
| for (i in 1:(length(getNodes(x)) + 1)) { | ||
| j <- i | ||
| while ((j <- j + 1) < length(getNodes(x)) + 1) { | ||
| pairIdStart <- c(pairIdStart, i) | ||
| pairIdStop <- c(pairIdStop, j) | ||
| } | ||
| } | ||
|
|
||
| ## wrap ## | ||
| ## ! sp.between does not return duplicated paths | ||
| res <- RBGL::sp.between(myGraph, start = x@nodes.id[pairIdStart], finish = x@nodes.id[pairIdStop]) | ||
|
|
||
|
|
||
| ## handle duplicated paths ## | ||
| if (length(res) < length(pairIdStart)) { # res should have length = pairIdStart | ||
| fromTo <- paste(x@nodes.id[pairIdStart], x@nodes.id[pairIdStop], sep = ":") # all different paths | ||
| res <- res[fromTo] | ||
| } | ||
|
|
||
|
|
||
| ## make it a class "gPath" (output + xy coords) ## | ||
| allNodes <- unique(unlist(lapply(res, function(e) e$path_detail))) | ||
| ## res$xy <- getCoords(x)[allNodes,] | ||
| attr(res, "xy") <- coords[allNodes, ] | ||
| class(res) <- "gPath" | ||
|
|
||
| return(res) | ||
| myNodes <- getNodes(x) | ||
| dijkstraBetween(myGraph,from=myNodes, to=myNodes) | ||
| # | ||
| # coords <- getCoords(myGraph) # store xy coords for later | ||
| # myGraph <- getGraph(myGraph) # don't do this before getCoords | ||
| # | ||
| # ## build indices of all pairwise combinations ## | ||
| # pairIdStart <- integer() | ||
| # pairIdStop <- integer() | ||
| # | ||
| # for (i in 1:(length(getNodes(x)) + 1)) { | ||
| # j <- i | ||
| # while ((j <- j + 1) < length(getNodes(x)) + 1) { | ||
| # pairIdStart <- c(pairIdStart, i) | ||
| # pairIdStop <- c(pairIdStop, j) | ||
| # } | ||
| # } | ||
| # | ||
| # ## wrap ## | ||
| # ## ! sp.between does not return duplicated paths | ||
| # res <- RBGL::sp.between(myGraph, start = [email protected][pairIdStart], finish = [email protected][pairIdStop]) | ||
| # | ||
| # | ||
| # ## handle duplicated paths ## | ||
| # if (length(res) < length(pairIdStart)) { # res should have length = pairIdStart | ||
| # fromTo <- paste([email protected][pairIdStart], [email protected][pairIdStop], sep = ":") # all different paths | ||
| # res <- res[fromTo] | ||
| # } | ||
| # | ||
| # | ||
| # ## make it a class "gPath" (output + xy coords) ## | ||
| # allNodes <- unique(unlist(lapply(res, function(e) e$path_detail))) | ||
| # ## res$xy <- getCoords(x)[allNodes,] | ||
| # attr(res, "xy") <- coords[allNodes, ] | ||
| # class(res) <- "gPath" | ||
| # | ||
| # return(res) | ||
| }) # end dijkstraBetween for gData | ||
|
|
||
|
|
||
|
|
@@ -249,21 +256,24 @@ setMethod("dijkstraFrom", "gGraph", function(x, start) { | |
| if (!all(start %in% getNodes(x))) stop("Starting node is not in x.") | ||
|
|
||
| ## check connectivity ## | ||
| if (!areConnected(x, getNodes(myGraph))) stop("Not all nodes are connected by the graph.") | ||
|
|
||
| if (!areConnected(x, getNodes(x))) stop("Not all nodes are connected by the graph.") | ||
| ## build the wrapper ## | ||
| myGraph <- getGraph(x) | ||
| ## if(is.character(costs) && costs=="default"){ | ||
| ## costs <- unlist(edgeWeights(myGraph)) | ||
| endNodes <- getNodes(x)[!getNodes(x) %in% start] | ||
| ## } | ||
|
|
||
| #browser() | ||
| ## wrap ## | ||
| res <- RBGL::dijkstra.sp(myGraph, start = start) | ||
| #res <- RBGL::dijkstra.sp(myGraph, start = start) | ||
| res <- RBGL::sp.between(myGraph, start = start, | ||
| finish = endNodes) | ||
|
|
||
| ## sp.between uses unique([email protected]) ## | ||
| ## eventually have to duplicate paths ## | ||
| temp <- gsub(".*:", "", names(res)) | ||
| res <- res[match(getNodes(x), temp)] | ||
| res <- res[match(endNodes, temp)] | ||
|
|
||
|
|
||
| ## make it a class "gPath" (output + xy coords) ## | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.