R/graph_metrics/tfm_graphs/grid_graph_metrics.R

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

source("R/graph_metrics/input_data.R")


get_meric_top_stations <- function(g, metric_name, num_stations) {
  df <-
    data.frame(names = vertex_attr(g, 'name'),
               values = vertex_attr(g, metric_name))
  return((df %>% arrange(desc(values)) %>% head(num_stations))$names)
  
}

# Get all metric graphs for the the entire time series
metric_names <- c("degree", "betweenness", "eigenvector", "loops")
max_stations <- 6
metric_thresholds = c(100, max_stations) # 80% or minimum 6
graph_context <- build_graph_context(data)
all_graphs <- list()
for (i in seq_along(metric_names)) {
  metric_name <- metric_names[i]
  
  if (metric_name != 'loops') {
    g <- graph_context$simple_g
  }
  else {
    g <- graph_context$only_loops_g
  }
  
  top_stations <-
    get_meric_top_stations(g,
                           metric_name,
                           max_stations)
  sub_graph <- subgraph(g, vids = top_stations)
  coords_simple_g <-
    get_graph_coordinates(sub_graph, locs)
  bb_simple_g <-
    adjust_coord_bb(coords_simple_g, min_half_size = 2000)
  metric_graph <- plot_graph_centrality_metric(
    sub_graph,
    coords_simple_g,
    locs,
    bb_simple_g,
    coast,
    "",
    metric_name,
    metric_thresholds
  )
  all_graphs[[i]] <- metric_graph
}



main_common_title <-
  paste("Node metrics and loops for the",
        max_stations,
        "station with highest score")
tgrob <- text_grob(main_common_title, size = 15, just = "centre")

grid_title_plot <- ggarrange(plotlist = list (as_ggplot(tgrob)),
                             ncol = 1,
                             nrow = 1)

grid_row_1_plot <- ggarrange(plotlist = all_graphs[1:2],
                             ncol = 2,
                             nrow = 1)

grid_row_2_plot <- ggarrange(plotlist = all_graphs[3:4],
                             ncol = 2,
                             nrow = 1)

outer_grid <- ggarrange(
  grid_title_plot,
  grid_row_1_plot,
  grid_row_2_plot,
  ncol = 1,
  nrow = 3,
  heights = c(1, 6, 6)
)

to_path <-
  paste(OUTPUT,
        "/",
        "grid_graph_metrics.pdf",
        suffix,
        sep = "")

plots_to_pdf(list(outer_grid),
             to_path,
             paper_type,
             paper_height,
             paper_width)


# Generate graphs for individual path lengths

monthly_detections <- slide_data_by_date_interval(data,
                                                  start,
                                                  end,
                                                  granularity,
                                                  as_list = FALSE)

individual_graph_data  <- list()
jan_det <- monthly_detections %>% filter(period == '2021-01')
jun_det <- monthly_detections %>% filter(period == '2021-06')

individual_graph_data [[1]] <-
  jan_det %>% select(ind_name, station) %>% filter(ind_name == "DICLAB-54173")
individual_graph_data [[2]] <-
  jun_det %>% select(ind_name, station) %>%filter(ind_name == "DICLAB-54173")
individual_graph_data [[3]] <-
  jan_det %>% select(ind_name, station) %>%filter(ind_name == "DICLAB-16215")
individual_graph_data [[4]] <-
  jun_det %>% select(ind_name, station) %>%filter(ind_name == "DICLAB-16215")
individual_graph_data [[5]] <-
  jan_det %>% select(ind_name, station) %>%filter(ind_name == "DICLAB-40163")
individual_graph_data [[6]] <-
  jun_det %>% select(ind_name, station) %>%filter(ind_name == "DICLAB-40163")

metric_name <- "degree"
max_stations <- 100
metric_thresholds = c(100, max_stations) # 80% or minimum 6
metric_graphs <- list()

for (i in seq_along(individual_graph_data)) {
  if (i <= 2) {
    ind_name <- "54173"
  }
  else if (i > 2 & i<= 4) {
    ind_name <- "16215"
  }
  else {
    ind_name <- "40163"
  }
  if (i %% 2 == 1) {
    month_name <- "January 2021"
  }
  else {
    month_name <- "June 2021"
  }
  
  graph_data <- individual_graph_data [[i]]
  
  gc <- build_graph_context(graph_data)
  coords_simple_g <-
    get_graph_coordinates(gc$simple_g, locs)
  bb_simple_g <-
    adjust_coord_bb(coords_simple_g, min_half_size = 2000)
  
  metric_graph <- plot_graph_centrality_metric(
    gc$simple_g,
    coords_simple_g,
    locs,
    bb_simple_g,
    coast,
    paste("Itinerary", ind_name, "in", month_name),
    metric_name,
    metric_thresholds,
    show_legend = FALSE,
    show_labels = FALSE
  )
  
  metric_graphs[[i]] <- metric_graph
}


main_common_title <- "Example of individual itineraries for January and June 2021"
tgrob <- text_grob(main_common_title, size = 15, just = "centre")

grid_title_plot <- ggarrange(plotlist = list (as_ggplot(tgrob)),
                             ncol = 1,
                             nrow = 1)

grid_row_1_plot <- ggarrange(plotlist = metric_graphs[1:2],
                             ncol = 2,
                             nrow = 1)

grid_row_2_plot <- ggarrange(plotlist = metric_graphs[5:6],
                             ncol = 2,
                             nrow = 1)

outer_grid <- ggarrange(
  grid_title_plot,
  grid_row_1_plot,
  grid_row_2_plot,
  ncol = 1,
  nrow = 3,
  heights = c(1, 6, 6)
)

to_path <-
  paste(OUTPUT,
        "/",
        "example_individual_grid_apl.pdf",
        suffix,
        sep = "")

plots_to_pdf(list(outer_grid),
             to_path,
             paper_type,
             paper_height,
             paper_width)