超慢R sapply循环

时间:2014-07-08 20:17:56

标签: r loops sapply

我试图计算两个序列的成对同一性。如果我的数据格式为:

nrow(mydata_v)  
[1] 1145


mydata_v[1:10,1:10]  
V5  V6  V7  V8  V9  V10 V11 V12 V13 V14  
A1 "M" "E" "T" "I" "S" "L" "I" "T" "I" "L"  
A2 "M" "E" "A" "V" "S" "L" "I" "T" "I" "L"  
A3 "-" "-" "-" "-" "-" "-" "-" "-" "-" "-"  
A4 "-" "-" "-" "-" "-" "-" "-" "-" "-" "-"  
A5 "M" "E" "T" "T" "S" "L" "I" "T" "I" "L"  
A6 "M" "E" "T" "T" "S" "L" "I" "T" "I" "L"  
A7 "M" "E" "T" "I" "S" "L" "I" "T" "I" "L"  
A8 "M" "E" "T" "I" "S" "L" "I" "T" "I" "L"  
A9 "-" "-" "-" "-" "-" "-" "-" "-" "-" "-"  
A10 "M" "E" "T" "I" "S" "L" "I" "T" "I" "L"  

是的,我同意Aaron Schumacher的说法,我的代码没有做正确的事
更新了工作代码,现在spped似乎没问题

mydata_v =as.matrix( mydata[,4:( ncol(mydata)-2)])  
mydata_v[mydata_v=="-"] =NA  
loop_fun <-function(p) {  
    v1 =as.vector(mydata_v[p[1],])  
    v2 =as.vector(mydata_v[p[2],])  
    good_pos =complete.cases(v1,v2)  
    identity =(100*sum(v1[good_pos]!=v2[good_pos])/sum(good_pos))  
}  
m_pair =as.data.frame( combn(1:nrow(mydata_v),2) )  
hot_vector =sapply(m_pair, loop_fun)  
hot <- diag(nrow(mydata_v)-1)  
hot[lower.tri(hot,diag=T)] <- hot_vector  

非常感谢,
硕国

1 个答案:

答案 0 :(得分:1)

这是您的数据,因为R适用于面向列的数据

而转换
m <- c("M", "E", "T", "I", "S", "L", "I", "T", "I", "L",
       "M", "E", "A", "V", "S", "L", "I", "T", "I", "L",
       "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
       "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
       "M", "E", "T", "T", "S", "L", "I", "T", "I", "L",
       "M", "E", "T", "T", "S", "L", "I", "T", "I", "L",
       "M", "E", "T", "I", "S", "L", "I", "T", "I", "L",
       "M", "E", "T", "I", "S", "L", "I", "T", "I", "L",
       "-", "-", "-", "-", "-", "-", "-", "-", "-", "-",
       "M", "E", "T", "I", "S", "L", "I", "T", "I", "L")
m <- t(matrix(m, 10, byrow=TRUE))

看起来你可以在循环之外拉出一些操作

m[m == "-"] <- NA
notna <- !is.na(m)

(后来乘以100)。基本策略是进行向量操作,在第一步中将第i列与 all 剩余列进行比较,例如colSums(m[, 1] != m[, -1], na.rm=TRUE)。我们这样做是通过预先分配结果矩阵然后迭代列,形成剩余列的显式索引

res <- matrix(0, nrow(m) - 1, ncol(m) - 1)
for (i in seq_len(ncol(m) - 1)) {
    idx <- seq(i + 1, ncol(m))
    den <- colSums(notna[, i] & notna[, idx, drop=FALSE])
    res[idx - 1, i] <- colSums(m[,i] != m[, idx, drop=FALSE], na.rm=TRUE) / den
}
res <- 100 * res