在data.table中创建新列时,如何引用整行？

Question

我有data.table200多个变量都是二进制的.我想在其中创建一个新列,用于计算每行和参考向量之间的差异:

#Example
dt = data.table(
"V1" = c(1,1,0,1,0,0,0,1,0,1,0,1,1,0,1,0),
"V2" = c(0,1,0,1,0,1,0,0,0,0,1,1,0,0,1,0),
"V3" = c(0,0,0,1,1,1,1,0,1,0,1,0,1,0,1,0),
"V4" = c(1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0),
"V5" = c(1,1,0,0,1,1,0,0,1,1,0,0,1,1,0,0)  
)

reference = c(1,1,0,1,0)

我可以用一个小的for循环,比如

distance = NULL
for(i in 1:nrow(dt)){      
  distance[i] = sum(reference != dt[i,])  
}

但它有点慢,肯定不是最好的方法.我试过了:

dt[,"distance":= sum(reference != c(V1,V2,V3,V4,V5))]
dt[,"distance":= sum(reference != .SD)]

但它们都不起作用,因为它们为所有行返回相同的值.此外,我不必键入所有变量名称的解决方案会好得多,因为真正的data.table有超过200列

Answer 1

您可以使用sweep()同rowSums,即

rowSums(sweep(dt, 2, reference) != 0)
 #[1] 2 2 2 2 4 4 3 2 4 3 2 1 3 4 1 3

BENCHMARK

HUGH <- function(dt) {
    dt[, I := .I] 
    distance_by_I <- melt(dt, id.vars = "I")[, .(distance = sum(reference != value)), keyby = "I"]
    return(dt[distance_by_I, on = "I"])
}

Sotos <- function(dt) {
    return(rowSums(sweep(dt, 2, reference) != 0))
}

dt1 <- as.data.table(replicate(5, sample(c(0, 1), 100000, replace = TRUE)))
microbenchmark(HUGH(dt1), Sotos(dt1))

#Unit: milliseconds
#       expr       min        lq      mean   median        uq       max neval cld
#  HUGH(dt1) 112.71936 117.03380 124.05758 121.6537 128.09904 155.68470   100   b
# Sotos(dt1)  23.66799  31.11618  33.84753  32.8598  34.02818  68.75044   100  a 

Answer 2

另一个:

ref = as.list(reference)
dt[, Reduce(`+`, Map(`!=`, .SD, ref))]

这个怎么运作.因此,我们将每个向量列.SD与其中的单个对应值进行比较ref.该!=函数是矢量化的,因此每个元素都ref被循环出来以匹配每个向量的长度.

此Map调用返回一个TRUE/FALSE向量列表,每列一个.当我们将TRUE/FALSE值相加时,它们被视为1/0,因此我们只需要添加这些列.这可以通过+在第一列和第二列之间传递成对运算符来实现; 然后再在计算结果和第三列之间; 等等.这是怎么回事Reduce.它可能更具可读性

x = dt[, Map(`!=`, .SD, ref)]
Reduce(`+`, x, init = 0L)

可以读作

• v = 0
• 对于x中的每个xi,更新v = v + xi

另见?Map和?Reduce.

计时.我正在修改基准数据,因为如果OP真的有0-1数据,使用整数似乎更加理智.此外,由于OP表示他们有很多,因此添加更多列.最后,编辑Hugh的答案可与其他答案相媲美:

HUGH <- function(dt, r) {
  dt[, I := .I] 
  res <- melt(dt, id.vars = "I")[, .(distance = sum(r != value)), keyby = "I"]$distance
  dt[, I := NULL]
  res
}

Sotos <- function(dt, r) {
  return(rowSums(sweep(dt, 2, r) != 0))
}

mm <- function(dt, r){
  colSums(t(dt) != r)
}

ff <- function(DT, r){
  DT[, Reduce(`+`, Map(`!=`, .SD, r))]
}

nr = 20000
nc = 500
dt1 <- as.data.table(replicate(nc, sample(0:1, nr, replace = TRUE)))
ref <- rep(as.integer(reference), length.out=nc)
lref = as.list(ref)

identical(HUGH(dt1, ref), ff(dt1, lref)) # integer output
identical(mm(dt1, ref), Sotos(dt1, ref)) # numeric output
all.equal(HUGH(dt1, ref), mm(dt1, ref))  # but they match
# all TRUE

microbenchmark::microbenchmark(times = 3, 
 HUGH(dt1, ref), 
 Sotos(dt1, ref), 
 mm(dt1, ref), 
 ff(dt1, lref)
)

结果:

Unit: milliseconds
            expr      min        lq     mean   median         uq       max neval
  HUGH(dt1, ref) 365.0529 370.05233 378.8826 375.0517  385.79737  396.5430     3
 Sotos(dt1, ref) 871.5693 926.50462 961.5527 981.4400 1006.54437 1031.6488     3
    mm(dt1, ref) 104.5631 121.74086 131.7157 138.9186  145.29197  151.6653     3
   ff(dt1, lref)  87.0800  87.48975  93.1361  87.8995   96.16415  104.4288     3