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
|
utils::globalVariables(c('i', 'j', 'value'))
#' Correlation PLot (Upper Triangle)
#'
#' Minimal ggplot2 correlation plot showing the upper triangle
#' in the top-right corner with no axis labels.
#' @param R A square numeric correlation matrix
#' @param title Optional plot title
#'
#' @return A ggplot object
#'
#' @examples
#' X <- matrix(data = rnorm(100), nrow = 10)
#' R <- cor(X)
#' corplot(R, title = 'Example Correlation Plot')
#'
#' @importFrom reshape2 melt
#' @import ggplot2
#' @export
corplot <- function(R, title = NULL){
R <- tryCatch({
if(is.matrix(R)){
if(nrow(R) == ncol(R)){
R[upper.tri(R)]
}
}else if(is.vector(R)){
m <- length(R)
n <- (1 + sqrt(1 + 8 * m)) / 2
if(n == floor(n)){
R
}else{
stop('Input length not compatible with upper triangle')
}
}else{
Rm <- as.matrix(R)
if(nrow(Rm) == ncol(Rm)){
Rm[upper.tri(Rm)]
}
}
}, error = function(e){
stop(paste('Invalid input for corplot:', e$message))
})
# Now get a df from the upper triangle
m <- length(R)
n <- as.integer((1 + sqrt(1 + 8 * m)) / 2)
M <- matrix(NA, n, n)
M[upper.tri(M)] <- R
df <- reshape2::melt(M, na.rm = TRUE)
colnames(df) <- c('i', 'j', 'value')
df$i <- factor(df$i, levels = 1:n)
df$j <- factor(df$j, levels = 1:n)
# And plot it
p <- ggplot2::ggplot(
data = df,
ggplot2::aes(x = i, y = j, fill = value)
) +
ggplot2::geom_tile() +
ggplot2::scale_fill_gradient2(
low = 'red',
mid = 'white',
high = 'blue',
midpoint = 0,
name = expression(rho)
) +
ggplot2::scale_x_discrete(limits = rev(levels(df$i))) +
ggplot2::scale_y_discrete(limits = levels(df$j)) +
ggplot2::coord_fixed() +
ggplot2::theme_void()
if(!is.null(title)){
p <- p +
ggplot2::ggtitle(title) +
ggplot2::theme(
plot.title = ggplot2::element_text(hjust = 0.5)
)
}
return(p)
}
|
