Question

我是R的新手，正在尝试完成以下任务efficiently。

我有data.frame，x，其中包含以下列：start，end，val1，val2，val3 ，val4。列由start排序/排序。

对于每个start，首先我必须找到x中共享相同start的所有条目。由于列表是有序的，因此它们将是连续的。如果特定start只出现一次，那么我忽略它。然后，对于具有相同start的这些条目，假设某个特定start，则有3个条目，如下所示：

start=10

的条目

start end val1 val2 val3 val4
   10  25    8    9    0    0
   10  55   15  200    4    9
   10  30    4    8    0    1

然后，我必须一次取两行，并在fisher.test 2x4矩阵上执行val1:4。也就是说，

row1:row2 => fisher.test(matrix(c(8,15,9,200,0,4,0,9), nrow=2))
row1:row3 => fisher.test(matrix(c(8,4,9,8,0,0,0,1), nrow=2))
row2:row3 => fisher.test(matrix(c(15,4,200,8,4,0,9,1), nrow=2))

我写的代码是传统上使用for-loops完成的。我想知道这是否可以矢量化或者无论如何都要改进。

f_start = as.factor(x$start) #convert start to factor to get count
tab_f_start = as.table(f_start) # convert to table to access count
o_start1 = NULL
o_end1   = NULL
o_start2 = NULL
o_end2   = NULL
p_val    = NULL
for (i in 1:length(tab_f_start)) {
    # check if there are more than 1 entries with same start
    if ( tab_f_start[i] > 1) {
        # get all rows for current start
        cur_entry = x[x$start == as.integer(names(tab_f_start[i])),]
        # loop over all combinations to obtain p-values
        ctr = tab_f_start[i]
        for (j in 1:(ctr-1)) {
            for (k in (j+1):ctr) {
                # store start and end values separately
                o_start1 = c(o_start1, x$start[j])
                o_end1   = c(o_end1, x$end[j])
                o_start2 = c(o_start2, x$start[k])
                o_end2   = c(o_end2, x$end[k])
                # construct matrix
                m1 = c(x$val1[j], x$val1[k])
                m2 = c(x$val2[j], x$val2[k])
                m3 = c(x$val3[j], x$val3[k])
                m4 = c(x$val4[j], x$val4[k]) 
                m = matrix(c(m1,m2,m3,m4), nrow=2)
                p_val = c(p_val, fisher.test(m))
            }
        }
    }
}
result=data.frame(o_start1, o_end1, o_start2, o_end2, p_val)

谢谢！

Answer 1

正如@Ben Bolker建议的那样，您可以使用plyr包来紧凑地执行此操作。第一步是创造包含所需行对的更宽数据帧。使用combn函数生成行对：

set.seed(1)
x <- data.frame( start = c(1,2,2,2,3,3,3,3), 
                 end = 1:8, 
                 v1 = sample(8), v2 = sample(8), v3 = sample(8), v4 = sample(8))

require(plyr)
z <- ddply(x, .(start), function(d) if (nrow(d) == 1) NULL
                                      else {
                                        row_pairs <- combn(nrow(d),2)
                                        cbind( a = d[ row_pairs[1,], ],
                                               b = d[ row_pairs[2,], ] )
                                      })[, -1]

第二步是提取p.value将fisher.test应用于每个行对：

result <- ddply(z, .(a.start, a.end, b.start, b.end), 
                function(d) 
                     fisher.test(matrix(unlist( d[, -c(1,2,7,8) ]), 
                                        nrow=2, byrow=TRUE))$p.value  )


> result
  a.start a.end b.start b.end         V1
1       2     2       2     3 0.33320784
2       2     2       2     4 0.03346192
3       2     3       2     4 0.84192284
4       3     5       3     6 0.05175017
5       3     5       3     7 0.65218289
6       3     5       3     8 0.75374989
7       3     6       3     7 0.34747011
8       3     6       3     8 0.10233072
9       3     7       3     8 0.52343422

R：拆分数据帧，将函数应用于每个子集中的所有行对

1 个答案: