在多个列上嵌套 if else 语句

Question

我有一个很大的data.frame，其中前三列包含有关标记的信息。其余列是每个个体中该标记的数字类型。每个人都有三列。数据集如下所示：

                      marker alleleA alleleB   X818 X818.1 X818.2   X345 X345.1 X345.2   X346 X346.1 X346.2
1   kgp5209280_chr3_21902067       T       A 0.0000 1.0000 0.0000 1.0000 0.0000 0.0000 0.0000 1.0000 0.0000
2 chr3_21902130_21902131_A_T       A       T 0.8626 0.1356 0.0018 0.7676 0.2170 0.0154 0.8626 0.1356 0.0018
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.2854 0.0164 0.5617 0.3749 0.0634 0.6982 0.2854 0.0164

也就是说，对于每个标记（行），每个人都有三个值，每列一个。

我想创建一个新的data.frame，它的行与原始行相同，但每个人只有一列。在每个人的一列中，我希望每个人的三列中的值大于 0.8。如果没有值大于 0.8，那么我想打印 NA。例如，在我为第一行给出的数据集中，我希望第二个值是 818 (1.0000)，第一个值是 345 (1.0000)。在第二行中，我想要 818 (0.8626) 的第一个值，对于 345，没有一个值高于 0.8，所以我想要打印 NA 等等。因此，新数据集将如下所示：

                     marker alleleA alleleB   X818 X345
1   kgp5209280_chr3_21902067       T       A 1.0000    1
2 chr3_21902130_21902131_A_T       A       T 0.8626   NA

我一直在尝试使用if/else 语句，就像if [, 4] > 0.8 then [, 4], else... 一样，但它似乎没有给我想要的东西，我还必须循环这个命令，所以它不只是做它适用于前三列中的一个人，但适用于所有列。

任何帮助将不胜感激！提前致谢。

Answer 1

编辑：使用在 data.table 版本 >= 1.9.0 中实施的快速融化/dcast 方法更新了解决方案。去here了解更多信息。

require(data.table)
require(reshape2)
dt <- as.data.table(df)

# melt data.table
dt.m <- melt(dt, id=c("marker", "alleleA", "alleleB"), 
                 variable.name="id", value.name="val")
dt.m[, id := gsub("\\.[0-9]+$", "", id)] # replace `.[0-9]` with nothing
# aggregation
dt.m <- dt.m[, list(alleleA = alleleA[1], 
         alleleB = alleleB[1], val = max(val)), 
        keyby=list(marker, id)][val <= 0.8, val := NA]
# casting back
dt.c <- dcast.data.table(dt.m, marker + alleleA + alleleB ~ id)
#                        marker alleleA alleleB X345   X346   X818
# 1: chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
# 2: chr3_21902134_21902135_T_C       T       C   NA     NA     NA
# 3:   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000

---

解决方案1：可能不是最好的方法，但这是我目前能想到的：

mm <- t(apply(df[-(1:3)], 1, function(x) tapply(x, gl(3,3), max)))
mode(mm) <- "numeric"
mm[mm < 0.8] <- NA 
# you can set the column names of mm here if necessary
out <- cbind(df[, 1:3], mm)

#                       marker alleleA alleleB      1  2      3
# 1   kgp5209280_chr3_21902067       T       A 1.0000  1 1.0000
# 2 chr3_21902130_21902131_A_T       A       T 0.8626 NA 0.8626
# 3 chr3_21902134_21902135_T_C       T       C     NA NA     NA

gl(3,3) 给出一个因子，其值为1,1,1,2,2,2,3,3,3，水平为1,2,3。也就是说，tapply 将一次取值 x 3 并获得它们的 max（前 3 个，后 3 个和最后 3 个）。并且apply 将每一行一一发送。

---

解决方案 2： 使用 melt 和 cast 在 data.table 内的 data.table 解决方案 不使用 使用 reshape 或 reshape2：

require(data.table)
dt <- data.table(df)
# melt your data.table to long format
dt.melt <- dt[, list(id = names(.SD), val = unlist(.SD)), 
                  by=list(marker, alleleA, alleleB)]
# replace `.[0-9]` with nothing
dt.melt[, id := gsub("\\.[0-9]+$", "", id)]
# get max value grouping by marker and id
dt.melt <- dt.melt[, list(alleleA = alleleA[1], 
                      alleleB = alleleB[1], 
                      val = max(val)), 
        keyby=list(marker, id)][val <= 0.8, val := NA]
# edit mnel (use setattr(,'names') to avoid copy by `names<-` within `setNames`
dt.cast <- dt.melt[, as.list(setattr(val,'names', id)), 
                   by=list(marker, alleleA, alleleB)]

#                        marker alleleA alleleB X345   X346   X818
# 1: chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
# 2: chr3_21902134_21902135_T_C       T       C   NA     NA     NA
# 3:   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000

Answer 2

我认为最好将您的数据放在长格式中。这里是基于reshape2 包的解决方案，可能类似于第二个@Arun 解决方案，但语法不同

library(reshape2)
dat.m <- melt(dat,id.vars=1:3)
dat.m$variable <- gsub('[.].*','',dat.m$variable)
dcast(dat.m,...~variable,fun.aggregate=function(x){
   res <- NA_real_
   if(length(x) > 0 && max(x)> 0.8)
      res <- max(x)
   res
})

                      marker alleleA alleleB X345   X346   X818
1 chr3_21902130_21902131_A_T       A       T   NA 0.8626 0.8626
2 chr3_21902134_21902135_T_C       T       C   NA     NA     NA
3   kgp5209280_chr3_21902067       T       A    1 1.0000 1.0000

Answer 3

这是我使用函数pmax 的方法。请注意，如果每个人有两个或多个高于 0.8 的值，这将为您提供最大值：

df <- read.table(textConnection("                      marker alleleA alleleB   X818 X818.1 X818.2   X345 X345.1 X345.2   X346 X346.1 X346.2
1   kgp5209280_chr3_21902067       T       A 0.0000 1.0000 0.0000 1.0000 0.0000 0.0000 0.0000 1.0000 0.0000
2 chr3_21902130_21902131_A_T       A       T 0.8626 0.1356 0.0018 0.7676 0.2170 0.0154 0.8626 0.1356 0.0018
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.2854 0.0164 0.5617 0.3749 0.0634 0.6982 0.2854 0.0164"), header=TRUE)

#data.table solution
library(data.table)
DT <- as.data.table(df)
DT[, M818 := ifelse(pmax(X818, X818.1, X818.2) > 0.8, pmax(X818, X818.1, X818.2), NA)]
DT[, M345 := ifelse(pmax(X345, X345.1, X345.2) > 0.8, pmax(X345, X345.1, X345.2), NA)]
DT[, M346 := ifelse(pmax(X346, X346.1, X346.2) > 0.8, pmax(X346, X346.1, X346.2), NA)]

#Base R solution
df$M818 <- ifelse(pmax(df$X818, df$X818.1, df$X818.2) > 0.8, pmax(df$X818, df$X818.1, df$X818.2), NA)
df$M345 <- ifelse(pmax(df$X345, df$X345.1, df$X345.2) > 0.8, pmax(df$X345, df$X345.1, df$X345.2), NA)
df$M346 <- ifelse(pmax(df$X346, df$X346.1, df$X346.2) > 0.8, pmax(df$X346, df$X346.1, df$X346.2), NA)

如果您想删除其他列，只需键入：

DT[, list(marker, alleleA, alleleB, M818, M345, M346)]
                       marker alleleA alleleB   M818 M345   M346
1:   kgp5209280_chr3_21902067       T       A 1.0000    1 1.0000
2: chr3_21902130_21902131_A_T       A       T 0.8626   NA 0.8626
3: chr3_21902134_21902135_T_C       T       C     NA   NA     NA

Answer 4

这是另一种可能的解决方案。上述所有解决方案均有效。

我的解决方案是在不使用新库的情况下创建一个区分大小写的函数。它很长，并且可以压缩，但是为了了解函数的工作原理，查看每个步骤很有用。

olddf <- data.frame(marker = c("kgp5209280_chr3_21902067",
        "chr3_21902130_21902131_A_T",
        "chr3_21902134_21902135_T_C"),
        alleleA = c("T","A","T"),
        alleleB = c("A","T","C"),
        X818 = c(0.0000,0.8626,0.6982),
        X818.1 = c(1.0000,0.1356,0.2854),
        X818.2 = c(0.0000,0.0018,0.0164),
        X345 = c(1.0000,0.7676, 0.5617),
        X345.1 = c(0.0000, 0.2170, 0.3749),
        X345.2 = c(0.0000, 0.0154, 0.0634),   
        X346 = c(0.0000, 0.8626, 0.6982),
        X346.1 = c(1.0000,0.1356, 0.2854), 
        X346.2 = c(0.0000, 0.0018, 0.0164))


mergeallele <- function(arguments,threshold = 0.8){
    n <- nrow(arguments)
    # Creation of a results object as an empty list of length NROW
    # speed for huge data.frame 
    new.lst <- vector(mode="list", n)
    for (i in 1:n){
        marker_row <- arguments[i,]
        colvalue.4 <- NaN
        if (max(marker_row[,c(4:6)]) < threshold){
            colvalue.4 <- max(marker_row[,c(4:6)])
        }

        colvalue.5 <- NaN       
        if (max(marker_row[,c(7:9)]) < threshold){
            colvalue.5 <- max(marker_row[,c(7:9)])
        }

        colvalue.6 <- NaN       
        if (max(marker_row[,c(10:12)]) < threshold){
            colvalue.6 <- max(marker_row[,c(10:12)])
        }
        new.lst[[i]]  <- data.frame(marker_row[,1],
            marker_row[,2],
            marker_row[,3],
            colvalue.4,
            colvalue.5,
            colvalue.6)     
    }   
    new.df <- as.data.frame(do.call("rbind",new.lst))
    names(new.df) <-  c(colnames(arguments)[1],
                    colnames(arguments)[2],
                    colnames(arguments)[3],
                    colnames(arguments)[4],
                    colnames(arguments)[7],
                    colnames(arguments)[10])
    return(new.df)
}


newdf <- mergeallele(olddf)

                      marker alleleA alleleB   X818   X345   X346
1   kgp5209280_chr3_21902067       T       A    NaN    NaN    NaN
2 chr3_21902130_21902131_A_T       A       T    NaN 0.7676    NaN
3 chr3_21902134_21902135_T_C       T       C 0.6982 0.5617 0.6982

关于：

threshold = 0.8 

您可以设置阈值（例如：0.8）避免更改函数内部的变量

new.lst <- vector(mode="list", n)

您可以创建一个长度为旧 data.frame 的空列表，然后列表中的元素逐渐被循环结果填充（快得多）。从这个Blog看测试速度