inst/doc/igraph.R

## ----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

Try the rsppfp package in your browser

Any scripts or data that you put into this service are public.

rsppfp documentation built on May 1, 2019, 10:27 p.m.