R 根据第二个数据集和拆分列重新编码

我有一个矩阵“mat”，012个编码的SNP作为列，人作为行。例如：

> mat<-matrix(c("0","1","0","1","2","0","1","1","2"),3,byrow=T)
> rownames(mat)<-c("ID1","ID2","ID3")
> colnames(mat)<-c("rs123","rs333","rs9000")

> mat

    rs123 rs333 rs9000
ID1    "0"   "1"   "0"   
ID2    "1"   "2"   "0"   
ID3    "1"   "1"   "2"  

>mat行名称（mat）列名称（mat）mat
rs123 rs333 rs9000
ID1“0”1“0”
ID2“1”2“0”
ID3“1”“1”“2”

在不同的矩阵“mat2”中，我将各自的等位基因分为两列（即次要和主要等位基因），SNP分为两行

> mat2<-matrix(c("A","T","C","T","T","G"),3,byrow=T)
> rownames(mat2)<-c("rs123","rs333","rs9000")
> colnames(mat2)<-c("Allele_A","Allele_B")

> mat2

         Allele_A Allele_B
 rs123        "A"      "T"     
 rs333        "C"      "T"     
rs9000        "T"      "G"

>mat2行名（mat2）列名（mat2）mat2
等位基因A等位基因B
rs123“A”“T”
rs333“C”“T”
rs9000“T”“G”

现在我想把第一个矩阵中的012个编码的SNP重新编码为两列：如果它们的编码为零，它们应该是两个新列中各自的等位基因A，如果是1，它们应该是A/B，如果是2，它们应该是B/B。在我的示例中，我希望得到以下信息：

> mat3<-matrix(c("A","C","T","A","T","T","A","T","T","T","T","T","A","C","G","T","T","G" ),3,byrow=T)
> rownames(mat3)<-c("ID1","ID2","ID3")
> colnames(mat3)<-c("rs123_1","rs333_1","rs9000_1","rs123_2","rs333_2","rs9000_2")

> mat3

     rs123_1 rs333_1 rs9000_1 rs123_2 rs333_2 rs9000_2
ID1       "A"     "C"     "T"      "A"     "T"     "T"     
ID2       "A"     "T"     "T"      "T"     "T"     "T"     
ID3       "A"     "C"     "G"      "T"     "T"     "G"

>mat3行名（mat3）列名（mat3）mat3
rs123_1 rs333_1 rs9000_1 rs123_2 rs333_2 rs9000_2
ID1“A”“C”“T”“A”“T”“T”
ID2“A”“T”“T”“T”“T”
ID3“A”“C”“G”“T”“T”“G”

---

你能帮我做到这一点吗？提前谢谢你

这里是另一个data.table解决方案

library(reshape2)
library(data.table)

mat<-data.table(matrix(c("ID1","0","1","0","ID2","1","2","0","ID3","1","1","2"),3,byrow=T))
setnames(mat, c("ID","rs123","rs333","rs9000"))

mat2<-data.table(matrix(c("rs123","A","T","rs333","C","T","rs9000","T","G"),3,byrow=T))
setnames(mat2, c("rs","Allele_A","Allele_B"))

mat <- data.table(melt(mat, id.vars = 'ID'))
setnames(mat,'variable','rs')

mat <- merge(mat,mat2, by = 'rs', all.x = TRUE)
mat[,a1 := Allele_A]
mat[value == 2,a1 := Allele_B]
mat[,a2 := Allele_B]
mat[value == 0,a2 := Allele_A]

mat1 <- dcast(mat, ID~rs, value.var = 'a1')
mat2 <- dcast(mat, ID~rs, value.var = 'a2')
mat <- merge(mat1,mat2,by = 'ID', suffixes = c('_1','_2'))

library(data.table)
DT.mat1 <- as.data.table(mat)
DT.mat2 <- as.data.table(mat2, keep.rownames=TRUE)

## Make sure all characters
DT.mat2[, names(DT.mat2) := lapply(.SD, as.character)]

# set key to the row names
setkey(DT.mat2, rn)

---

---

您可以使用

microbenchmark

（来自microbenchmark包）来计时。我不确定您的实际数据有多大，但我猜随着数据的增长，这将是相当快的

不如Codoremifa建议的漂亮，作为一个函数：

allele_count_to_genotype <- function(M_count, M_geno){

  # assuming same order of SNPs in both matrices!

  # generate empty target matrix with right col and row names
  M_target <- matrix(ncol=ncol(M_count)*2, nrow=nrow(M_count)) 
  rownames(M_target) <- rownames(M_count)
  colnames(M_target) <- c(paste(colnames(M_count),"1",sep="_"), 
                          paste(colnames(M_count),"2",sep="_"))   

  # fill the target matrix with counts
  M_target[,1:ncol(M_count)]                   <- M_count
  M_target[, (ncol(M_count)+1):ncol(M_target)] <- M_count

  # substitute the counts
  for(k in 1:ncol(M_count)){
      M_target[,k] <- gsub("0", M_geno[k,1], M_target[,k])
      M_target[,k] <- gsub("1", M_geno[k,1], M_target[,k])
      M_target[,k] <- gsub("2", M_geno[k,2], M_target[,k])
      M_target[,(ncol(M_count)+k)] <- gsub("0", M_geno[k,1], M_target[,(ncol(M_count)+k)])
      M_target[,(ncol(M_count)+k)] <- gsub("1", M_geno[k,2], M_target[,(ncol(M_count)+k)])
      M_target[,(ncol(M_count)+k)] <- gsub("2", M_geno[k,2], M_target[,(ncol(M_count)+k)])
  }

  return(M_target)
 }

