R/graph_metrics/graph_metrics.R

In d2gex/seabasstfm: What the Package Does (One Line, Title Case)

source("R/utils.R")
source("R/graph_legends.R")
source("R/graph_utils.R")
source("R/detections/detection_views.R")
library(igraph)

build_graph_context <- function(data) {
  # build graph and plot
  no_loops_full_graph <- build_basic_graph(data,
                                           loop_or_transition = FALSE,
                                           keep_duplicated_edges =  TRUE)
  only_loops_g <- build_basic_graph(data,
                                    loop_or_transition = TRUE,
                                    keep_duplicated_edges =  TRUE)
  
  no_loop_nodes <- length(V(no_loops_full_graph)) > 0
  only_loop_nodes <- length(V(only_loops_g)) > 0
  
  
  if (!no_loop_nodes) {
    simple_g = NULL
    no_loops_simple_graph = NULL
    simple_g_metric_names <- NULL
    simple_g_average_distance <- 0
  }
  else {
    # Metrics for no-loops graph
    V(no_loops_full_graph)$degree <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_full_graph)) # assignment
    V(no_loops_full_graph)$degree_in <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_full_graph, mode = "in")) # assignment
    V(no_loops_full_graph)$degree_out <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_full_graph, mode = "out")) # assignment
    V(no_loops_full_graph)$betweenness <-
      set_extreme_vals_to_zero(igraph::betweenness(no_loops_full_graph))
    V(no_loops_full_graph)$eigenvector <-
      set_extreme_vals_to_zero(igraph::evcent(no_loops_full_graph)$vector)
    V(no_loops_full_graph)$station_type <-
      substr(V(no_loops_full_graph)$name, 1, 1)
    
    simple_g <- simplify(no_loops_full_graph)
    simple_g_metric_names <-
      c('degree', 'betweenness', 'eigenvector')
    simple_g_average_distance <- mean_distance(no_loops_full_graph)
    
    # Metrics recalculation for the simplified version of the full graph
    no_loops_simple_graph <- simplify(no_loops_full_graph)
    V(no_loops_simple_graph)$degree <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_simple_graph)) # assignment
    V(no_loops_simple_graph)$degree_in <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_simple_graph, mode = "in")) # assignment
    V(no_loops_simple_graph)$degree_out <-
      set_extreme_vals_to_zero(igraph::degree(no_loops_simple_graph, mode = "out")) # assignment
    V(no_loops_simple_graph)$betweenness <-
      set_extreme_vals_to_zero(igraph::betweenness(no_loops_simple_graph))
    V(no_loops_simple_graph)$eigenvector <-
      set_extreme_vals_to_zero(igraph::evcent(no_loops_simple_graph)$vector)
    
  }
  
  
  # Metrics for loops graph
  if (!only_loop_nodes) {
    only_loops_g = NULL
    only_loops_metric_names <- NULL
  }
  else {
    V(only_loops_g)$loops <-
      set_extreme_vals_to_zero(igraph::degree(only_loops_g))
    V(only_loops_g)$station_type <-
      substr(V(no_loops_full_graph)$name, 1, 1)
    only_loops_g <- simplify(only_loops_g)
    only_loops_metric_names <- c('loops')
  }
  
  
  
  # Build Graph Context
  graph_context <- list()
  graph_context$data <- data
  graph_context$no_loops_full_graph <- no_loops_full_graph
  graph_context$only_loops_g <- only_loops_g
  graph_context$simple_g <- simple_g
  graph_context$no_loops_simple_graph <- no_loops_simple_graph
  graph_context$simple_g_metric_names <- simple_g_metric_names
  graph_context$only_loops_metric_names <- only_loops_metric_names
  graph_context$average_distance <- simple_g_average_distance
  
  return(graph_context)
}

build_sample_data <- function (data, start, end, granularity) {
  data <-
    fetch_individuals(data, individuals, grouped = TRUE)
  data <- slide_data_by_date_interval(data,
                                      start, end,
                                      granularity = 'months')
  
  data <- do.call(rbind, data) %>%
    arrange(date_time, ind_name)
  
  return(data)
}



plot_metrics <- function(graph_context,
                         gis_locs,
                         coast,
                         metric_thresholds,
                         metric_date_interval_title) {
  degree_graph <- NULL
  betweenness_graph <- NULL
  eigen_graph <- NULL
  loops_graph <- NULL
  graph_objects <- list()
  
  if (!is.null(graph_context$simple_g)) {
    # Coordinates and bounding box
    coords_simple_g <-
      get_graph_coordinates(graph_context$simple_g, gis_locs)
    bb_simple_g <-
      adjust_coord_bb(coords_simple_g, min_half_size = 2000)
    
    # Degree Centrality
    plot_title <-  gsub("placeholder",
                        "Degree Centrality",
                        metric_date_interval_title)
    metric_name <- "degree"
    
    
    degree_graph <- plot_graph_centrality_metric(
      graph_context$simple_g,
      coords_simple_g,
      gis_locs,
      bb_simple_g,
      coast,
      plot_title,
      metric_name,
      metric_thresholds
    )
    
    # Betweenness Centrality
    plot_title <-  gsub("placeholder",
                        "Betweenness Centrality",
                        metric_date_interval_title)
    metric_name <- "betweenness"
    
    
    betweenness_graph <- plot_graph_centrality_metric(
      graph_context$simple_g,
      coords_simple_g,
      gis_locs,
      bb_simple_g,
      coast,
      plot_title,
      metric_name,
      metric_thresholds
    )
    
    # EigenVector Centrality
    plot_title <-  gsub("placeholder",
                        "Eigenvector Centrality",
                        metric_date_interval_title)
    metric_name <- "eigenvector"
    
    
    eigen_graph <- plot_graph_centrality_metric(
      graph_context$simple_g,
      coords_simple_g,
      gis_locs,
      bb_simple_g,
      coast,
      plot_title,
      metric_name,
      metric_thresholds
    )
  }
  
  
  if (!is.null(graph_context$only_loops_g)) {
    # Coordinates  and bounding box
    coords_only_loops_g <-
      get_graph_coordinates(graph_context$only_loops_g,
                            gis_locs)
    bb_only_loops_g <-
      adjust_coord_bb(coords_only_loops_g, min_half_size = 2000)
    
    # Loops
    plot_title <-  gsub("placeholder",
                        "Loops", metric_date_interval_title)
    metric_name <- "loops"
    
    
    loops_graph <- plot_graph_centrality_metric(
      graph_context$only_loops_g,
      coords_only_loops_g,
      gis_locs,
      bb_only_loops_g,
      coast,
      plot_title,
      metric_name,
      metric_thresholds
    )
    
  }
  
  graph_objects <- Filter(Negate(is.null),
                          list(degree_graph,
                               betweenness_graph,
                               eigen_graph, loops_graph))
  
  if (!length(graph_objects)) {
    return (NULL)
  }
  return (graph_objects)
  
}