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

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

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

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包来做到这一点。第一步是创建包含所需行对的更广泛的数据帧。

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] 

所述第二步骤是从施加fisher.test到每个行对提取p.value：

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