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
|
#' @rdname ggraph
#'
#' @aliases layout_ggraph
#'
#' @export
create_layout <- function(graph, layout, circular, ...) {
if (is_layout(layout)) {
cli::cli_warn(c(
'Ignoring {.arg graph} as layout is already calculated',
i = 'Pass the calculated layout to the {.arg graph} argument to silence this warning'
))
return(layout)
}
UseMethod('create_layout', graph)
}
is_layout <- function(x) inherits(x, 'layout_ggraph')
#' @rdname ggraph
#' @export
create_layout.default <- function(graph, layout, ...) {
graph <- try_fetch(as_tbl_graph(graph), error = function(e) {
cli::cli_abort('No layout function defined for objects of class {.cls {class(graph)[1]}}')
})
create_layout(graph, layout, ...)
}
#' @rdname ggraph
#' @export
create_layout.layout_ggraph <- function(graph, ...) {
graph
}
#' @export
as.data.frame.layout_ggraph <- function(x, ...) {
extra_attr <- names(attributes(x))
extra_attr <- extra_attr[!extra_attr %in% c('names', 'row.names')]
attributes(x)[extra_attr] <- NULL
class(x) <- 'data.frame'
x
}
check_layout <- function(layout) {
if (!is.data.frame(layout)) {
cli::cli_abort('{.arg layout} must be a {.cls data.frame}')
}
if (!(is.numeric(layout$x) && is.numeric(layout$y))) {
cli::cli_abort('{.arg layout} must contain numeric {.col x} and {.col y} columns')
}
graph <- attr(layout, 'graph')
if (!is.tbl_graph(graph)) {
cli::cli_abort('{.arg layout} must have a {.cls tbl_graph} as the {.arg graph} attribute')
}
if (nrow(layout) != gorder(graph)) {
cli::cli_abort('{.arg layout} must contain the same number of rows as the number of nodes in the graph')
}
if (!'circular' %in% names(layout)) {
layout$circular <- FALSE
}
if (!is.logical(layout$circular)) {
cli::cli_abort('The {.col circular} column must be logical')
}
layout
}
|
