Question

如何使用data.table计算互动？具体来说，我试图获得从右到左的连续分组列之间的所有独特组合（删除未使用的级别）。我正在使用这样的代码，

## Sample data
set.seed(1999)
dat <- setDT(lapply(split(letters[1:9], 1:3), function(l) factor(sample(l, 10, TRUE, (1:3)^3))))
dat
#     1 2 3
#  1: d h i
#  2: g e f
#  3: g h i
#  4: g h i
#  5: d h i
#  6: g h c
#  7: d h i
#  8: g h f
#  9: g e i
# 10: d e i

## All factor combinations from left to right by column
f <- function(...) interaction(..., drop=TRUE)
levs <- Reduce(f, dat, accumulate = TRUE)
res <- unlist(lapply(levs, levels))
#  [1] "d"     "g"     "d.e"   "g.e"   "d.h"   "g.h"   "g.h.c" "g.e.f" "g.h.f"
# [10] "d.e.i" "g.e.i" "d.h.i" "g.h.i"

其中res是预期的结果。它工作正常，但我可能只是使用data.frame，因为这不是任何内部data.table匹配的优势。

这更糟糕，因为它重复了一切。

dat[, Reduce(f, .SD, accumulate = TRUE)]

我可以用快速data.table替换base interaction吗？

修改

来自gglot2

的数据的更大示例

data(diamonds, package="ggplot2")
dat <- as.data.table(diamonds)
sdcols <- c("cut", "color", "clarity")  # some factor columns

## Expected output, really just interested in the levels,
## so character instead of factor is fine
levs <- unlist(Reduce(function(...) interaction(..., drop=TRUE),
                      dat[,sdcols,with=FALSE], accumulate = TRUE))
length(levels(levs))  # [1] 316

## Not quite right
levs2 <- dat[, Reduce(function(...) do.call(paste, c(list(...), sep=".")), .SD,
                      accumulate = TRUE), .SDcols=sdcols]

Answer 1

使用OP的例子：

data(diamonds, package="ggplot2")
dat <- as.data.table(diamonds)
sdcols <- c("cut", "color", "clarity")

DAT <- dat[, sdcols, with=FALSE]

以下是一些选项

f       <- function(...) interaction(..., drop=TRUE)
baseint <- function() lapply(Reduce(f, DAT, accumulate = TRUE), levels)

newint  <- function() lapply(seq_along(DAT), function(nj) do.call(paste, c(
  sep=".",
  unique(DAT[,seq(nj),with=FALSE])
)))

newint2  <- function(){
  DAT0 = unique(DAT)
  res  = vector("list", length(DAT))
  for (k in length(DAT):1){
    res[[k]] <- do.call(paste, c(sep=".",DAT0))
    DAT0[, (length(DAT0)) := NULL]
    DAT0 <- unique(DAT0)
  }
  res
}

library(microbenchmark)
microbenchmark(
  base = {baseres = baseint()},
  new  = {newres  = newint()},
  new2 = {newres2 = newint2()},
  times = 3
)

# Unit: milliseconds
#  expr       min        lq      mean    median        uq       max neval
#  base 14.110835 14.377433 16.910993 14.644031 18.311072 21.978113     3
#   new  3.335112  3.352311  3.680126  3.369511  3.852634  4.335756     3
#  new2  2.662375  2.843113  3.963925  3.023850  4.614700  6.205549     3

identical(lapply(baseres,sort), lapply(newres,sort))  # TRUE
identical(lapply(baseres,sort), lapply(newres2,sort)) # TRUE

新interaction，newint2的第二个想法是采取以下步骤：

Uniquify data
粘贴列
删除最右边的列
在保留任何列的情况下从步骤1开始重复

评论的

这是一个非常小的例子，我不清楚一个更大的例子（我们谈论的是节省超过几毫秒）。

最后一个，如果您只需要获得累积交互的长度，

dat <- as.data.table(diamonds)
setkeyv(dat, sdcols)
tst <- vector("list", length(sdcols))
for (i in 1:length(sdcols)) tst[[i]] <- uniqueN(rleidv(dat[, sdcols[1:i], with=FALSE]))

data.table中因素之间的相互作用

修改

1 个答案: