如何使用兩個或更多列中的數據與R data.table的比較來應用函數

Question

我想對R數據表對象應用一個函數，該對象比較兩列中的值並返回結果。 這是數據表X的示例：

X <- as.data.table(list(POSITION=c(1,4,5,9,24,36,42,56),
   FIRST=c("A","BB","AA","B","AAA","B","A,B"),
   SECOND=c("B","AA","B","AAA","BBB","AB,ABB","B,A")))

   POSITION FIRST SECOND
1:        1     A      B
2:        4    BB     AA
3:        5    AA      B
4:        9     B    AAA
5:       24   AAA    BBB
6:       36     B AB,ABB
7:       42   A,B    B,A
8:       56     A      B

我想對“ FIRST”和“ SECOND”列中的數據執行以下邏輯比較，以創建“ RESULT”列：

 SAME = length of FIRST and SECOND are both one character
 BLOCK = Character length of FIRST and SECOND are the same,
         but greater than one, and not mixed (i.e. no comma)
 LESS = SECOND has fewer characters, but neither is mixed
 MORE = SECOND has more characters, but neither is mixed
 MIXED = either firs of second contains a comma

因此，所需的結果將如下所示：

POSITION FIRST SECOND RESULTS
1        A     B      SAME
4        BB    AA     BLOCK
5        A     B,A    MIXED    
9        AA    B      LESS
24       B     AAA    MORE
28       BBB   A,B    MIXED
36       AAA   BBB    BLOCK
42       B     AB,ABB MIXED
56       A,B   B,A    MIXED

因此，以下方法可行，但是對於具有400萬行的文件來說速度很慢！

X[, RESULT := ifelse(nchar(FIRST)+nchar(SECOND)==2,"SAME",
    ifelse(grepl(",", FIRST) | grepl(",",SECOND), "MIXED",
       ifelse(nchar(FIRST) > nchar(SECOND), "LESS",
          ifelse(nchar(FIRST) < nchar(SECOND), "MORE","BLOCK")))]

但這確實給了您想要的結果：

   POSITION FIRST SECOND RESULT
1:        1     A      B   SAME
2:        4    BB     AA  BLOCK
3:        5    AA      B   LESS
4:        9     B    AAA   MORE
5:       24   AAA    BBB  BLOCK
6:       36     B AB,ABB  MIXED
7:       42   A,B    B,A  MIXED
8:       56     A      B   SAME

實際上，我還有更多條件要測試，其中有些條件變得更加復雜，以至於字符計數都沒有。 不用長的ifelse語句，是否可以將兩列作為輸入來應用函數？ 例如：

checkType <- function(x) {
  if(nchar(x$FIRST)+nchar(x$SECOND)==2) {
    type <- "SNP"
  } else if(!grepl(",", x$SECOND) & !grepl(",",x$FIRST) & (nchar(x$FIRST) > nchar(x$SECOND))) {
    type <- "LESS"
  } else if(!grepl(",", x$SECOND) & !grepl(",",x$FIRST) & (nchar(x$FIRST) < nchar(x$SECOND))) {
    type <- "MORE"
  } else if (!grepl(",", x$SECOND) & !grepl(",",x$FIRST) & (nchar(x$FIRST) == nchar(x$SECOND)) & nchar(x$SECOND)>1) {
    type <-"BLOCK"
  } else {
    type <- "MIXED"
  }
  return(type)
}

> checkType(X[1,])
[1] "SAME"

for(i in 1:nrow(X)) X[i, RESULT := checkType(X[i,])]

因此，盡管上述方法可行，但這顯然不是使用data.table運行事物的最佳方法。 但是，我嘗試套用並套用，但均無效：

X[, RESULT3 := lapply(.SD, checkType)]
 Error in x$FIRST : $ operator is invalid for atomic vectors 
  nchar(x$FIRST) 
  FUN(X[[1L]], ...) 
  lapply(.SD, checkType) 
  eval(expr, envir, enclos) 
  eval(jsub, SDenv, parent.frame()) 
  `[.data.table`(X, , `:=`(RESULT3, lapply(.SD, checkType))) 
  X[, `:=`(RESULT3, lapply(.SD, checkType))] 

與apply（.SD，1，checkType）的結果相同。 通過應用函數，我試圖做的事情有可能嗎？

Answer 1

請注意，由您的代碼生成的數據表（下面的第一行，是從上面的代碼段粘貼的） 與下面的“所需結果”框中顯示的數據表不同。

但是，這實際上可能會更快，並且絕對會更容易理解。 我認為這與您的規則相符。

X <- as.data.table(list(POSITION=c(1,4,5,9,24,36,42,56),
                        FIRST=c("A","BB","AA","B","AAA","B","A,B"),
                        SECOND=c("B","AA","B","AAA","BBB","AB,ABB","B,A")))

X$mixed <- grepl(',',X$FIRST) | grepl(',',X$SECOND)
X$nf    <- nchar(X$FIRST)
X$ns    <- nchar(X$SECOND)
X$RESULT = ""

setkey(X,nf,ns)
X[J(1,1),RESULT:="SAME"]
X[!mixed & nf==ns & nf>1 & ns>1]$RESULT <- "BLOCK"
X[!mixed & nf > ns]$RESULT <- "LESS"
X[!mixed & nf < ns]$RESULT <- "MORE"
X[(mixed)]$RESULT <- "MIXED"
setkey(X,POSITION)

您的類別不是互相排斥的，因此我假設這些規則按順序適用（例如FIRST=","和SECOND=","呢？

另外，我認為您對MORE和LESS的定義是相同的。

Answer 2

因此，來自@Frank和@jlhoward的答案均提供了理想的結果，並且比我最初的嘗試要快得多。 但是，從這些答案中，這種方法（createResult1）的速度比具有1,000,000行的文件快4倍：

createResult1 <- function(X) {
  X[,`:=`(
    cf=nchar(FIRST),
    cs=nchar(SECOND),
    mf=grepl(',',FIRST),
    ms=grepl(',',SECOND)
    )]
  X[cf==1&cs==1, RESULT:="SAME"]
  X[cf > cs, RESULT:="LESS"]
  X[cf < cs, RESULT:="MORE"]
  X[cf==cs & cs>1, RESULT:="BLOCK"]
  X[(mf)|(ms), RESULT:="MIXED"]
  X[,c('cf','cs','mf','ms'):=NULL]
  return(X)
}

createResult2 <- function(X) { #@Frank
  X[,`:=`(
    cf=nchar(FIRST),
    cs=nchar(SECOND),
    mf=grepl(',',FIRST),
    ms=grepl(',',SECOND)
  )][,RESULT:=ifelse(cf==1&cs==1,"SAME",
                     ifelse(mf | ms, "MIXED",
                            ifelse(cf > cs, "LESS",
                                   ifelse(cf < cs, "MORE","BLOCK"))))
     ][
       ,c('cf','cs','mf','ms'):=NULL
        ]
  return(X)
}

createResult3 <- function(X) { #@jlhoward
  X$mixed <- grepl(',',X$FIRST) | grepl(',',X$SECOND)
  X$nf    <- nchar(X$FIRST)
  X$ns    <- nchar(X$SECOND)
  X$RESULT = ""

  setkey(X,nf,ns)
  X[J(1,1),RESULT:="SAME"]
  X[!mixed & nf==ns & nf>1 & ns>1]$RESULT <- "BLOCK"
  X[!mixed & nf > ns]$RESULT <- "LESS"
  X[!mixed & nf < ns]$RESULT <- "MORE"
  X[(mixed)]$RESULT <- "MIXED"
  X[,c('nf','ns','mixed'):=NULL]
  setkey(X,POSITION)
  return(X)
}

創建與上述相同的數據表，但具有1,000,000行

X <- as.data.table(list(POSITION=rep(c(1,4,5,9,24,36,42,56),1000000),
                        FIRST=rep(c("A","BB","AA","B","AAA","B","A,B"),1000000),
                        SECOND=rep(c("B","AA","B","AAA","BBB","AB,ABB","B,A"),1000000)))
Y <- copy(X)
Z <- copy(X)

結果如下：

> system.time(X <- createResult1(X))
   user  system elapsed 
   4.06    0.05    4.12
> system.time(Y <- createResult2(Y))
   user  system elapsed 
  18.53    0.36   18.94 
> system.time(Z <- createResult2(Z))
   user  system elapsed 
  18.63    0.29   18.97 
> identical(X,Y)
[1] TRUE
> identical(X,Z)
[1] TRUE