我正在研究一些高通量基因数据，并根据贝叶斯统计数据进行一种相关性分析。我需要做的一件事是找到数据集中每个成对的产品组合，并找到每个结果行的总和。
例如，对于高吞吐量数据集矩阵Dataset
(Dataset <- structure(list(`Condition 1` = c(1L, 3L, 2L, 2L), `Condition 2` = c(2L, 1L, 7L, 2L), `Condition 3` = c(4L, 1L, 2L, 5L)), .Names = c("Condition 1", "Condition 2", "Condition 3"), class = "data.frame", row.names = c("Gene A", "Gene B", "Gene C", "Gene D")))
Condition 1 Condition 2 Condition 3
Gene A 1 2 4
Gene B 3 1 1
Gene C 2 7 2
Gene D 2 2 5
首先，我想将每对可能的行相乘，得到以下称为Comb的矩阵：
Condition 1 Condition 2 Condition 3
Gene A Gene A 1 4 9
Gene A Gene B 3 2 4
Gene A Gene C 2 14 8
Gene A Gene D 2 4 20
Gene B Gene B 9 1 1
Gene B Gene C 6 7 2
Gene B Gene D 6 2 5
Gene C Gene C 4 49 4
Gene C Gene D 4 14 10
Gene D Gene D 4 4 25
在我想找到每个产品的行总和并以矩阵的形式得到总和（我将称之为CombSums）：
Gene A Gene B Gene C Gene D
Gene A NA 10 24 26
Gene B 10 NA 15 13
Gene C 24 15 NA 28
Gene D 26 13 28 NA
当我尝试这样做时，我能想到的最好的是
combs <- combn(seq_len(nrow(Dataset)), 2)
Comb <- Dataset[combs[1,], ] * Dataset[combs[2,], ]
rownames(Comb) <- apply(combn(rownames(Comb), 2), 2, paste, collapse = " ")
CombSums <- rowSums(Comb)
哪会给我作为列表的总和，如下所示：
[1,]
Gene A Gene B 10
Gene A Gene C 24
Gene A Gene D 26
Gene B Gene C 15
Gene B Gene D 13
Gene C Gene D 28
不幸的是，我希望它是一个双向矩阵，而不是列表，所以这并不是很有效，所以如果有人可以建议一种方法将总和作为一个矩阵，那将是一个很大的帮助。
答案 0 :(得分：4)
您可以使用lapply和outer计算原始数据框中每列的成对产品，然后将所有这些成对产品与Reduce一起添加+。
Reduce("+", lapply(dat, function(x) outer(x, x)))
# [,1] [,2] [,3] [,4]
# [1,] 21 9 24 26
# [2,] 9 11 15 13
# [3,] 24 15 57 28
# [4,] 26 13 28 33
该主题的变体内存密集程度较低（因为它不需要同时存储每个列的矩阵），但更多的输入将是：
ret <- outer(dat[,1], dat[,1])
for (i in 2:ncol(dat)) ret <- ret + outer(dat[,i], dat[,i])
ret
# [,1] [,2] [,3] [,4]
# [1,] 21 9 24 26
# [2,] 9 11 15 13
# [3,] 24 15 57 28
# [4,] 26 13 28 33
这是迄今为止在100 x 100数据框架上提出的方法的基准：
# Larger dataset
set.seed(144)
dat <- as.data.frame(matrix(rnorm(10000), nrow=100))
josilber <- function(dat) Reduce("+", lapply(dat, function(x) outer(x, x)))
josilber2 <- function(dat) {
ret <- outer(dat[,1], dat[,1])
for (i in 2:ncol(dat)) ret <- ret + outer(dat[,i], dat[,i])
ret
}
frank <- function(DF) {
mat <- as.matrix(DF)
pairs <- combn(1:nrow(DF),2)
vals <- rowSums(mat[pairs[1,],]*mat[pairs[2,],])
res <- matrix(,nrow(DF),nrow(DF),dimnames=list(rownames(DF),rownames(DF)))
res[lower.tri(res)] <- vals
res
}
library(microbenchmark)
microbenchmark(josilber(dat), josilber2(dat), josilberRcpp(as.matrix(dat)), frank(dat))
# Unit: microseconds
# expr min lq mean median uq max neval
# josilber(dat) 6867.499 45437.277 45506.731 46372.576 47549.834 85494.063 100
# josilber2(dat) 6831.692 7982.539 10245.459 9109.023 10883.965 50612.600 100
# josilberRcpp(as.matrix(dat)) 989.592 1112.316 1290.617 1204.388 1483.638 2384.348 100
# frank(dat) 13043.912 53369.804 52488.997 53921.402 54855.583 62566.730 100
答案 1 :(得分：4)
使用combn，您可以避免进行冗余计算：
mat <- as.matrix(DF)
pairs <- combn(1:nrow(DF),2)
vals <- rowSums(mat[pairs[1,],]*mat[pairs[2,],])
res <- matrix(,nrow(DF),nrow(DF),dimnames=list(rownames(DF),rownames(DF)))
res[lower.tri(res)] <- vals
# GeneA GeneB GeneC GeneD
# GeneA NA NA NA NA
# GeneB 9 NA NA NA
# GeneC 24 15 NA NA
# GeneD 26 13 28 NA
您的Comb矩阵是中间结果mat[pairs[1,],]*mat[pairs[2,],]。
整个计算可以在combn内进行，也可以：
vals <- combn(rownames(DF),2,FUN=function(x)sum(apply(DF[x,],2,prod)))
正如@josilber在下面的评论中指出的那样，这是非常缓慢的。
数据：
DF <- read.table(header=TRUE,text="Condition1 Condition2 Condition3
GeneA 1 2 4
GeneB 3 1 1
GeneC 2 7 2
GeneD 2 2 5")
答案 2 :(得分：2)
如果速度是一个重要因素（例如，如果您正在处理一个巨大的矩阵），您可能会发现Rcpp实现很有帮助。这只填充矩阵的上三角部分。
library(Rcpp)
cppFunction(
"NumericMatrix josilberRcpp(NumericMatrix x) {
const int nr = x.nrow();
const int nc = x.ncol();
NumericMatrix y(nr, nr);
for (int col=0; col < nc; ++col) {
for (int i=0; i < nr; ++i) {
for (int j=i; j < nr; ++j) {
y(i, j) += x(i, col) * x(j, col);
}
}
}
return y;
}")
josilberRcpp(as.matrix(Dataset))
# [,1] [,2] [,3] [,4]
# [1,] 21 9 24 26
# [2,] 0 11 15 13
# [3,] 0 0 57 28
# [4,] 0 0 0 33
我的另一个答案中提供了基准测试。请注意，基准测试不包括使用cppFunction的编译时间，这可能非常重要。因此，此实现可能仅适用于非常大的输入或需要多次使用此函数时。