Nothing
#' Undirected Network
#'
#' Generates Undirected Network with an iGraph \strong{gUnd} object,
#' a Data Frame \strong{netUnd} and a Data Frame
#' with Airport/Nodes statistics \strong{nodes}.
#'
#' @param x Data frame
#' @param disp Uses the Serrano's disparity filter (\url{https://en.wikipedia.org/wiki/Disparity_filter_algorithm_of_weighted_network})
#' to extract the backbone of the network.
#' @param alpha Argument for disparity filter.
#' @param cap Filters original data based on the edge weight.
#' @param pct Argument for cap filter. Value should be imput as percentage.
#' @param merge When set to FALSE, it keeps parallel edges instead of collapsing them
#' and summing their weights.
#' @param carrier Groups data per carrier and OD
#' @param metro Groups data by metropolitan area
#'
#' @examples
#' \dontrun{
#' make_net_und(OD_Sample)
#'
#' # Apply Disparity Filter
#' make_net_und(OD_Sample, disp = TRUE, alpha = 0.05)
#'
#' # Apply Percentage Cap
#' make_net_und(OD_Sample, cap = TRUE, pct = 20)
#' }
#'
#' @export
#'
make_net_und <- function(x, disp = FALSE, alpha = 0.003,
cap = FALSE, pct = 10,
merge = TRUE, carrier = FALSE, metro = FALSE){
if(carrier == TRUE & disp == TRUE){
stop("SKYNET doesn't support yet parallel edges on its disparity filter.
Not including the carrier option on the disparity filter mode,
or running the carriers option without the disparity filter mode,
solves the issue for now.")
}
if(metro == TRUE){# Metro option
x <- x %>%
select(-origin, -dest) %>%
rename(origin = origin_mkt_id, dest = dest_mkt_id) %>%
mutate(origin = as.character(origin), dest = as.character(dest))
}
#-------------------------------------------------
if(carrier == TRUE & merge == FALSE){
netUnd_all <- x %>%
select(origin, dest, passengers, op_carrier, year, quarter,
itin_yield, distance) %>%
group_by(origin, dest, op_carrier, year, quarter) %>%
mutate(itin_fare = itin_yield*distance) %>%
summarise(weight = sum(passengers), fare_sd = round(sd(itin_fare), 2),
itin_fare = round(mean(itin_fare), 2),
itin_yield = mean(itin_yield), distance = mean(distance)) %>%
mutate(fare_sd = ifelse(is.na(fare_sd), 0, fare_sd)) %>%
select(-year, -quarter, everything())
}
if(carrier == TRUE & merge == TRUE){
nodes <- node_stats(x)
netUnd_all <- x %>%
select(origin, dest, passengers, op_carrier,
itin_yield, distance, year, quarter) %>%
graph_from_data_frame(directed = FALSE, vertices = nodes) %>%
get.data.frame() %>%
group_by(from, to, op_carrier, year, quarter) %>%
mutate(itin_fare = itin_yield*distance) %>%
summarise(weight = sum(passengers), fare_sd = round(sd(itin_fare), 2),
itin_fare = round(mean(itin_fare), 2),
itin_yield = mean(itin_yield), distance = mean(distance)) %>%
mutate(fare_sd = ifelse(is.na(fare_sd), 0, fare_sd)) %>%
select(-year, -quarter, everything())
}else{
netUnd_all <- x %>%
select(origin, dest, passengers, itin_yield, distance, year, quarter) %>%
group_by(origin, dest, year, quarter) %>%
mutate(itin_fare = itin_yield*distance) %>%
summarise(weight = sum(passengers), fare_sd = round(sd(itin_fare), 2),
itin_fare = round(mean(itin_fare), 2),
itin_yield = mean(itin_yield), distance = mean(distance)) %>%
mutate(fare_sd = ifelse(is.na(fare_sd), 0, fare_sd)) %>%
select(-year, -quarter, everything())
}
#-------------------------------------------------
if(metro == FALSE){
nodes <- node_stats(x)
}else{ # Metro option
nodes <- nodeStatsMetro(x)
}
if(merge == FALSE){
gUnd <- graph_from_data_frame(netUnd_all,
directed = FALSE, vertices = nodes)
}
if(merge == TRUE & carrier == TRUE){
gUnd <- graph_from_data_frame(netUnd_all,
directed = FALSE, vertices = nodes)
}else{
gUnd <- graph_from_data_frame(netUnd_all,
directed = FALSE, vertices = nodes)
# Merges edges and keeps year and quarter
netUnd_all <- as_data_frame(gUnd)
netUnd_all <- netUnd_all %>%
rename(origin = from, dest = to) %>%
group_by(origin, dest, year, quarter) %>%
summarise(weight = sum(weight), fare_sd = round(sd(itin_fare), 2),
itin_fare = round(mean(itin_fare), 2),
itin_yield = mean(itin_yield), distance = mean(distance)) %>%
mutate(fare_sd = ifelse(is.na(fare_sd), 0, fare_sd)) %>%
select(-year, -quarter, everything())
gUnd <- graph_from_data_frame(netUnd_all,
directed = FALSE, vertices = nodes)
# gUnd <- as.undirected(gUnd, mode = "collapse",
# edge.attr.comb=list(weight = "sum",
# itin_fare = "mean",
# itin_yield = "mean",
# fare_sd = "mean",
# distance = "mean"))
}
if(disp == TRUE){
# Run disparity filter
# Creates igraph object
gUnd_disp <- disparity_filter(gUnd, alpha = alpha)
netUnd_disp <- get.data.frame(gUnd_disp)
# Rename fields
netUnd_disp <- netUnd_disp %>%
rename(origin = from, dest = to, passengers = weight)
if(metro == FALSE){
# Add city name
netUnd_disp <- netUnd_disp %>%
left_join(airportCode, by = "origin") %>%
rename(origin_city = city, origin_city_mkt_id = city_mkt_id)
airtemp <- airportCode %>%
rename(dest = origin, dest_city = city, dest_city_mkt_id = city_mkt_id)
netUnd_disp <- netUnd_disp %>%
left_join(airtemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}else{ # Metro Option
netUnd_disp <- netUnd_disp %>%
left_join(MetroLookup, by = "origin") %>%
rename(origin_city = description)
MetroTemp <- MetroLookup %>%
rename(dest = origin, dest_city = description)
netUnd_disp <- netUnd_disp %>%
left_join(MetroTemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}
nodes <- as.data.frame(get.vertex.attribute(gUnd_disp))
nodes <- rename(nodes, airport = name)
netlist <- list(gUnd_disp = gUnd_disp,
netUnd_disp = netUnd_disp, nodes = nodes)
class(netlist) <- "skynet"
return(netlist)
# --------------------------------------------------------------- #
# End of disparity_filter command #
# --------------------------------------------------------------- #
}else if(cap == TRUE){
#Run 10% cap
gUnd_cap <- gUnd
gUnd_cap <- subgraph.edges(gUnd_cap,
which(E(gUnd_cap)$weight > quantile(E(gUnd_cap)$weight,
prob = 1-pct/100)), delete.vertices = TRUE)
# Create datafram based on collapsed edges graph
netUnd_cap <- igraph::as_data_frame(gUnd_cap)
netUnd_cap <- netUnd_cap %>%
rename(origin = from, dest = to, passengers = weight)
if(metro == FALSE){
# Add city name
netUnd_cap <- netUnd_cap %>%
left_join(airportCode, by = "origin") %>%
rename(origin_city = city, origin_city_mkt_id = city_mkt_id)
airtemp <- airportCode %>%
rename(dest = origin, dest_city = city, dest_city_mkt_id = city_mkt_id)
netUnd_cap <- netUnd_cap %>%
left_join(airtemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}else{ # Metro Option
netUnd_cap <- netUnd_cap %>%
left_join(MetroLookup, by = "origin") %>%
rename(origin_city = description)
MetroTemp <- MetroLookup %>%
rename(dest = origin, dest_city = description)
netUnd_cap <- netUnd_cap %>%
left_join(MetroTemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}
nodes <- as.data.frame(get.vertex.attribute(gUnd_cap))
nodes <- rename(nodes, airport = name)
netlist <- list(gUnd_cap = gUnd_cap,
netUnd_cap = netUnd_cap, nodes = nodes)
class(netlist) <- "skynet"
return(netlist)
# --------------------------------------------------------------- #
# End of 10% filter command #
# --------------------------------------------------------------- #
}else{
# Create dataframe based on collapsed edges graph
netUnd_all <- igraph::as_data_frame(gUnd)
netUnd_all <- netUnd_all %>%
rename(origin = from, dest = to, passengers = weight)
if(metro == FALSE){
# Add city name
netUnd_all <- netUnd_all %>%
left_join(airportCode, by = "origin") %>%
rename(origin_city = city, origin_city_mkt_id = city_mkt_id)
airtemp <- airportCode %>%
rename(dest = origin, dest_city = city, dest_city_mkt_id = city_mkt_id)
netUnd_all <- netUnd_all %>%
left_join(airtemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}else{ #Metro Option
netUnd_all <- netUnd_all %>%
left_join(MetroLookup, by = "origin") %>%
rename(origin_city = description)
MetroTemp <- MetroLookup %>%
rename(dest = origin, dest_city = description)
netUnd_all <- netUnd_all %>%
left_join(MetroTemp, by = "dest") %>%
select(-latitude.x, -latitude.y, -longitude.x, -longitude.y)
}
netlist <- list(gUnd = gUnd, netUnd = netUnd_all, nodes = nodes)
class(netlist) <- "skynet"
return(netlist)
}
}
make.netUnd <- function(...){
warning(paste("make.netUnd is deprecated, use make_net_und(), instead."))
do.call(make_net_und, list(...))
}
# --------------------------------------------------------------- #
# --------------------------------------------------------------- #
# End of netUnd command #
# --------------------------------------------------------------- #
# --------------------------------------------------------------- #
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.