---

下面是一个使用

堆栈

、

开关

和

取消堆栈

的基本R方法：

s.mat <- stack(data.frame(mat))
left.allele.choice <- function(x) switch(x, "0"=1, "1"=1, "2"=2)
right.allele.choice <- function(x) switch(x, "0"=1, "1"=2, "2"=2)
get.allele.choice <- function(allele.choice) {
    mapply(function(values, ind) mat2[ind, allele.choice(values)], 
           values=s.mat$values, ind=s.mat$ind)
}
left.side <- unstack(transform(s.mat, 
                               values=get.allele.choice(left.allele.choice))) 
right.side <- unstack(transform(s.mat, 
                                values=get.allele.choice(right.allele.choice))) 
result <- cbind(left.side, right.side)
colnames(result) <- make.unique(colnames(result))
#   rs123 rs333 rs9000 rs123.1 rs333.1 rs9000.1
# 1     A     C      T       A       T        T
# 2     A     T      T       T       T        T
# 3     A     C      G       T       T        G

---

s.mat它正在迭代
.SD
（mat1列）的名称，并将它们用作mat2的键。然后是两个简单的
ifelse
语句…显然+1代表聪明。缺乏可读性似乎是嵌套
数据的一个常见特征。表
解决方案——一些人可能会争辩说，这是速度提升的公平价格。哈哈哈！我确实认为理解
data.table
语法就像理解嵌套的
lapply
调用一样。明确的学习曲线，但一旦越过这一驼峰，可读性很强。但是，是的，你完全正确，速度的提高是值得的，这对我来说是完美的！
   rs123 _ 1 rs333 _ 2 rs9000 _ 1 rs123 _ 2 rs333 _ 1 rs9000 _ 2
1:         A         T          C         C         T          G
2:         A         A          T         C         T          G
3:         A         A          C         C         G          T

allele_count_to_genotype <- function(M_count, M_geno){

  # assuming same order of SNPs in both matrices!

  # generate empty target matrix with right col and row names
  M_target <- matrix(ncol=ncol(M_count)*2, nrow=nrow(M_count)) 
  rownames(M_target) <- rownames(M_count)
  colnames(M_target) <- c(paste(colnames(M_count),"1",sep="_"), 
                          paste(colnames(M_count),"2",sep="_"))   

  # fill the target matrix with counts
  M_target[,1:ncol(M_count)]                   <- M_count
  M_target[, (ncol(M_count)+1):ncol(M_target)] <- M_count

  # substitute the counts
  for(k in 1:ncol(M_count)){
      M_target[,k] <- gsub("0", M_geno[k,1], M_target[,k])
      M_target[,k] <- gsub("1", M_geno[k,1], M_target[,k])
      M_target[,k] <- gsub("2", M_geno[k,2], M_target[,k])
      M_target[,(ncol(M_count)+k)] <- gsub("0", M_geno[k,1], M_target[,(ncol(M_count)+k)])
      M_target[,(ncol(M_count)+k)] <- gsub("1", M_geno[k,2], M_target[,(ncol(M_count)+k)])
      M_target[,(ncol(M_count)+k)] <- gsub("2", M_geno[k,2], M_target[,(ncol(M_count)+k)])
  }

  return(M_target)
 }

> allele_count_to_genotype(M_count=mat, M_geno=mat2)
    rs123_1 rs333_1 rs9000_1 rs123_2 rs333_2 rs9000_2
ID1 "A"     "C"     "T"      "A"     "T"     "T"     
ID2 "A"     "T"     "T"      "T"     "T"     "T"     
ID3 "A"     "C"     "G"      "T"     "T"     "G"  

s.mat <- stack(data.frame(mat))
left.allele.choice <- function(x) switch(x, "0"=1, "1"=1, "2"=2)
right.allele.choice <- function(x) switch(x, "0"=1, "1"=2, "2"=2)
get.allele.choice <- function(allele.choice) {
    mapply(function(values, ind) mat2[ind, allele.choice(values)], 
           values=s.mat$values, ind=s.mat$ind)
}
left.side <- unstack(transform(s.mat, 
                               values=get.allele.choice(left.allele.choice))) 
right.side <- unstack(transform(s.mat, 
                                values=get.allele.choice(right.allele.choice))) 
result <- cbind(left.side, right.side)
colnames(result) <- make.unique(colnames(result))
#   rs123 rs333 rs9000 rs123.1 rs333.1 rs9000.1
# 1     A     C      T       A       T        T
# 2     A     T      T       T       T        T
# 3     A     C      G       T       T        G