custom-code/ModifiedCorrelogram.R at master · indykpol/custom-code · GitHub

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
function (corr, method = c("square", "circle"), type = c("full",
                                                         "lower", "upper"), ggtheme = ggplot2::theme_minimal, title = "",
          show.legend = TRUE, legend.title = "Corr", show.diag = FALSE,
          colors = c("blue", "white", "red"), outline.color = "gray",
          hc.order = FALSE, hc.method = "complete", lab = FALSE, lab_col = "black",
          lab_size = 4, p.mat = NULL, sig.level = 0.05, insig = c("pch",
                                                                  "blank"), pch = 4, pch.col = "black", pch.cex = 5, tl.cex = 12,
          tl.col = "black", tl.srt = 45)
{
    require(ggcorrplot)
    type <- match.arg(type)
    method <- match.arg(method)
    insig <- match.arg(insig)
    if (!is.matrix(corr) & !is.data.frame(corr))
        stop("Need a matrix or data frame!")
    corr <- as.matrix(corr)
    if (hc.order) {
        ord <- ggcorrplot:::.hc_cormat_order(corr)
        corr <- corr[ord, ord]
        if (!is.null(p.mat))
            p.mat <- p.mat[ord, ord]
    }
    if (type == "lower") {
        corr <- ggcorrplot:::.get_lower_tri(corr, show.diag)
        p.mat <- ggcorrplot:::.get_lower_tri(p.mat, show.diag)
    }
    else if (type == "upper") {
        corr <- ggcorrplot:::.get_upper_tri(corr, show.diag)
        p.mat <- ggcorrplot:::.get_upper_tri(p.mat, show.diag)
    }
    corr <- reshape2::melt(corr, na.rm = TRUE)
    corr$pvalue <- rep(NA, nrow(corr))
    corr$signif <- rep(NA, nrow(corr))
    if (!is.null(p.mat)) {
        p.mat <- reshape2::melt(p.mat, na.rm = TRUE)
        corr$coef <- corr$value
        corr$pvalue <- p.mat$value
        corr$signif <- as.numeric(p.mat$value <= sig.level)
        p.mat <- subset(p.mat, p.mat$value > sig.level)
        if (insig == "blank")
            corr$value <- corr$value * corr$signif
    }
    corr$abs_corr <- abs(corr$value) * 10
    p <- ggplot2::ggplot(corr, ggplot2::aes_string("Var1", "Var2",
                                                   fill = "value"))
    if (method == "square")
        p <- p + ggplot2::geom_tile(color = outline.color)
    else if (method == "circle") {
        p <- p + ggplot2::geom_point(color = outline.color,
                                     shape = 21, ggplot2::aes_string(size = "abs_corr")) +
            ggplot2::scale_size(range = c(4, 10)) + ggplot2::guides(size = FALSE)
    }
    p <- p + ggplot2::scale_fill_gradient2(low = colors[1],
                                           high = colors[3], mid = colors[2], midpoint = .5, limit = c(0,
                                                                                                       1), space = "Lab", name = legend.title) + ggtheme() +
        ggplot2::theme(axis.text.x = ggplot2::element_text(angle = tl.srt,
                                                           vjust = 1, size = tl.cex, hjust = 1), axis.text.y = ggplot2::element_text(size = tl.cex)) +
        ggplot2::coord_fixed()
    label <- round(corr[, "value"], 2)
    if (lab)
        p <- p + ggplot2::geom_text(ggplot2::aes_string("Var1",
                                                        "Var2", label = label), color = lab_col, size = lab_size)
    if (!is.null(p.mat) & insig == "pch") {
        p <- p + ggplot2::geom_point(data = p.mat, ggplot2::aes_string("Var1",
                                                                       "Var2"), shape = pch, size = pch.cex, color = pch.col)
    }
    if (title != "")
        p <- p + ggplot2::ggtitle(title)
    if (!show.legend)
        p <- p + ggplot2::theme(legend.position = "none")
    p <- p + ggcorrplot:::.no_panel()
    p
}