R/create_subgraph_year.R

In Framus94/HierarchiesAndCareers:

create_subgraph_year <- function(.graph, .lower_boundary_yr, .yr_of_interest,
                                 .output_as_edge_df = F,
                                 .only_active_place = T,
                                 .only_n_past_exh = NULL
                                 ){

  # ---- CREATE SUBGRAPH ----
  # all edges will be taken into account that are between lower boundary and year of interest
  edges_subset <- E(.graph)[[exh_start_Y_from   >= .lower_boundary_yr
                             & exh_start_Y_from <= .yr_of_interest
                             & exh_start_Y_to   >= .lower_boundary_yr
                             & exh_start_Y_to   <= .yr_of_interest]]

  subgraph <- subgraph.edges(.graph, eids = edges_subset, delete.vertices = T) %>%
    tidygraph::as_tbl_graph()

  # ---- ONLY ACTIVE VENUES ----
  # inactive venues will no longer receive ties but have outward ties to active venues
  # hence, active venues will still receive ties whereas the status inactive venues will diminish
  # but not removed completely (assures stability for centrality computation)
  if(.only_active_place == T){

    # return output as graph
    subgraph <- subgraph %>%
      tidygraph::activate(edges) %>%
      tidygraph::mutate(venue_to_active_until = tidygraph::.N()$last_exh_yr[to],
                        venue_from_active_until = tidygraph::.N()$last_exh_yr[from],

                        from_is_inactive_and_to_is_active = if_else(exh_start_Y_to > venue_from_active_until
                                                                    & exh_start_Y_to <= venue_to_active_until, TRUE, FALSE),
                        in_yr_of_interest_to_is_active = if_else(venue_to_active_until >= .yr_of_interest, TRUE, FALSE),
                        in_yr_of_interest_from_is_active = if_else(venue_from_active_until >= .yr_of_interest, TRUE, FALSE)) %>%
      tidygraph::filter(in_yr_of_interest_to_is_active)

  }

  # ---- PAST EXHIBITIONS ----
  # restrict number of past number of exhibitions from .yr_of_interest
  # e.g. if only 5 past exh selected function will keep the latest 5 exh
  if(!is.null(.only_n_past_exh)){

    subgraph_edges <- subgraph %>%
      igraph::as_data_frame("edges") %>%
      dplyr::group_by(from) %>%
      dplyr::arrange(- exh_start_Ym_from) %>%
      dplyr::mutate(exh_chronology_per_venue = row_number()) %>%  # add .5 to include multiple ranks
      dplyr::filter(exh_chronology_per_venue <= .only_n_past_exh)

    nodes <- subgraph %>%
      igraph::as_data_frame("vertices") %>%
      dplyr::filter(name %in% subgraph_edges$from | name %in% subgraph_edges$to)

    subgraph <- igraph::graph_from_data_frame(subgraph_edges, directed = T, vertices = nodes) %>%
      tidygraph::as_tbl_graph()

  }

  # ---- AS EDGE DATA FRAME ----
  if(.output_as_edge_df == T){

    subgraph <- subgraph %>%
      igraph::as_data_frame("edges") %>%
      tidygraph::select(from, to, exh_start_Y_from, exh_start_Y_to, contains("is_"), contains("active_until"), everything())
    #distinct(from_is_inactive_to_is_active, in_yr_of_interest_to_is_active, in_yr_of_interest_from_is_active, .keep_all = T) %>% View()

  }

  return(subgraph)
}