Nothing
## ----setup, include = FALSE----------------------------------------------
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>"
)
library(rsppfp)
library(igraph)
library(foreach)
library(doParallel)
library(dplyr)
## ------------------------------------------------------------------------
# Load the sample graph
graph <- data.frame(from = c("s", "s", "s", "u", "u", "w", "w", "x", "x", "v", "v", "y", "y"),
to = c("u", "w", "x", "w", "v", "v", "y", "w", "y", "y", "t", "t", "u"),
cost = c(1L, 4L, 1L, 2L, 7L, 1L, 2L, 5L, 1L, 4L, 1L, 3L, 9L),
stringsAsFactors = FALSE)
# Load the forbidden paths
fpaths <- data.frame(V1 = c("u", "u", "w", "x"), V2 = c("v", "w", "v","w"), V3 = c("y", "y", "y", "v"),
V4 = c("u", "u", NA, "y"), V5 = c(NA, NA, NA, "t"), stringsAsFactors = FALSE)
## ------------------------------------------------------------------------
# Run the algorithm and transform the graph
gStar <- modify_graph_hsu(graph, fpaths)
gStar
## ------------------------------------------------------------------------
# Transform gStar to igraph's data format
gStar.igraph <- graph_from_data_frame(gStar)
## ---- fig.show='hold'----------------------------------------------------
# This can be used to plot the graph
plot(gStar.igraph, edge.arrow.size = 0.5, vertex.size = 20, xlab = "Graph",
vertex.color = "#F1F1F1", vertex.label.color = "#050505")
## ------------------------------------------------------------------------
# This can be used to plot the graph
get_all_nodes(gStar, "v")
## ---- eval=FALSE---------------------------------------------------------
# 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 `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 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)) )
# }
## ---- warning=FALSE------------------------------------------------------
# Obtain the shortest path using the simplified function
shortestPath <- get_shortest_path(gStar, "u", "t", "cost")
shortestPath
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.