File: iterate.R

package info (click to toggle)
r-cran-tidygraph 1.3.1-2
  • links: PTS, VCS
  • area: main
  • in suites: sid, trixie
  • size: 880 kB
  • sloc: cpp: 41; sh: 13; makefile: 2
file content (79 lines) | stat: -rw-r--r-- 2,299 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
#' Repeatedly modify a graph by a function
#'
#' The iterate family of functions allow you to call the same modification
#' function on a graph until some condition is met. This can be used to create
#' simple simulations in a tidygraph friendly API
#'
#' @param .data A `tbl_graph` object
#' @param .f A function taking in a `tbl_graph` as the first argument and
#' returning a `tbl_graph` object
#' @param n The number of times to iterate
#' @param cnd A condition that must evaluate to `TRUE` or `FALSE` determining if
#' iteration should continue
#' @param max_n The maximum number of iterations in case `cnd` never evaluates
#' to `FALSE`
#' @param ... Further arguments passed on to `.f`
#'
#' @return A `tbl_graph` object
#'
#' @rdname iterate
#' @name iterate
#'
#' @examples
#' # Gradually remove edges from the least connected nodes while avoiding
#' # isolates
#' create_notable('zachary') |>
#'   iterate_n(20, function(gr) {
#'     gr |>
#'       activate(nodes) |>
#'       mutate(deg = centrality_degree(), rank = order(deg)) |>
#'       activate(edges) |>
#'       slice(
#'         -which(edge_is_incident(.N()$rank == sum(.N()$deg == 1) + 1))[1]
#'       )
#'   })
#'
#' # Remove a random edge until the graph is split in two
#' create_notable('zachary') |>
#'   iterate_while(graph_component_count() == 1, function(gr) {
#'     gr |>
#'       activate(edges) |>
#'       slice(-sample(graph_size(), 1))
#'   })
#'
NULL

#' @rdname iterate
#' @export
#'
iterate_n <- function(.data, n, .f, ...) {
  check_tbl_graph(.data)
  .f <- rlang::as_function(.f)
  act <- active(.data)
  for (i in seq_len(n)) {
    .data <- .f(.data, ...)
    check_tbl_graph(.data)
  }
  activate(.data, !!rlang::sym(act))
}

#' @rdname iterate
#' @export
#'
iterate_while <- function(.data, cnd, .f, ..., max_n = NULL) {
  check_tbl_graph(.data)
  .f <- rlang::as_function(.f)
  act <- active(.data)
  if (!is.null(max_n) && !rlang::is_integerish(max_n, 1, TRUE)) {
    cli::cli_abort('{.arg max_n} must either be NULL or a single integer')
  }
  cnd <- rlang::enquo(cnd)
  cnd <- rlang::expr(with_graph(.data, !!cnd))
  n <- 1
  while (isTRUE(rlang::eval_tidy(cnd)) && !isTRUE(n > max_n)) {
    .data <- .f(.data, ...)
    check_tbl_graph(.data)
    n <- n + 1
  }
  activate(.data, !!rlang::sym(act))
}