r语言 - 基于一列重新编码数据帧 - 反向

Question

我不久前问过这个问题（基于一列重新编码数据帧），答案非常有效。然而，现在我几乎想反其道而行之。也就是说，我的 （700k * 2000） 为 0/1/2 或 NA。在一个单独的数据帧中，我有两列（引用和 Obs）。0 对应于 Ref 的两个实例，1 是 Ref 的一个实例和一个 Obs 实例，2 是两个 Obs。为澄清起见，数据片段：

 Genotype File --- 
 Ref Obs   
 A    G        
 T    C
 G    C
 Ref <- c("A", "T", "G")
 Obs <- c("G", "C", "C")
 Current Data---
 Sample.1     Sample.2  .... Sample.2000
 0              1                2
 0              0                0 
 0              NA               1
mat <- matrix(nrow=3, ncol=3)
mat[,1] <- c(0,0,0)
mat[,2] <- c(1,0,NA)
mat[,3] <- c(2,0,1)
 Desired Data format--- 
 Sample.1   Sample.1   Sample.2   Sample.2   Sample.2000   Sample.2000
    A         A           A           G          G              G
    T         T           T           T          T              T
    G         G           0           0          G              C

我认为这是对的。所需的数据格式对每个样本有两列（空格分隔）。这种格式的 0（生物信息学家的 plink ped 文件）缺少数据。

Answer 1

主要假设：您的数据在 3 个元素帧中，即您想将映射应用于前 3 行，然后是接下来的 3 行，依此类推，我认为考虑到 DNA 帧，这是有意义的。 如果你想要一个滚动的 3 元素窗口，这将不起作用（但可以修改代码以使其工作）。 这将适用于任意数量的列和任意数量的 3 行组：

# Make up a matrix with your properties (4 cols, 6 rows)
col <- 4L
frame <- 3L
mat <- matrix(sample(c(0:2, NA_integer_), 2 * frame * col, replace=T), ncol=col)
# Mapping data
Ref <- c("A", "T", "G")
Obs <- c("G", "C", "C")
map.base <- cbind(Ref, Obs)
num.to.let <- matrix(c(1, 1, 1, 2, 2, 2), byrow=T, ncol=2) # how many from each of ref obs
# Function to map 0,1,2,NA to Ref/Obs
re_map <- function(mat.small) {  # 3 row matrices, with col columns
  t(
    mapply(                      # iterate through each row in matrix
      function(vals, map, num.to.let) {
        vals.2 <- unlist(lapply(vals, function(x) map[num.to.let[x + 1L, ]]))
        ifelse(is.na(vals.2), 0, vals.2)
      },
      vals=split(mat.small, row(mat.small)),  # a row
      map=split(map.base, row(map.base)),     # the mapping for that row
      MoreArgs=list(num.to.let=num.to.let)    # general conversion of number to Obs/Ref
  ) ) 
}
# Split input data frame into 3 row matrices (assumes frame size 3),
# and apply mapping function to each group
mat.split <- split.data.frame(mat, sort(rep(1:(nrow(mat) / frame), frame)))
mat.res <- do.call(rbind, lapply(mat.split, re_map)) 
colnames(mat.res) <- paste0("Sample.", rep(1:ncol(mat), each=2))
print(mat.res, quote=FALSE)
#   Sample.1 Sample.1 Sample.2 Sample.2 Sample.3 Sample.3 Sample.4 Sample.4
# 1 G        G        A        G        G        G        G        G       
# 2 C        C        0        0        T        C        T        C       
# 3 0        0        G        C        G        G        G        G       
# 1 A        A        A        A        A        G        A        A       
# 2 C        C        C        C        T        C        C        C       
# 3 C        C        G        G        0        0        0        0       

Answer 2

我

不确定，但这可能是你需要的：

第一个相同的简单数据

geno <- data.frame(Ref = c("A", "T", "G"), Obs = c("G", "C", "C"))
data <- data.frame(s1 = c(0,0,0),s2 = c(1, 0, NA))

然后是几个函数：

f <- function(i , x, geno){
  x <- x[i]
  if(!is.na(x)){
    if (x == 0) {y <- geno[i , c(1,1)]}
    if (x == 1) {y <- geno[i, c(1,2)]}
    if (x == 2) {y <- geno[i, c(2,2)]}
  }
  else y <- c(0,0)
  names(y) <- c("s1", "s2")
  y
}
g <- function(x, geno){
 Reduce(rbind, lapply(1:length(x), FUN = f , x = x, geno = geno))
}

定义 f（） 的方式可能不是最优雅的，但它可以完成工作

然后简单地以 lapply 的方式将其作为 doble for 循环运行

as.data.frame(Reduce(cbind, lapply(data , g , geno = geno )))

希望对您有所帮助

Answer 3

以下是基于答案中的示例数据的一种方法：

# create index
idx <- lapply(data, function(x) cbind((x > 1) + 1, (x > 0) + 1))
# list of matrices
lst <- lapply(idx, function(x) {
  tmp <- apply(x, 2, function(y) geno[cbind(seq_along(y), y)])
  replace(tmp, is.na(tmp), 0)
  })
# one data frame
as.data.frame(lst)
#   s1.1 s1.2 s2.1 s2.2
# 1    A    A    A    G
# 2    T    T    T    T
# 3    G    G    0    0