1#' Set edge attribute values 2#' 3#' From a graph object of class `dgr_graph`, set edge attribute values for one 4#' or more edges. 5#' 6#' @inheritParams render_graph 7#' @param edge_attr The name of the attribute to set. 8#' @param values The values to be set for the chosen attribute for the chosen 9#' edges. 10#' @param from An optional vector of node IDs from which the edge is outgoing 11#' for filtering list of nodes with outgoing edges in the graph. 12#' @param to An optional vector of node IDs from which the edge is incoming for 13#' filtering list of nodes with incoming edges in the graph. 14#' 15#' @return A graph object of class `dgr_graph`. 16#' 17#' @examples 18#' # Create a simple graph 19#' ndf <- 20#' create_node_df( 21#' n = 4, 22#' type = "basic", 23#' label = TRUE, 24#' value = c(3.5, 2.6, 9.4, 2.7)) 25#' 26#' edf <- 27#' create_edge_df( 28#' from = c(1, 2, 3), 29#' to = c(4, 3, 1), 30#' rel = "leading_to") 31#' 32#' graph <- 33#' create_graph( 34#' nodes_df = ndf, 35#' edges_df = edf) 36#' 37#' # Set attribute `color = "green"` 38#' # for edges `1`->`4` and `3`->`1` 39#' # in the graph 40#' graph <- 41#' graph %>% 42#' set_edge_attrs( 43#' edge_attr = color, 44#' values = "green", 45#' from = c(1, 3), 46#' to = c(4, 1)) 47#' 48#' # Set attribute `color = "blue"` 49#' # for all edges in the graph 50#' graph <- 51#' graph %>% 52#' set_edge_attrs( 53#' edge_attr = color, 54#' values = "blue") 55#' 56#' # Set attribute `color = "pink"` 57#' # for all edges in graph outbound 58#' # from node with ID value `1` 59#' graph <- 60#' graph %>% 61#' set_edge_attrs( 62#' edge_attr = color, 63#' values = "pink", 64#' from = 1) 65#' 66#' # Set attribute `color = "black"` 67#' # for all edges in graph inbound 68#' # to node with ID `1` 69#' graph <- 70#' graph %>% 71#' set_edge_attrs( 72#' edge_attr = color, 73#' values = "black", 74#' to = 1) 75#' 76#' @import rlang 77#' @family Edge creation and removal 78#' @export 79set_edge_attrs <- function(graph, 80 edge_attr, 81 values, 82 from = NULL, 83 to = NULL) { 84 85 # Get the time of function start 86 time_function_start <- Sys.time() 87 88 # Get the name of the function 89 fcn_name <- get_calling_fcn() 90 91 # Get the requested `edge_attr` 92 edge_attr <- 93 rlang::enquo(edge_attr) %>% rlang::get_expr() %>% as.character() 94 95 if (edge_attr %in% c("id", "from", "to")) { 96 97 emit_error( 98 fcn_name = fcn_name, 99 reasons = "You cannot alter edge ID values or attributes associated with node IDs") 100 } 101 102 if (!is.null(from) & !is.null(to)) { 103 if (length(from) != length(to)) { 104 105 emit_error( 106 fcn_name = fcn_name, 107 reasons = "The number of values specified in `from` and `to` must be the same") 108 } 109 } 110 111 # Extract the graph's edf 112 edf <- graph$edges_df 113 114 if (length(values) != 1 & 115 length(values) != nrow(edf)) { 116 117 emit_error( 118 fcn_name = fcn_name, 119 reasons = "The length of values provided must either be 1 or that of the number of rows in the edf") 120 } 121 122 # Get the indices for the edge data frame 123 # that require modification 124 if (is.null(from) & !is.null(to)) { 125 indices <- 126 which(edf$to %in% to) 127 } else if (!is.null(from) & is.null(to)) { 128 indices <- 129 which(edf$from %in% from) 130 } else if (is.null(from) & is.null(to)) { 131 indices <- 1:nrow(edf) 132 } else { 133 indices <- 134 which((edf$from %in% from) & 135 (edf$to %in% to)) 136 } 137 138 # Apply single value to all target edges 139 if (length(values) == 1) { 140 141 if (edge_attr %in% colnames(edf)) { 142 143 edf[indices, 144 which(colnames(edf) %in% 145 edge_attr)] <- values 146 } 147 148 if (!(edge_attr %in% colnames(edf))) { 149 150 # Add a new column and map the edge attribute 151 # value to each of the indices in `edges_df` 152 edf <- 153 dplyr::mutate( 154 edf, 155 new_attr__ = ifelse(as.numeric(row.names(edf)) %in% 156 indices, values, NA)) 157 158 colnames(edf)[ncol(edf)] <- edge_attr 159 } 160 } 161 162 if (length(values) == nrow(edf)) { 163 164 if (edge_attr %in% colnames(edf)) { 165 edf[, which(colnames(edf) %in% 166 edge_attr)] <- values 167 } 168 169 if (!(edge_attr %in% colnames(edf))) { 170 edf <- 171 cbind(edf, 172 rep(as.character(NA), nrow(edf))) 173 174 edf[, ncol(edf)] <- 175 edf[, ncol(edf)] 176 177 colnames(edf)[ncol(edf)] <- edge_attr 178 179 edf[, ncol(edf)] <- values 180 } 181 } 182 183 # Update the graph object 184 graph$edges_df = edf 185 186 # Update the `graph_log` df with an action 187 graph$graph_log <- 188 add_action_to_log( 189 graph_log = graph$graph_log, 190 version_id = nrow(graph$graph_log) + 1, 191 function_used = fcn_name, 192 time_modified = time_function_start, 193 duration = graph_function_duration(time_function_start), 194 nodes = nrow(graph$nodes_df), 195 edges = nrow(graph$edges_df)) 196 197 # Write graph backup if the option is set 198 if (graph$graph_info$write_backups) { 199 save_graph_as_rds(graph = graph) 200 } 201 202 graph 203} 204