ggpairs 中的部分 cor (pcor.test)

我可以用吗pcor (from ppcor）或者实际上将我预先制作的任何相关矩阵放入以下代码中ggpairs（在里面upper =） 代替cor?

我想在 ggpairs 中集成一个部分相关矩阵或 pcor。

library(GGally)
a <- as.numeric(1:10)
b <- as.numeric(a*a)
c <- as.numeric(a/b)
D <- as.factor(c("A", "B", "C", "A", "B", "C","A", "B", "C","A"))
abcd <- data.frame(a,b,c, D)

p <- ggpairs(abcd, columns = c("a", "b", "c"), title = "All Bivariate analysis", 
           upper = list(continuous = wrap("cor",   size = 6)),
           lower = list(continuous = wrap("smooth", alpha = 0.6, size = 0.1)),      
           mapping = aes(color = D))

for (i in 1:p$nrow) {
  for (j in 1:p$ncol) {
    p[i,j] <- p[i,j] + 
      scale_fill_manual(values=c("grey25", "slategrey", "grey85")) +
      scale_color_manual(values=c("grey37", "slategrey", "grey75"))  
  }
}

d <- p + theme(axis.text.x = element_text(face = "bold", size = 10 ),
             axis.text.y = element_text(face = "bold", size = 10),
             strip.text = element_text(size = 20))
d

我想用奇妙的ggpairs但具有偏相关矩阵。
是否可以？ 我想我应该在这部分这样做：

upper = list(continuous = wrap("cor",   size = 6))

查看代码GGally::ggpairs你可以看到你可以提供一个函数upper需要产生一个ggplot。当提供这样的函数存根时：

 upper = list(continuous = function(data, mapping) { print(list(data, mapping)) })

您将看到，对于每个面板，您都会获得整个面板data.frame and an aes映射描述 x 轴和 y 轴上的内容以及您可能设置的其他美学，例如：

[[1]]
    a   b         c D
1   1   1 1.0000000 A
2   2   4 0.5000000 B
3   3   9 0.3333333 C
4   4  16 0.2500000 A
5   5  25 0.2000000 B
6   6  36 0.1666667 C
7   7  49 0.1428571 A
8   8  64 0.1250000 B
9   9  81 0.1111111 C
10 10 100 0.1000000 A

[[2]]
Aesthetic mapping: 
* `x`      -> `b`
* `y`      -> `a`
* `colour` -> `D`

根据这些信息，我们需要

1. 计算pcor
2. 提取相关系数

这有点棘手，因为我们需要计算分组pcor（每个级别一个系数colour -> D+ 您稍后可能想要包含的其他分组），我们需要从映射中获取分组结构，这也不是那么简单。

长话短说，下面的存根向您展示了方向，您可以从那里进一步微调上图的外观：

library(tidyverse)
pcor_panel <- function(data, mapping, ...) {
  ## remove x, y mapping
  grp_aes <- mapping[setdiff(names(mapping), c("x", "y"))]
  ## extract the columns to which x and y is mapped
  xy <- sapply(mapping[c("x", "y")], rlang::as_name)
  ## calculate pcor per group
  stats <- data %>%
    group_by(!!!unname(unclass(grp_aes))) %>%
    group_modify(function(dat, grp) {
      res <- pcor(dat)$estimate %>%
        as_tibble() %>%
        setNames(names(dat)) ## needed b/c in pcor names are sometimes messed up
      res <- res %>%
        mutate(x = names(res)) %>%
        gather(y, pcor, -x)
      res %>%
        filter(x == xy[1], y == xy[2]) ## look only at the pcors of this panel
    }) %>% 
    ungroup() %>%
    mutate(x = 1, y = seq_along(y))
  ggplot(stats, aes(x, y, label = round(pcor, 3))) +
    geom_text(grp_aes) +
    ylim(range(stats$y) + c(-2, 2))
}

ggpairs(abcd, columns = c("a", "b", "c"), title = "All Bivariate analysis", 
        upper = list(continuous = pcor_panel),
        lower = list(continuous = wrap("smooth", alpha = 0.6, size = 0.1)),      
        mapping = aes(color = D))