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行并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