2019-12-11用ggcor画相关性图


节选自http://houyun.xyz/post/2019/10/26/ggcor/

安装绘图R包(还处在开发阶段)

1
2
3
4
if(!require(devtools))
  install.packages("devtools")
if(!require(ggcor))
  devtools::install_github("houyunhuang/ggcor", force = TRUE)

绘制基本图，如同corrplot包一样方便

1
library(ggcor)
1
## Loading required package: ggplot2
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
## ggcor可以调整的参数比较多，并且处于开发阶段，主要的参数是以下几个：
##          function(
##                   x,
##                   y = NULL,
##                   type = c("full", "upper", "lower"),
##                   show.diag = FALSE,
##                   cor.test = FALSE,
##                   cor.test.alt = "two.sided",
##                   cor.test.method = "pearson",
##                   cluster.type = c("none", "all", "row", "col"),
##                   cluster.method = "HC",
##                   cluster.absolute = FALSE,
##                   keep.name = FALSE,
##                   ...)
## ggcor提供了定制的geom_square()、geom_circle2()、geom_ellipse2()、geom_pie2()、geom_colour()、geom_confbox()、geom_num()、geom_mark()、geom_cross()9个ggplot2图层函数，可以根据需要进行叠加。除了ggplot2中一般化的参数（x、y、fill、colour、size等）最常用参数r、p、low、upp、num、r0、sig.thres、sig.level、mark等。
ggcor(mtcars) + geom_square()

image.png

1
ggcor(mtcars, type = "upper") + geom_circle2()

image.png

1
ggcor(mtcars, type = "lower", show.diag = TRUE) + geom_ellipse2()

image.png

1
ggcor(mtcars, type = "full", cluster.type = "all") + geom_pie2()
1
2
3
## Registered S3 method overwritten by 'gclus':
##   method         from
##   reorder.hclust vegan
1
2
3
## Registered S3 method overwritten by 'dendextend':
##   method     from
##   rev.hclust vegan
1
2
3
## Registered S3 method overwritten by 'seriation':
##   method         from
##   reorder.hclust gclus

image.png

1
2
3
ggcor(mtcars, cluster.type = "all") +
  geom_colour() +
  geom_num(aes(num = r), colour = "grey90", size = 3.5)#可以标记相关系数的图层

image.png

1
ggcor(mtcars, type = "full", cor.test = TRUE) + geom_confbox()

image.png

1
2
3
ggcor(mtcars, type = "full", cor.test = TRUE, cluster.type = "all") +
  geom_colour() +
  geom_cross()

image.png

1
2
3
ggcor(mtcars, type = "full", cor.test = TRUE, cluster.type = "all") +
  geom_raster() +
  geom_mark(sig.thres = 0.05, size = 3, colour = "grey90")#过滤掉不显著的值

image.png

1
2
3
ggcor(mtcars, type = "full", cor.test = TRUE, cluster.type = "all") +
  geom_raster() +
  geom_mark(r = NA, sig.thres = 0.05, size = 5, colour = "grey90")#不标记系数，只标记显著符号

image.png

1
2
3
ggcor(mtcars, type = "full", cor.test = TRUE, cluster.type = "all") +
  geom_raster() +
  geom_mark(r = NA, sig.level = 0.05, mark = "*", vjust = 0.65, size = 6, colour = "grey90")

image.png

绘制非对称相关系数图，这个功能非常独有

1
library(vegan) # 使用vegan包所带的数据集
1
## Loading required package: permute
1
## Loading required package: lattice
1
## This is vegan 2.5-6

1
2
3
4
data(varechem)
data(varespec)
df03 <- fortify_cor(x = varechem, y = varespec[ , 1:30], cluster.type = "col")#调用fortify_cor()函数来处理数据
ggcor(df03) + geom_colour()

image.png

