File: delete_graph_actions.R

package info (click to toggle)
r-cran-diagrammer 1.0.11%2Bds-2
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 3,544 kB
  • sloc: javascript: 153; sh: 13; makefile: 2
file content (145 lines) | stat: -rw-r--r-- 3,832 bytes parent folder | download
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
#' Delete one or more graph actions stored within a graph object
#'
#' @description
#'
#' Delete one or more graph actions stored within a graph object of class
#' `dgr_graph`).
#'
#' @inheritParams render_graph
#' @param actions Either a vector of integer numbers indicating which actions to
#'   delete (based on `action_index` values), or, a character vector
#'   corresponding to `action_name` values.
#'
#' @return A graph object of class `dgr_graph`.
#'
#' @examples
#' # Create a random graph using the
#' # `add_gnm_graph()` function
#' graph <-
#'   create_graph() %>%
#'   add_gnm_graph(
#'     n = 5,
#'     m = 8,
#'     set_seed = 23)
#'
#' # Add three graph actions to the
#' # graph
#' graph <-
#'   graph %>%
#'   add_graph_action(
#'     fcn = "set_node_attr_w_fcn",
#'     node_attr_fcn = "get_pagerank",
#'     column_name = "pagerank",
#'     action_name = "get_pagerank") %>%
#'   add_graph_action(
#'     fcn = "rescale_node_attrs",
#'     node_attr_from = "pagerank",
#'     node_attr_to = "width",
#'     action_name = "pagerank_to_width") %>%
#'   add_graph_action(
#'     fcn = "colorize_node_attrs",
#'     node_attr_from = "width",
#'     node_attr_to = "fillcolor",
#'     action_name = "pagerank_fillcolor")
#'
#' # View the graph actions for the graph
#' # object by using the `get_graph_actions()`
#' # function
#' graph %>% get_graph_actions()
#'
#' # Delete the second and third graph
#' # actions using `delete_graph_actions()`
#' graph <-
#'   graph %>%
#'   delete_graph_actions(
#'     actions = c(2, 3))
#'
#' # Verify that these last two graph
#' # actions were deleted by again using
#' # the `get_graph_actions()` function
#' graph %>% get_graph_actions()
#'
#' @export
delete_graph_actions <- function(
    graph,
    actions
) {

  # Get the time of function start
  time_function_start <- Sys.time()

  # Validation: Graph object is valid
  check_graph_valid(graph)

  # Determine whether there any
  # available graph actions
  if (nrow(graph$graph_actions) == 0) {

    cli::cli_abort("There are no graph actions to delete")
  }

  if (inherits(actions, "character")) {

    graph_action_names <-
      graph %>%
      get_graph_actions() %>%
      dplyr::pull("action_name")

    if (!any(actions %in% graph_action_names)) {

      cli::cli_abort(
        "One or more provided `actions` do not exist in the graph.")
    }

    # Get a revised data frame with graph actions
    revised_graph_actions <-
      graph %>%
      get_graph_actions() %>%
      dplyr::filter(!(action_name %in% actions)) %>%
      dplyr::mutate(action_index = dplyr::row_number())
  }

  if (inherits(actions, "numeric")) {

    graph_action_indices <-
      graph %>%
      get_graph_actions() %>%
      dplyr::pull(action_index)

    if (!any(actions %in% graph_action_indices)) {
      cli::cli_abort("One or more provided `actions` do not exist in the graph.")
    }

    # Get a revised data frame with graph actions
    revised_graph_actions <-
      graph %>%
      get_graph_actions() %>%
      dplyr::filter(!(action_index %in% actions)) %>%
      dplyr::mutate(action_index = dplyr::row_number())
  }

  # Replace `graph$graph_actions` with the
  # revised version
  graph$graph_actions <- revised_graph_actions

  # Get the name of the function
  fcn_name <- get_calling_fcn()

  # 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
}