针对长数据框的所有组的散点图答案

【问题标题】：scatter plot against all groups for a long data frame针对长数据框的所有组的散点图
【发布时间】：2019-08-30 16:46:53
【问题描述】：

我很确定已经有人问过这样的问题，但我不知道如何搜索。

我经常获取宽格式的数据，例如我的小示例中的 3 个实验 (a-c)。我通常转换为长格式并通过某些函数转换值（这里以log2 为例）。

我经常想做的是将所有实验相互对照，在这里我正在寻找一个方便的解决方案。如何转换我的数据框以获取构面，例如 a~b、a~c 和 b~c...

到目前为止，我再次tidy::spread 数据并执行3 次ggplot 命令，其中各个列的名称分别为x 和y。稍后我将各个图合并在一起。

有没有更方便的方法？

library(dplyr)
library(tidyr)
library(ggplot2)

df <- data.frame(
  names=letters,
  a=1:26,
  b=1:13,
  c=11:36
)

df %>%
  tidyr::gather(experiment, value, -names) %>%
  mutate(log2.value=log2(value))

编辑
因为我从@hdkrgr 得到了一个非常有用的答案，所以我修改了一些代码。 inner_join 是一个很棒的技巧，我可以实现它来自动化我的想法，我仍然想念的是一个聪明的过滤器来摆脱冗余数据，因为如果我不想绘制 c~c 或 b~a已经绘制a~b。我现在通过提供我想做的配对解决了这个问题，但是有人能想到一个直接的解决方案吗？我想不出有什么东西可以给我独特的配对。

my_pairs <- c('a vs. b', 'a vs. c', 'b vs. c')

df %>%
  as_tibble() %>%
  tidyr::gather(experiment, value, -names) %>%
  mutate(log2.value=log2(value))  %>%
  inner_join(., ., by=c("names")) %>%
  mutate(pairing=sprintf('%s vs. %s', experiment.x, experiment.y)) %>%
  filter(pairing %in% my_pairs) %>% 
  ggplot(aes(log2.value.x, log2.value.y)) + 
  geom_point() + 
  facet_wrap( ~ pairing, labeller=label_both)

【问题讨论】：

查看 ggplot 中的 facet_wrap 和 facet_grid。当数据为长格式时，这些通常最有效。
我知道这些功能，但不知道如何使用它们，因为x 和y 在同一列中。你能用我的变异长数据框发布一个例子吗？
啊...我想我现在才明白你真正想要做什么。我会发布一个答案，虽然它比我想要的要复杂一些......

标签： r ggplot2 dplyr tidyr

【解决方案1】：

从长格式开始的一种方法是对长数据进行自连接，以获得每行中两个实验的所有组合：

df %>%
    tidyr::gather(experiment, value, -names) %>%
    mutate(log2.value=log2(value)) %>%
    inner_join(., ., by=c("names")) %>% 
    ggplot(aes(log2.value.x, log2.value.y)) + geom_point() + facet_grid(experiment.y ~ experiment.x)

编辑：为避免绘制多余的实验对，您可以：

df %>%
    tidyr::gather(experiment, value, -names) %>%
    mutate(log2.value=log2(value)) %>% inner_join(., ., by=c("names")) %>% 
    filter(experiment.x < experiment.y) %>% 
    ggplot(aes(log2.value.x, log2.value.y)) + geom_point() + facet_wrap(~experiment.y + experiment.x)

【讨论】：

这个内部连接的好主意。这几乎解决了我的问题（更新了我的答案）。我做了一个facet_wrap 并手动过滤冗余图，但很想自动过滤掉它们。删除a vs a 很容易，但删除b vs a 而不是a vs b 并不容易。有什么想法吗？
进行字典比较？ ... %>% filter(experiment.x < experiment.y) %>% ... 编辑：试过了，效果很好。在那种情况下，facet_wrap 最终比facet_grid 更容易掌握
这太简单了！！！必须检查这是否适用于我的真实世界数据，但它应该......会回复你！

【解决方案2】：

这可能不是您想要的，但如果目的是探索每个变量之间的相关模式，您可能需要考虑GGally 包中的ggpairs。它不仅提供散点图，还提供相关分数和分布。

library(GGally)

ggpairs(df[, c("a", "b", "c")])

【讨论】：

我知道GGally，但我不想创建这么多方面，因为它们中的大多数都显示冗余信息，或者我不需要它们。或者是一种将这个图的下对角线作为单个方面返回的方法？

【解决方案3】：

这真的很有趣，因为它实际上比最初看起来更复杂。突出的一件事是获得独特对实验 - 似乎您想要 a 与 b，但不一定也需要 b 与 a。为此，您需要一组独特的实验对。

最初，我尝试从您的 gathered 数据开始工作，但意识到从宽版本开始可能更简单。从列名中获取实验名称——您可以通过多种方式执行此操作，但我只是获取不是"names" 的字符串——并获取它们的组合。我将它们粘贴在一起以使它们更易于使用。

library(dplyr)
library(tidyr)
library(ggplot2)

df <- data.frame(
  names=letters,
  a=1:26,
  b=1:13,
  c=11:36
) %>%
  as_tibble()

exp <- stringr::str_subset(names(df), "names", negate = T)

pairs <- combn(exp, 2, paste, simplify = F, collapse = ",") %>%
  unlist()
pairs
#> [1] "a,b" "a,c" "b,c"

然后，对于每一对，提取相关的列名，做一些 tidyeval 来选择那些列，做你有的log2 转换。我不得不绕道这里用我可以参考的东西重命名列 - 我认为这没有必要，但我无法让我的 tidyeval 在ggplot aes 中工作。其他人可能对此有想法。然后制作你的情节，并相应地标记轴和标题。剩下的就是 3 个地块的列表。

plots <- purrr::map(pairs, function(pair) {
  cols <- strsplit(pair, split = ",", fixed = T)[[1]]
  df %>%
    select(names, !!cols[1], !!cols[2]) %>%
    mutate_at(vars(-names), log2) %>%
    rename(exp1 = !!cols[1], exp2 = !!cols[2]) %>%
    ggplot(aes(x = exp1, y = exp2)) +
      geom_point() +
      labs(x = cols[1], y = cols[2], title = pair)
})

使用您选择的方法将图放在一起。我选择了cowplot，但我也喜欢patchwork 包。

cowplot::plot_grid(plotlist = plots, nrow = 1)

【讨论】：

我之前做过类似的事情，但我想知道是否没有代码更少的直接解决方案。不知何故，@hdkrgr 的 filter 函数现在对我来说效果很好，没有发现问题，它基本上是一个简单的过滤器
@drmariod 这很公平，我不知道为什么我总是害怕自加入，但在这种情况下这绝对是一个好方法

【解决方案4】：

您可以从通过combn创建所有组合开始，然后逐步完成：

library(purrr)

t(combn(names(df)[-1], 2)) %>% ## get all combinations  
   as.data.frame(stringsAsFactors = FALSE) %>% 
   mutate(l = paste(V1, V2, sep = " vs. ")) %>%
   pmap_dfr(function(V1, V2, l) 
     df %>% 
       select(one_of(c(V1, V2))) %>% ## select the elements given by the combination
       mutate_all(log2) %>%
       setNames(c("x", "y")) %>%
       mutate(experiment = l)) %>%
   ggplot(aes(x, y)) + geom_point() + facet_wrap(~experiment)

【讨论】：