/
plot_life_cycle.R
135 lines (128 loc) · 4.31 KB
/
plot_life_cycle.R
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
#' Plot a life cycle diagram from a matrix population model
#'
#' Plots the life cycle diagram illustrated by a matrix population model. This
#' function processes the matrix model and passes the information to the
#' graphViz function in DiagrammeR. See
#' \url{https://rich-iannone.github.io/DiagrammeR/}.
#'
#' @param matA A matrix population model (i.e., a square projection matrix)
#' @param stages Optional vector of stage class labels. If missing, it first
#' attempts to infer them from \code{dimnames(matA)}. If these are also
#' \code{NULL}, then reverts to integers \code{1:ncol(A)}.
#' @param title Optional title for the plot. Defaults to \code{NULL}.
#' @param shape The shape to be used for the stages of the diagram. Any node
#' shape accepted by \code{graphViz} is acceptable.
#' @param fontsize Size of the font used in the diagram.
#' @param nodefontsize Size of the font used in the node part of the diagram.
#' @param edgecol Colour of the arrows in the diagram.
#' @param node_order An optional numeric vector giving the order that the nodes
#' should be presented in the plot. Default is `NULL` whereby the order is the
#' same as `stages`, or row/column names, of the matrix.
#'
#' @return An object of class \code{grViz} representing the life cycle diagram
#'
#' @author Owen R. Jones <jones@@biology.sdu.dk>
#'
#' @family visualisation
#'
#' @examples
#' matA <- rbind(
#' c(0.1, 0, 0, 0, 1.4),
#' c(0.5, 0.2, 0, 0, 0),
#' c(0, 0.3, 0.3, 0, 0),
#' c(0, 0, 0.4, 0.4, 0.1),
#' c(0, 0, 0, 0.1, 0.4)
#' )
#'
#' plot_life_cycle(matA)
#'
#' # One could save the diagram as a PNG file using a combination of `export_svg`
#' # (from the `DiagrammeRsvg` package) and `rsvg_png` (from the `rsvg` package)
#' # like this:
#' \dontrun{
#' p1 <- plot_life_cycle(matA)
#' p1 %>%
#' DiagrammeRsvg::export_svg %>%
#' charToRaw() %>%
#' rsvg::rsvg_png("my life cycle.png")
#' }
#'
#' # Change the order of the nodes and give them names
#' plot_life_cycle(matA,
#' stages = c("A", "B", "C", "D", "E"),
#' node_order = 5:1
#' )
#'
#' @importFrom DiagrammeR grViz
#' @export plot_life_cycle
plot_life_cycle <- function(matA, stages, title = NULL, shape = "egg",
fontsize = 10, nodefontsize = 12,
edgecol = "grey", node_order = NULL) {
# Identify stages
if (missing(stages) && is.null(dimnames(matA))) {
stages <- seq_len(ncol(matA))
} else if (missing(stages) && !is.null(dimnames(matA))) {
stages <- dimnames(matA)[[1]]
if (!identical(
dimnames(matA)[[1]],
dimnames(matA)[[2]]
)) {
message(strwrap(
prefix = " ", initial = "",
"Dimension names of 'matA' are not identical
for rows and columns. Using row names."
))
}
}
if (length(stages) != nrow(matA)) {
stop("The length of stages does not equal the dimension of matA")
}
if (!is.null(node_order)) {
if (length(node_order) != nrow(matA)) {
stop("The length of node_order does not equal the dimension of matA")
}
}
# Construct a "from" -> "to" graph dataset (edges)
graph <- expand.grid(to = stages, from = stages)
graph$trans <- round(c(matA), 3)
# Subset to only include those where the trans > 0
graph <- graph[graph$trans > 0, ]
# Create vector of node names (add semicolon for use by graphViz)
if (is.null(node_order)) {
nodes <- paste(paste0("'", stages, "'"), collapse = " -> ")
} else {
stages <- stages[order(node_order)]
nodes <- paste(paste0("'", stages, "'"), collapse = " -> ")
}
nodes <- paste0(nodes, " [style=invis]")
# Manipulate minimim length of edge to make the plot pretty (experimental!)
graph$min_len <- (as.numeric(graph$to) - as.numeric(graph$from)) * 3
# Create the edges argument for graphviz by pasting commands together
edges <- paste0("'", graph$from, "'", " -> ", "'", graph$to, "'",
"[minlen=", graph$min_len,
",fontsize=", fontsize,
",color=", edgecol,
",xlabel=", paste("\"", graph$trans),
"\"]\n",
collapse = ""
)
# The graphviz argument, pasted together
grViz(
paste(
"
digraph {
{
graph[overlap=false];
rank=same;
node [shape=", shape, ", fontsize=", nodefontsize, "];",
nodes, "
}",
"ordering=out
x [style=invis]
x -> {", nodes, "} [style=invis]", edges,
"labelloc=\"t\";
label=\"", title, "\"
}"
)
)
}