data.table中两种自定义函数行运算结果为何不一致？

问题描述 #

通过sapply逐行调用自定义函数Function得到Test1，再用data.table的赋值语法生成Data$Test1，但二者结果不一致，代码如下：

library("data.table")

Data <- fread("
V1 V2 V3
14   24.70762         17.3329292
8   25.01303         19.7530632
1   18.87427         -0.7832386
14   23.43488         14.9795652
14   24.43762         20.7145533
8   29.85930          3.7763770
17   27.66289          1.8315841
1   21.28808         79.7883210
1   24.55836         70.0779117
1   13.01046         27.3039891")

Function <- function(v1, v2, v3){
    
    ff <- function(wt){
            mod2 <- 1.399666
            j2 <- -0.4142602
            alpha <- 0.895474
            
            X_mu <- ifelse(wt >= j2*100,
                           wt - j2*100, 
                           0)
            mia <- X_mu/(alpha*100)
            weibull <- mod2/(alpha*100) * mia^(mod2 - 1) *
                exp(-mia^mod2)    
            return(weibull)
        }        
    my.f.si <- function(wt){
            epsilon = 0.008213571
            
            fnl <- (ff(wt) / epsilon)
            return(fnl)
        }

    SiS <- lapply(1:5, function(XX){
        pot = c(0.1012141, 0.1012141, 0.1410539,
                0.1581489, 0.1775243)
        theta0 = c(-3.651407, -3.651407, -3.804682,
                   -3.607503, -3.603890)
        theta1 = 0.2181257
        
        Pot <- pot[XX]
        The0 <- theta0[XX]
        The1 <- theta1
        
        Si <- 6 + (Pot*100 - 6) *
            my.f.si(wt = v3) *
            ((1 + exp(-(The0 + The1 * v2)))^-1)
        
        return(Si)
    })
    SiS <- do.call("c", SiS)
    
    MiN <- abs((SiS - v1) / v1)
  
    ## return(MiN)
    GetQ <- which(MiN == min(MiN))
    LengTh <- length(GetQ)
    return(LengTh)
}

##################################
Test1 <- sapply(1:nrow(Data), function(T){
    Function(v1 = Data[T, V1],
             v2 = Data[T, V2],
             v3 = Data[T, V2])})

##################################
Data[, Test1 := Function(v1 = V1,
                         v2 = V2,
                         v3 = V2)]

##################################
Test1
Data$Test1

原因分析 #

核心差异在于函数的输入类型：

• sapply是逐行调用，每次传入Function的v1、v2、v3都是单个标量值，函数内部的计算仅针对当前行的单个值。
• data.table的赋值语法是把整列向量直接传入Function，此时函数内部逻辑完全改变：
  1. SiS的每个元素会生成长度等于输入向量长度的结果，最终SiS是一个长度为5*nrow(Data)的长向量。
  2. MiN <- abs((SiS - v1)/v1)中，v1会被循环补齐到5*nrow(Data)长度，计算的是全局所有行的差值，而非逐行独立计算的差值。
  3. min(MiN)取的是全局最小值，which(MiN == min(MiN))会找出所有全局最小的位置，最终返回的LengTh是全局符合条件的数量，而非逐行的结果。

解决方法 #

要让两种调用方式结果一致，需要让函数支持逐行处理向量输入，或者在data.table中显式逐行调用：

方法1：修改函数为向量化版本 #

用mapply封装原函数，让每个输入元素独立计算：

Function_vec <- function(v1, v2, v3){
  mapply(function(v1_i, v2_i, v3_i){
    ff <- function(wt){
      mod2 <- 1.399666
      j2 <- -0.4142602
      alpha <- 0.895474
      
      X_mu <- ifelse(wt >= j2*100,
                     wt - j2*100, 
                     0)
      mia <- X_mu/(alpha*100)
      weibull <- mod2/(alpha*100) * mia^(mod2 - 1) *
        exp(-mia^mod2)    
      return(weibull)
    }        
    my.f.si <- function(wt){
      epsilon = 0.008213571
      fnl <- (ff(wt) / epsilon)
      return(fnl)
    }
    
    SiS <- lapply(1:5, function(XX){
      pot = c(0.1012141, 0.1012141, 0.1410539,
              0.1581489, 0.1775243)
      theta0 = c(-3.651407, -3.651407, -3.804682,
                 -3.607503, -3.603890)
      theta1 = 0.2181257
      
      Pot <- pot[XX]
      The0 <- theta0[XX]
      The1 <- theta1
      
      Si <- 6 + (Pot*100 - 6) *
        my.f.si(wt = v3_i) *
        ((1 + exp(-(The0 + The1 * v2_i)))^-1)
      
      return(Si)
    })
    SiS <- do.call("c", SiS)
    
    MiN <- abs((SiS - v1_i) / v1_i)
    
    GetQ <- which(MiN == min(MiN))
    LengTh <- length(GetQ)
    return(LengTh)
  }, v1, v2, v3)
}

调用方式：

Data[, Test1 := Function_vec(v1 = V1, v2 = V2, v3 = V2)]

方法2：在data.table中逐行调用 #

利用by = .I实现逐行处理，每次传入当前行的标量值：

Data[, Test1 := Function(v1 = V1, v2 = V2, v3 = V2), by = .I]

验证 #

运行修改后的代码，Test1和Data$Test1的结果会完全一致。

内容的提问来源于stack exchange，提问作者Nicso