1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
|
#' Delete one of the global graph attributes stored within a graph object
#'
#' @description
#'
#' Delete one of the global attributes stored within a graph object of class
#' `dgr_graph`).
#'
#' @inheritParams render_graph
#' @param attr The name of the attribute to delete for the `type` of global
#' attribute specified.
#' @param attr_type The specific type of global graph attribute to delete. The
#' type is specified with `graph`, `node`, or `edge`.
#'
#' @return A graph object of class `dgr_graph`.
#'
#' @examples
#' # Create a new graph and add
#' # some extra global graph attrs
#' graph <-
#' create_graph() %>%
#' add_global_graph_attrs(
#' attr = "overlap",
#' value = "true",
#' attr_type = "graph") %>%
#' add_global_graph_attrs(
#' attr = "penwidth",
#' value = 3,
#' attr_type = "node") %>%
#' add_global_graph_attrs(
#' attr = "penwidth",
#' value = 3,
#' attr_type = "edge")
#'
#' # Inspect the graph's global
#' # attributes
#' graph %>%
#' get_global_graph_attr_info()
#'
#' # Delete the `penwidth` attribute
#' # for the graph's nodes using the
#' # `delete_global_graph_attrs()` fcn
#' graph <-
#' graph %>%
#' delete_global_graph_attrs(
#' attr = "penwidth",
#' attr_type = "node")
#'
#' # View the remaining set of global
#' # attributes for the graph
#' graph %>%
#' get_global_graph_attr_info()
#'
#' @export
delete_global_graph_attrs <- function(
graph,
attr = NULL,
attr_type = NULL
) {
# Get the time of function start
time_function_start <- Sys.time()
# Get the name of the function
fcn_name <- get_calling_fcn()
# Validation: Graph object is valid
check_graph_valid(graph)
# If no `attr` or `attr_type` provided then
# all global graph attributes will be removed
if (is.null(attr) && is.null(attr_type)) {
# Clear the global graph attributes data frame
# by removing all rows from it
graph$global_attrs <-
graph$global_attrs[-(seq_len(nrow(graph$global_attrs))), ]
message(
glue::glue("Deleted all existing global graph attributes."))
}
# If an `attr` is provided but not an
# `attr_type`, then delete all of those
# `attr`s without regard to their type
if (is.null(attr_type) && !is.null(attr)) {
# Capture provided attr
attr <- rlang::enquo(attr)
graph$global_attrs <-
graph$global_attrs %>%
dplyr::filter(!(attr %in% !!attr))
}
if (!is.null(attr_type) && is.null(attr)) {
# Stop function if `attr_type` is not a valid
# attribute type
if (length(attr_type) > 1) {
cli::cli_abort("Problem. attr_type must be")
}
rlang::arg_match(attr_type, c("graph", "node", "edge"), multiple = TRUE)
# Capture provided `attr_type`
attr_type <- rlang::enquo(attr_type)
graph$global_attrs <-
graph$global_attrs %>%
dplyr::filter(!(attr_type %in% !!attr_type))
}
if (!is.null(attr_type) && !is.null(attr)) {
# Stop function if `attr_type` is not a valid
# attribute type
rlang::arg_match(attr_type, c("graph", "node", "edge"), multiple = TRUE)
# Get the global graph attributes already set
# in the graph object
global_attrs_available <- graph$global_attrs
# Create a table with a single row for the
# attribute to remove
global_attrs_to_remove <-
dplyr::tibble(
attr = as.character(attr),
value = NA_character_,
attr_type = as.character(attr_type)) %>%
as.data.frame(stringsAsFactors = FALSE)
# Use the `anti_join()` to remove global attribute
# rows from the graph
global_attrs_joined <-
global_attrs_available %>%
dplyr::anti_join(
global_attrs_to_remove,
by = c("attr", "attr_type"))
# Replace the graph's global attributes with
# the revised set
graph$global_attrs <- global_attrs_joined
}
# Update the `graph_log` df with an action
graph$graph_log <-
add_action_to_log(
graph_log = graph$graph_log,
version_id = nrow(graph$graph_log) + 1L,
function_used = fcn_name,
time_modified = time_function_start,
duration = graph_function_duration(time_function_start),
nodes = nrow(graph$nodes_df),
edges = nrow(graph$edges_df))
# Write graph backup if the option is set
if (graph$graph_info$write_backups) {
save_graph_as_rds(graph = graph)
}
graph
}
|
