R中基因型矩阵映射的高效代码

嗨，我想把基因型矩阵，编码为三元组，转换为编码为0，1，2的矩阵，即

c(0,0,1) <-> 0; c(0,1,0) <-> 1; c(0,0,1) <-> 2

输出有3n列和p行，其中n是样本量，p是基因型数。现在我们可以使用以下函数将矩阵还原为0,1,2编码

reduce012 = function(x){
  if(identical(x, c(1,0,0))){
    return(0)
  } else if(identical(x, c(0,1,0))){
    return(1)
  } else if(identical(x,  c(0,0,1))){
    return(2)
  } else { 
    return(NA)
  }
}

reduce.G = function(G.gen){
  G.vec = 
    mapply(function(i,j) reduce012(as.numeric(G.gen[i,(3*j-2):(3*j)])), 
           i=expand.grid(1:(ncol(G.gen)/3),1:nrow(G.gen))[,2], 
           j=expand.grid(1:(ncol(G.gen)/3),1:nrow(G.gen))[,1]
    )

  G = matrix(G.vec, nrow = ncol(G.gen)/3, ncol = nrow(G.gen))
  colnames(G) = rownames(G.gen)
  return(G)
}

reduce.G.loop = function(G.gen){
  G = matrix(NA,nrow = ncol(G.gen)/3, ncol = nrow(G.gen))
  for(i in 1:nrow(G.gen)){
    for(j in 1:(ncol(G.gen)/3)){
      G[j,i] = reduce012(as.numeric(G.gen[i,(3*j-2):(3*j)]))
    }
  }
  colnames(G) = rownames(G.gen)
  return(G)
}

输出是n行x p列。编码为0,1,2的矩阵是编码为三元组的矩阵的转置，这是偶然的，但也是有意的

代码不是特别快。让我烦恼的是，时间与n^2有关。你能解释或提供更有效的代码吗

G = expand.G(1000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))

G = expand.G(2000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))

G = expand.G(4000,20)
system.time(reduce.G(G))
system.time(reduce.G.loop(G))

---

这似乎比您的版本快三倍（重命名为

reduce.G.orig

）：

---

reduce.G您只需创建一个访问器查找表：

decode <- array(dim = c(3, 3, 3))
decode[cbind(1, 0, 0) + 1] <- 0
decode[cbind(0, 1, 0) + 1] <- 1
decode[cbind(0, 0, 1) + 1] <- 2

这个完全矢量化的R版本将为您提供相同的矩阵，没有DIMNAME和超快

然而，如果你有更大的矩阵，你真的应该使用Rcpp来解决内存和时间问题。
我不能运行你的代码，因为
all.equal（x，c（1,0,0））
并不总是返回逻辑值。您可以使用
isTRUE（）
来包装它，但请提供一个可复制的示例。是的，这是以前的版本，我已更新为idential（）。我将进行编辑以反映上述内容。如果您觉得有冒险精神，以下是我编写的一些
awk
代码：
reduce.G <- function(G) {
  varmap = c("100"=0, "010"=1, "001"=2)
  result <- do.call(rbind, lapply(1:(ncol(G)/3)-1, function(val) 
    varmap[paste(G[,3*val+1], G[,3*val+2], G[,3*val+3], sep="")]))
  colnames(result) <- rownames(G)
  result
}

system.time(reduce.G(G))
#   user  system elapsed 
#  0.156   0.000   0.155 

system.time(reduce.G.orig(G))
#   user  system elapsed 
#  0.444   0.000   0.441 

identical(reduce.G(G), reduce.G.orig(G))
# [1] TRUE

decode <- array(dim = c(3, 3, 3))
decode[cbind(1, 0, 0) + 1] <- 0
decode[cbind(0, 1, 0) + 1] <- 1
decode[cbind(0, 0, 1) + 1] <- 2

matrix(decode[matrix(t(G + 1), ncol = 3, byrow = TRUE)], ncol = nrow(G))