1
2
df04 <- fortify_cor(x = varespec[ , 1:30], y = varechem, cor.test = TRUE)
ggcor(df04) + geom_square() + geom_cross(size = 0.2)

image.png

绘制上下三角不一样相关系数图

1
2
df05 <- fortify_cor(x = varechem, cor.test = TRUE, cluster.type = "all")
ggcor(df05) + geom_circle2()

image.png

1
2
df05_lower <- get_lower_data(df05, show.diag = FALSE)
ggcor(df05_lower) + geom_circle2()

image.png

1
2
3
ggcor(df05) +
  geom_pie2(data = get_data(type = "upper", show.diag = FALSE)) +
  geom_ellipse2(data = get_data(type = "lower", show.diag = TRUE))

image.png

1
2
3
4
5
6
7
8
9
ggcor(df05) +
  geom_segment(aes(x = x - 0.5, y = y + 0.5, xend = x + 0.5, yend = y - 0.5),
               data = get_data(type = "diag"), size = 0.5, colour = "grey60") +
  geom_colour(data = get_data(type = "upper", show.diag = FALSE)) +
  geom_mark(data = get_data(type = "upper", show.diag = FALSE), size = 3) +
  geom_circle2(data = get_data(r >= 0.5, type = "lower", show.diag = FALSE),
               r = 0.8, fill = "#66C2A5") +
  geom_num(aes(num = r), data = get_data(type = "lower",
                                         show.diag = FALSE), size = 3)

image.png

列名放在对角线

1
2
3
4
ggcor(mtcars, cor.test = TRUE, cluster.type = "all") +
  geom_confbox(data = get_data(type = "upper", show.diag = FALSE)) +
  geom_num(aes(num = r), data = get_data(type = "lower", show.diag = FALSE), size = 3.5) +
  add_diaglab(size = 4.56) + remove_axis()

image.png

mantel 检验组合图,这个是最酷的功能

ggcor提供了mantel检验的封装函数fortify_mantel()，支持vegan包中的mantel()、mantel.partial()和ade4包中的mantel.randtest()、mantel.rtest()函数，差别上说mantel.partial()是偏mantel检验（有控制变量），其它三个是mantel检验.

1
2
3
4
5
6
mantel <- fortify_mantel(varespec, varechem, spec.select = list(spec01 = 22:25,
                                                      spec02 = 1:4,
                                                      spec03 = 38:43,
                                                      spec04 = 15:20))
df06 <- as_cor_tbl(mantel)#转换成ggcor可用的数据格式
ggcor(df06) + geom_pie2() + geom_cross()

image.png

