厚缊

诹图——ggcor简介(九)

厚缊 / 2020-03-01


放了一个月的寒假,这可能是接下来很长的日子里最漫长的寒假了,这周好不容易返深,却发现工作效率也没有比家里高多少,很多在计划内的事情给耽误了。这一期要介绍的是ggcor新增的一些比较有意思的功能,有多少实用性目前还不清楚,好玩嘛应该还是可以的。

版本

由于是最新增加的功能,也就需要最新的0.9.3版,若是感觉没有用就不要强制更新了。

## install.packages("devtools)
devtools::install_github("houyunhuang/ggcor") 
## 安装过老版本的加 force = TRUE 参数
packageVersion("ggcor")
## [1] '0.9.3'

一般性热图支持

ggcor的核心工作是围绕相关性矩阵热图展开的,之前的所有版本对于一般性矩阵热图的支持并不那么友好,但为了适用性更广一些,抑或是为了在和其它相似的包(如corrplot)的竞争中不至于太落下风,所以综合考量还是把一般性矩阵热图加进来了。注意,目前只是能画矩阵热图,不能处理聚类树等更复杂的内容,以后可能会加进来。

先看一个简单的例子。

library(ggcor)
cor_tbl(extra.mat = list(mtcars = mtcars)) %>% 
  quickcor() + geom_colour(aes(fill = mtcars))

在这个系列的第二期我专门讲过cor_tbl()函数,extra.mat参数是为了在构造cor_tbl对象的时候能增加除了相关性之外的其它数据的。

args(cor_tbl)
## function (corr, p.value = NULL, extra.mat = list(), type = "full", 
##     show.diag = TRUE, row.names = NULL, col.names = NULL, cluster = FALSE, 
##     ...) 
## NULL

为了增加一般性矩阵支持,主要就是允许corr参数缺失,即missing的情况。重要提醒:尽管你可以(目前没有对相关系数及p值进行check,后续很可能会加),但是最好不要把一般性矩阵直接传递给corr参数,而是要通过extra.mat参数来处理。当然,你要自杀我目前也没有阻止。

class(cor_tbl(mtcars))
## [1] "cor_tbl"    "tbl_df"     "tbl"        "data.frame"
class(cor_tbl(extra.mat = list(mtcars = mtcars)))
## [1] "general_cor_tbl" "cor_tbl"         "tbl_df"          "tbl"            
## [5] "data.frame"

当然,你也可能相对一般性矩阵热图聚类,很遗憾的,目前的情况是要么聚类要么不聚类,不能分别对行列进行聚类。

cor_tbl(extra.mat = list(mtcars = mtcars), cluster = TRUE) %>% 
  quickcor() + geom_colour(aes(fill = mtcars))

花样热图

以为上面这么多就完了?当然不是,我们完全可以把ggcor提供的一些特殊图层充分利用起来,搞出点新的花样来。

## 构造数据
m1 <- matrix(rnorm(5 * 5, mean = 2), nrow = 5)
m2 <- matrix(rnorm(5 * 5, mean = 3), nrow = 5)
m3 <- matrix(rnorm(5 * 5, mean = 1), nrow = 5)
m4 <- matrix(rnorm(5 * 5, mean = 4), nrow = 5)
m5 <- matrix(rnorm(5 * 5, mean = 2), nrow = 5)
m6 <- matrix(rnorm(5 * 5, mean = 3), nrow = 5)
m7 <- matrix(rnorm(5 * 5, mean = 0), nrow = 5)
m8 <- matrix(rnorm(5 * 5, mean = 2), nrow = 5)
m9 <- matrix(rnorm(5 * 5, mean = 3), nrow = 5)

