R 基于一列重新编码数据帧

我有一个5845*1095（行*列）数据框，看起来像这样：

 9  286593   C     C/C     C/A     A/A
 9  334337   A     A/A     G/A     A/A
 9  390512   C     C/C     C/C     C/C

c <-  c("9", "286593", "C", "C/C", "C/A", "A/A") 
d <-  c("9", "334337", "A", "A/A", "G/A", "A/A")
e <-   c("9", "390512", "C", "C/C", "C/C", "C/C")
dat <- data.frame(rbind(c,d,e))

9286593 C/C/A A/A
9 334337 A A A/A G/A A/A
9 390512 C/C C/C/C
c首先，请输入您的数据：

c <-  c("9", "286593", "C", "C/C", "C/A", "A/A")
# Note: In your original data, you had a space in "G/A", which I did remove. 
# If this was no mistake, we would also have to deal with the space.
d <-  c("9", "334337", "A", "A/A", "G/A", "A/A")
e <-   c("9", "390512", "C", "C/C", "C/C", "C/C")
dat <- data.frame(rbind(c,d,e))

这使得我的版本稍微快一点。然而，差别几乎为零，因此您可能对每一种方法都很满意。公平地说：我没有对添加额外因子水平的部分进行基准测试。同时这样做可能会排除我的版本。
以下是一种方法：

FUN <- function(x) {
    a <- strsplit(as.character(unlist(x[-1])), "/")
    b <- sapply(a, function(y) sum(y %in% as.character(unlist(x[1]))))
    2 - b
}

dat[4:6] <-  t(apply(dat[, 3:6], 1, FUN))

## > dat
##   X1     X2 X3 X4 X5 X6
## c  9 286593  C  0  1  2
## d  9 334337  A  0  1  0
## e  9 390512  C  0  0  0

FUN此解决方案效率不高：

dat <-  cbind(dat[,-(4:6)],
              t(sapply(seq_len(nrow(dat)),function(i){
                res <- dat[i,]
                res[,4:6] <- lapply(res[,4:6],function(x) 2-sum(gregexpr(res[,3],x)[[1]]>0))
              })))

#  X1     X2 X3 X4 X5 X6
#c  9 286593  C  0  1  2
#d  9 334337  A  0  1  0
#e  9 390512  C  0  0  0

dat很难看，但它能工作

fff<-apply(dat[,4:ncol(dat)],2,substr,1,1)!=dat[,3]
ggg<-apply(dat[,4:ncol(dat)],2,substr,3,3)!=dat[,3]
final<-fff+ggg
cbind(dat,final)
X1     X2 X3  X4  X5  X6 X4 X5 X6
c  9 286593  C C/C C/A A/A  0  1  2
d  9 334337  A A/A G/A A/A  0  1  0
e  9 390512  C C/C C/C C/C  0  0  0

fff这里有一种方法可以使用
apply
：

out <- apply(dat[, -(1:2)], 1, function(x) 
        2 - grepl(x[1], x[-1]) -  
        x[-1] %in% paste(x[1], x[1], sep="/"))
cbind(dat[, (1:3)], t(out))

out对R-golf的另一贡献：

cbind(dat[, 1:3],
      apply(dat[, -(1:3)], 2, function(x) {
        2 - (dat[[3]] == gsub('..$', '', x)) - (dat[[3]] == gsub('^..', '', x))
      }))

A、C、G、T
是唯一的字母表吗？或者你还有
N
和其他字母表..？应该是A、C、G、T是的。你可以说这是DNA，不是吗：）作为一个生物信息学家，如果我能：）这将是一个问题。没有丢失的数据Fabio，只是丢失了诀窍。只是一个可能的解决方案的提示：
length（grep（dat$X3，dat$X4））
大型基准测试的信息量可能要比大型复制基准测试的信息量大得多，这意味着我非常确定这是基本上适用于任何规模的最快解决方案data@eddi：哦，我忘了提一下：在复制数据之前，我对三行进行了重新采样，使
dat
包含10000行数据。因此，也有大量的数据。你的答案被接受（尽管我可以从他们身上学到一些东西），因为基准测试显示你的答案是最快的。所以我更喜欢编程。哇！干得好（我跑得第二快！）！你能加上eddi的溶液吗？单核苷酸多态性的数量很容易达到数十万个，因此采用快速方法非常好！
FUN <- function(x) {
    a <- strsplit(as.character(unlist(x[-1])), "/")
    b <- sapply(a, function(y) sum(y %in% as.character(unlist(x[1]))))
    2 - b
}

dat[4:6] <-  t(apply(dat[, 3:6], 1, FUN))

## > dat
##   X1     X2 X3 X4 X5 X6
## c  9 286593  C  0  1  2
## d  9 334337  A  0  1  0
## e  9 390512  C  0  0  0

dat <-  cbind(dat[,-(4:6)],
              t(sapply(seq_len(nrow(dat)),function(i){
                res <- dat[i,]
                res[,4:6] <- lapply(res[,4:6],function(x) 2-sum(gregexpr(res[,3],x)[[1]]>0))
              })))

#  X1     X2 X3 X4 X5 X6
#c  9 286593  C  0  1  2
#d  9 334337  A  0  1  0
#e  9 390512  C  0  0  0

fff<-apply(dat[,4:ncol(dat)],2,substr,1,1)!=dat[,3]
ggg<-apply(dat[,4:ncol(dat)],2,substr,3,3)!=dat[,3]
final<-fff+ggg
cbind(dat,final)
X1     X2 X3  X4  X5  X6 X4 X5 X6
c  9 286593  C C/C C/A A/A  0  1  2
d  9 334337  A A/A G/A A/A  0  1  0
e  9 390512  C C/C C/C C/C  0  0  0

out <- apply(dat[, -(1:2)], 1, function(x) 
        2 - grepl(x[1], x[-1]) -  
        x[-1] %in% paste(x[1], x[1], sep="/"))
cbind(dat[, (1:3)], t(out))

cbind(dat[, 1:3],
      apply(dat[, -(1:3)], 2, function(x) {
        2 - (dat[[3]] == gsub('..$', '', x)) - (dat[[3]] == gsub('^..', '', x))
      }))