1
2
3
4
5
6
7
8
9
10
11
12
corr <- fortify_cor(varechem, type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
mantel <- fortify_mantel(varespec, varechem,
                                spec.select = list(spec01 = 22:25,
                                                   spec02 = 1:4,
                                                   spec03 = 38:43,
                                                   spec04 = 15:20),
                                mantel.fun = "mantel.randtest")
ggcor(corr, xlim = c(-5, 14.5)) +
  add_link(mantel, diag.label = TRUE) +
  add_diaglab(angle = 45) +
  geom_square() + remove_axis("y")

image.png

1
2
3
4
5
6
corr <- fortify_cor(varechem, type = "upper", show.diag = FALSE,
                    cor.test = TRUE, cluster.type = "all")
ggcor(corr, xlim = c(-5, 14.5)) +
  add_link(mantel, diag.label = TRUE) +
  add_diaglab(angle = 45) +
  geom_pie2() + remove_axis("y")

image.png

1
2
3
4
5
6
corr <- fortify_cor(varechem, type = "lower", show.diag = FALSE,
                    cor.test = TRUE, cluster.type = "all")
ggcor(corr, xlim = c(0.5, 20)) +
  add_link(mantel, diag.label = TRUE) +
  add_diaglab(angle = 45) +
  geom_ellipse2() + remove_axis("y")

image.png

1
2
3
4
5
6
7
8
9
10
11
12
13
corr <- fortify_cor(varechem, varechem[ , 1:7], type = "full", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
mantel <- fortify_mantel(varespec, varechem,
                         spec.select = list(spec01 = 22:25,
                                            spec02 = 1:4,
                                            spec03 = 38:43,
                                            spec04 = 15:20),
                         mantel.fun = "mantel.randtest", nrepet = 2000)
extra.params <- extra_params(group.label = text_params(size = 6),
                             link.params = link_params(group.point.hjust = 2))
ggcor(corr, axis.y.position = "left", legend.position = "left", xlim = c(0.5, 14.5)) +
  add_link(mantel, extra.params = extra.params) +
  geom_circle2()

image.png

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
group <- rep(LETTERS[1:3], 8)

corr <- fortify_cor(varechem, type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
mantel <- fortify_mantel(varespec[ , 38:43], varechem,
                         spec.group = group,
                         env.group = group,
                         is.pair = TRUE,
                         mantel.fun = "mantel.randtest")

ggcor(corr, xlim = c(-5, 14.5)) +
  add_link(mantel, diag.label = TRUE) +
  add_diaglab(angle = 45) +
  geom_colour() + geom_shade(sign = -1) +
  remove_axis("y")

image.png

1
2
3
4
5
6
7
8
9
10
11
12
13
14
corr <- fortify_cor(varechem, type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
mantel <- fortify_mantel(varespec, varechem,
                         spec.select = list(spec01 = 22:25,
                                            spec02 = 1:4,
                                            spec03 = 38:43,
                                            spec04 = 15:20),
                         mantel.fun = "mantel.randtest")
mantel <- dplyr::filter(mantel, p <= 0.05)

ggcor(corr, xlim = c(-5, 14.5)) +
  add_link(mantel, diag.label = TRUE, legend.drop = TRUE) +
  add_diaglab(angle = 45) +
  geom_square() + remove_axis("y")

image.png

1
2
3
4
corr <- fortify_cor(varechem, type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
corr01 <- fortify_cor(varechem, varespec[ , 38:39], type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
1
## Warning: 'type=upper' just supports for symmetric correlation matrix.
1
2
3
4
5
6
7
8
9
10
11
12
mantel <- fortify_mantel(varespec, varechem,
                         spec.select = list(spec01 = 22:25,
                                            spec02 = 1:4,
                                            spec03 = 38:43,
                                            spec04 = 15:20),
                         mantel.fun = "mantel.randtest")

ggcor(corr, xlim = c(-5, 14.5)) +
    add_link(x = corr01, diag.label = TRUE,
             link.line.colours = c("#E31A1C", "#33A02C")) +
    add_diaglab(angle = 45) +
    geom_square() + remove_axis("y")

image.png

1
2
3
4
5
6
7
8
ggcor(corr, xlim = c(-5, 14.5)) +
    add_link(x = corr01, mapping = aes(size = abs(r)), diag.label = TRUE) +
    add_diaglab(angle = 45) +
    geom_square() +
    scale_size_continuous(limits = c(0, 1), range = c(0.25, 3)) +
    guides(size = guide_legend(title = "abs r", override.aes = list(colour = "grey35"),
                               order = 1)) +
    remove_axis("y")

image.png

1
2
3
4
5
6
7
8
9
10
corr <- fortify_cor(varechem, type = "upper", show.diag = TRUE,
                    cor.test = TRUE, cluster.type = "all")
df <- data.frame(x = rep(LETTERS[1:3], 14),
                 y = rep(cor_tbl_yname(corr), 3),
                 r = runif(42, -1, 1),
                 p = runif(42, 0, 0.5), stringsAsFactors = FALSE)
ggcor(corr, xlim = c(-5, 14.5)) +
  add_link(df, diag.label = TRUE, colour = "red") +
  add_diaglab(angle = 45) +
  geom_square() + remove_axis("y")

image.png