mat <- cbind(
  rbind(m1, m2, m3),
  rbind(m4, m5, m6),
  rbind(m7, m8, m9)
)
df <- cor_tbl(extra.mat = list(mat = mat))
df
## # A tibble: 225 x 5
##    .row.names .col.names   mat .row.id .col.id
##  * <chr>      <chr>      <dbl>   <int>   <int>
##  1 row1       col1       1.47       15       1
##  2 row2       col1       0.763      14       1
##  3 row3       col1       3.40       13       1
##  4 row4       col1       1.76       12       1
##  5 row5       col1       2.47       11       1
##  6 row6       col1       4.44       10       1
##  7 row7       col1       2.51        9       1
##  8 row8       col1       1.50        8       1
##  9 row9       col1       3.61        7       1
## 10 row10      col1       4.36        6       1
## # … with 215 more rows

由于默认配色有点我不是那么喜欢,接下来的例子我统一换了个颜色。

p <- quickcor(df, mapping = aes(fill = mat)) + 
  scale_fill_gradient2n(midpoint = mean(mat))
p + geom_circle2()

p + geom_square()

和相关性矩阵热图相比,这几个图的每个形状的大小都是固定的,怎么映射大小呢?

p + geom_square(aes(r0 = mat)) + 
  scale_radius_area(guide = "none", midpoint = mean(mat))

p + geom_ellipse2(aes(r0 = mat)) + 
  scale_radius_area(guide = "none", midpoint = mean(mat))

p + geom_star(aes(r0 = mat)) + 
  scale_radius_area(guide = "none", midpoint = mean(mat))

p + geom_pie2(aes(r0 = mat)) + 
  scale_radius_area(guide = "none", midpoint = mean(mat))

当然,还可以玩出很多的花样,就不一一啰嗦了。最后看一个聚类之后的图。

cor_tbl(extra.mat = list(mat = mat), cluster = TRUE) %>% 
  quickcor() +
  geom_colour(aes(fill = mat)) +
  geom_number(aes(num = mat)) +
  scale_fill_gradient2n(midpoint = mean(mat))

气泡热图

quickcor()毕竟是为了和corrplot的效果差不多设计的,难免有些修饰的过头了,想用回最经典的ggplot2风格,那就用ggcor()函数吧。

library(ggplot2)
ggcor(df) + geom_point(aes(size = mat), colour = "grey35") +
  scale_size_continuous(range = c(1, 12)) +
  coord_cartesian(xlim = c(0.5, 15.5),
                  ylim = c(0.5, 15.5))

上下三角展示不同的数据

这块的内容是一直相加又没加的内容,这两天找到了点灵感就一次性加进来了。对于ggcor提供的所有和热图相关的图层(例如geom_square()),都有对应的上三角(geom_upper_square()或者下三角(geom_lower_square())的版本,上下三角图层函数的映射参数都分别以upper或者lower开头,例如fill参数,在上下三角图层函数中就是upper_filllower_fill。可能听得有点云里雾里,还是看例子实在。

假如我们想对比下两种不同的相关性计算方法之间的差别,这时候放在一张图里面会更舒服。

data("varechem", package = "vegan")
cor1 <- cor(varechem, method = "pearson")
cor2 <- cor(varechem, method = "kendall")
cor_tbl(cor1, extra.mat = list(cor2 = cor2)) %>% 
  quickcor() +
  geom_upper_colour(aes(upper_fill = r)) +
  geom_lower_colour(aes(lower_fill = cor2)) +
  geom_diag_label() +
  remove_all_axis()

当然,这个例子的对比效果并不那么好,我们可以再看一个例子。纯粹瞎造的例子,没有任何实际意义的。

d <- dist(t(varechem))
correlate(varechem, cor.test = TRUE) %>% 
  as_cor_tbl(extra.mat = list(dist = d)) %>% 
  quickcor() +
  geom_square(data = get_data("upper")) +
  geom_lower_colour(aes(lower_fill = dist)) +
  scale_lower_fill_gradientn(colours = c("blue", "white", "red")) +
  geom_diag_label() +
  remove_all_axis()

除了颜色(fillcolour)和半径(r0),上下三角相关的其它映射函数还不是很完善,可能还需要一周的时间才能完全更新完。

小结

这部分内容纯粹就是闲得无聊自娱自乐,喜欢折腾的可以继续折腾,不喜欢折腾的就不要浪费时间了。

下期预告:不知道还有没有下一期。