R总结具有独特功能的数据框

R summarize dataframe with unique features

我有一个大的 table,格式如下:

Data <- data.frame("Chrom" = c("chr1", "chr1", "chr1", "chr4", "chr4", "chr6"), "Site" = c(100, 200, 400, 140, 300, 400), "Heart" = c(20, 100, 0, 35, 92, 100), "Brain" = c(30, 40, 55, 100, 0, 100), "Liver" = c(100, 55, 20, 90, 0, 0), "Lungs" = c(100, 0, 80, 40, 30, 0))

给予:

> Data
  Chrom Site Heart Brain Liver Lungs
1  chr1  100    20    30   100   100
2  chr1  200   100    40    55     0
3  chr1  400     0    55    20    80
4  chr4  140    35   100    90    40
5  chr4  300    92     0     0    30
6  chr6  400   100   100     0     0

我想做一个和这个发布的图相似的图。 (http://www.nature.com/ncomms/2015/150218/ncomms7363/fig_tab/ncomms7363_F1.html):

基本上每一行(基于常见的 Chrom 和 Site),我想看看有多少中间值。我在这里将中间值定义为 15 到 85 之间的值。然后对于每个器官,我想知道所有器官中有多少行是中间的,只有那个器官,与两个或三个器官共享。

对于问题的第一部分(每行找出有多少个中间值),您可以尝试类似的方法:

is_intermediate = function(x) {
    return(x < 85 & x > 15)
}
res = sapply(Data[, 2:length(Data)], is_intermediate)
rowSums(res)

如果你对 dplyr + tidyr 感到满意,你可以这样做:

Data %>% gather(organ, value, Heart:lungs) %>%
    group_by(Chrom, Site) %>%
    summarise(n_intermediate = sum(is_intermediate(value)))

这将为您提供每个 Chrom/Site 组合的中间值数量。

对于下一部分,您可以执行以下操作:

Data %>% select(-Chrom, -Site) %>%
    mutate_each(funs(is_intermediate)) %>%
    summarise_each(funs(sum))

这将按列为您提供中间值的数量。

展现data.table的力量:

设置

library(data.table)

Data <- data.frame("Chrom" = c("chr1", "chr1", "chr1", "chr4", "chr4", "chr6"), "Site" = c(100, 200, 400, 140, 300, 400), "Heart" = c(20, 100, 0, 35, 92, 100), "Brain" = c(30, 40, 55, 100, 0, 100), "Liver" = c(100, 55, 20, 90, 0, 0), "Lungs" = c(100, 0, 80, 40, 30, 0))

DT <- data.table(Data)

isintermediate <- function(x){
  return(x >=15 & x <= 85)
}


DI <- DT[ , list(Chrom, Site,
                 Heart = isintermediate(Heart),
                 Brain = isintermediate(Brain),
                 Liver = isintermediate(Liver),
                 Lungs = isintermediate(Lungs))]

这将创建一个矩阵 DI,如下所示:

> DI
   Chrom Site Heart Brain Liver Lungs
1:  chr1  100  TRUE  TRUE FALSE FALSE
2:  chr1  200 FALSE  TRUE  TRUE FALSE
3:  chr1  400 FALSE  TRUE  TRUE  TRUE
4:  chr4  140  TRUE FALSE FALSE  TRUE
5:  chr4  300 FALSE FALSE FALSE  TRUE
6:  chr6  400 FALSE FALSE FALSE FALSE

如果值是中间值,则使用 TRUEFALSE。 (可能是比创建函数更快的方法,但我发现这种方法很容易理解)。

计数中级

现在,通过 Chrom + Site 计算中间值很简单

# NoI is Number Intermediate

> DI[, list(NoI = Heart + Brain + Liver + Lungs), by = c("Chrom","Site")]
   Chrom Site NoI
1:  chr1  100   2
2:  chr1  200   2
3:  chr1  400   3
4:  chr4  140   2
5:  chr4  300   1
6:  chr6  400   0

器官中间计数

对于中间跨越的数量,这变得更加复杂。首先,使用 reshape

融化数据
library(reshape2)

DA <- melt(DI, id.vars = c("Chrom","Site"))[value == TRUE]

这给出:

> DA
    Chrom Site variable value
 1:  chr1  100    Heart  TRUE
 2:  chr4  140    Heart  TRUE
 3:  chr1  100    Brain  TRUE
 4:  chr1  200    Brain  TRUE
 5:  chr1  400    Brain  TRUE
 6:  chr1  200    Liver  TRUE
 7:  chr1  400    Liver  TRUE
 8:  chr1  400    Lungs  TRUE
 9:  chr4  140    Lungs  TRUE
10:  chr4  300    Lungs  TRUE

我们只对 TRUE 值感兴趣,因此 [value == TRUE]

现在我们需要计算每个部位的中间值,但附加到每个器官。我们可以使用 .Nby= 来做到这一点,然后合并回我们最初的 table:

DA <- merge(DA,DA[, list(IAcc = .N), by = c("Chrom","Site")], by = c("Chrom","Site"))

给予:

> DA
    Chrom Site variable value IAcc
 1:  chr1  100    Heart  TRUE    2
 2:  chr1  100    Brain  TRUE    2
 3:  chr1  200    Brain  TRUE    2
 4:  chr1  200    Liver  TRUE    2
 5:  chr1  400    Brain  TRUE    3
 6:  chr1  400    Liver  TRUE    3
 7:  chr1  400    Lungs  TRUE    3
 8:  chr4  140    Heart  TRUE    2
 9:  chr4  140    Lungs  TRUE    2
10:  chr4  300    Lungs  TRUE    1

现在剩下的就是计算每个器官的独特 IAcc 数,我们可以使用 table 函数获得:

Output <- data.table(table(DA[,list(variable,IAcc)]))
> Output
    variable IAcc N
 1:    Heart    1 0
 2:    Brain    1 0
 3:    Liver    1 0
 4:    Lungs    1 1
 5:    Heart    2 2
 6:    Brain    2 2
 7:    Liver    2 1
 8:    Lungs    2 1
 9:    Heart    3 0
10:    Brain    3 1
11:    Liver    3 1
12:    Lungs    3 1

其中IAcc是在同一个Chrom和Site也有中间值的器官(包括它自己)的个数,N是被看到的次数。

最后,绘制(原谅默认颜色):

library(ggplot2)

ggplot(Output, aes(x = variable, y = N, fill = IAcc)) + geom_bar(stat = "identity")