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
|
#' Network Plot
#'
#' Draw an undirected graph from a square matrix
#' where each variable is a node and the pairwise
#' entries are the strength of the relationship
#' (ex: correlation, partial correlation)
#'
#' @param R A square numeric matrix with names columns and rows
#' @param title Optional plot title
#'
#' @return A ggraph object
#'
#' @examples
#' X <- matrix(data = rnorm(100), nrow = 10)
#' R <- cor(X)
#' networkplot(R, title = 'Example Correlation Plot')
#'
#' @import ggraph
#' @import igraph
#'
#' @export
networkplot <- function(R, title = NULL){
Rm <- tryCatch({
if(is.matrix(R)){
if(nrow(R) != ncol(R)) stop('R must be square')
Rm <- R
}else if(is.vector(R)){
m <- length(R)
n <- (1 + sqrt(1 + 8 * m)) / 2
if(n != floor(n)) stop('Vector length not compatible with upper triangle')
n <- as.integer(n)
Rm <- matrix(0, n, n)
Rm[upper.tri(Rm)] <- R
Rm <- Rm + t(Rm)
diag(Rm) <- 1
}else{
Rm <- as.matrix(R)
if(nrow(Rm) != ncol(Rm)) stop('R must be square')
}
if(is.null(rownames(Rm))){
rownames(Rm) <- as.character(seq_len(nrow(Rm)))
}
if(is.null(colnames(Rm))){
colnames(Rm) <- as.character(seq_len(ncol(Rm)))
}
Rm
}, error = function(e){
stop(paste('Invalid input for networkplot:', e$message))
})
idx <- which(upper.tri(Rm), arr.ind = TRUE)
edges <- data.frame(
from = rownames(Rm)[idx[,1]],
to = colnames(Rm)[idx[,2]],
r = Rm[idx]
)
g <- igraph::graph_from_data_frame(
edges,
directed = FALSE
)
p <- ggraph::ggraph(graph = g, layout = 'circle') +
ggraph::geom_edge_arc(
ggplot2::aes(
edge_alpha = abs(.data$r),
edge_color = .data$r
),
strength = 0.5
) +
ggraph::scale_edge_color_gradient2(
low = 'red',
mid = 'white',
high = 'blue',
midpoint = 0,
limits = c(-1, 1),
guide = 'none'
) +
ggraph::geom_node_point(size = 3) +
ggraph::geom_node_text(
ggplot2::aes(label = .data$name),
repel = TRUE,
size = 3
) +
ggplot2::theme_void() +
ggplot2::theme(legend.position = 'none')
if(!is.null(title)){
p <- p +
ggplot2::ggtitle(title) +
ggplot2::theme(
plot.title = ggplot2::element_text(hjust = 0.5)
)
}
return(p)
}
|