1#' Get node IDs associated with edges
2#'
3#' Obtain a vector, data frame, or list of node IDs associated with edges in a
4#' graph object. An optional filter by edge attribute can limit the set of edges
5#' returned.
6#'
7#' @inheritParams render_graph
8#' @param conditions an option to use filtering conditions for the retrieval of
9#'   edges.
10#' @param return_type using `vector` (the default), a vector of character
11#'   objects representing the edges is provided. With `list` a list object will
12#'   be provided that contains vectors of outgoing and incoming node IDs
13#'   associated with edges. With `df`, a data frame containing outgoing and
14#'   incoming node IDs associated with edges.
15#' @param return_values using `id` (the default) results in node ID values
16#'   returned in the edge definitions. With `label`, the node labels will
17#'   instead be used to define edges.
18#'
19#' @return A list, data frame, or a vector object, depending on the value given
20#'   to `return_type`.
21#'
22#' @examples
23#' # Create a node data frame (ndf)
24#' ndf <-
25#'   create_node_df(
26#'     n = 4,
27#'     label = c("one", "two", "three", "four"),
28#'     type = "letter",
29#'     color = c("red", "green", "grey", "blue"),
30#'     value = c(3.5, 2.6, 9.4, 2.7))
31#'
32#' # Create an edge data frame (edf)
33#' edf <-
34#'   create_edge_df(
35#'     from = c(1, 2, 3),
36#'     to = c(4, 3, 1),
37#'     rel = "leading_to",
38#'     color = c("pink", "blue", "blue"),
39#'     value = c(3.9, 2.5, 7.3))
40#'
41#' # Create a graph
42#' graph <-
43#'   create_graph(
44#'     nodes_df = ndf,
45#'     edges_df = edf)
46#'
47#' # Get all edges within a graph, returned as a list
48#' graph %>%
49#'   get_edges(
50#'     return_type = "vector")
51#'
52#' # Get all edges within a graph, returned as a
53#' # data frame
54#' graph %>%
55#'   get_edges(
56#'     return_type = "df")
57#'
58#' # Get all edges returned as a list
59#' graph %>%
60#'   get_edges(
61#'     return_type = "list")
62#'
63#' # Get a vector of edges using
64#' # a numeric comparison (i.e.,
65#' # all edges with a `value`
66#' # attribute greater than 3)
67#' graph %>%
68#'   get_edges(
69#'     conditions = value > 3,
70#'     return_type = "vector")
71#'
72#' # Get a vector of edges using
73#' # a matching condition
74#' graph %>%
75#'   get_edges(
76#'     conditions = color == "pink",
77#'     return_type = "vector")
78#'
79#' # Use multiple conditions to
80#' # return edges with the
81#' # desired attribute values
82#' graph %>%
83#'   get_edges(
84#'     conditions =
85#'       color == "blue" &
86#'       value > 3,
87#'     return_type = "vector")
88#'
89#' # Use `return_values = "label"`
90#' # to return the labels of the
91#' # connected nodes
92#' graph %>%
93#'   get_edges(
94#'     conditions =
95#'       color == "blue" &
96#'       value > 3,
97#'     return_type = "vector",
98#'     return_values = "label")
99#'
100#' @import rlang
101#' @export
102get_edges <- function(graph,
103                      conditions = NULL,
104                      return_type = "vector",
105                      return_values = "id") {
106
107  # Get the name of the function
108  fcn_name <- get_calling_fcn()
109
110  # Capture provided conditions
111  conditions <- rlang::enquo(conditions)
112
113  # Extract edge data frame from the graph
114  edges_df <- graph$edges_df
115
116  if (return_values == "label") {
117    edges_df <-
118      edges_df %>%
119      dplyr::left_join(graph$nodes_df %>% dplyr::select("id", "label"), by = c("from" = "id")) %>%
120      dplyr::rename(from_label_ = label) %>%
121      dplyr::left_join(graph$nodes_df %>% dplyr::select("id", "label"), by = c("to" = "id")) %>%
122      dplyr::rename(to_label_ = label)
123  }
124
125
126  # If conditions are provided then
127  # pass in those conditions and filter the
128  # data frame of `edges_df`
129  if (!is.null(
130    rlang::enquo(conditions) %>%
131    rlang::get_expr())) {
132
133    edges_df <- dplyr::filter(.data = edges_df, !!conditions)
134  }
135
136  # If no edges remain then return NA
137  if (nrow(edges_df) == 0) {
138    return(NA)
139  }
140
141  if (return_type == "list") {
142
143    edges_list <- vector(mode = "list")
144    edges_list[[1]] <- edges_list[[2]] <- vector(mode = "integer")
145
146    if (return_values == "id") {
147      edges_list[[1]] <- c(edges_list[[1]], edges_df$from)
148      edges_list[[2]] <- c(edges_list[[2]], edges_df$to)
149    } else if (return_values == "label") {
150      edges_list[[1]] <- c(edges_list[[1]], edges_df$from_label_)
151      edges_list[[2]] <- c(edges_list[[2]], edges_df$to_label_)
152    }
153
154    return(edges_list)
155  }
156
157  if (return_type == "df") {
158
159    if (return_values == "id") {
160      edges_df <-
161        edges_df %>%
162        dplyr::select("from", "to")
163    } else if (return_values == "label") {
164      edges_df <-
165        edges_df %>%
166        dplyr::select("from_label_", "to_label_")
167    }
168
169    return(edges_df)
170  }
171
172  if (return_type == "vector") {
173
174    if (return_values == "id") {
175      edges_vector <-
176        paste0(edges_df$from, "->", edges_df$to)
177    } else if (return_values == "label") {
178      edges_vector <-
179        paste0(edges_df$from_label_, "->", edges_df$to_label_)
180    }
181
182    return(edges_vector)
183  }
184}
185