数据表中因素之间的交互作用

Question

数据表中因素之间的交互作用

4

如何使用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.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]

- Rorschach

你有数百个因子水平或列吗？我不会期望 interaction（它只需要组合因子水平并将它们粘在一起..？）需要很长时间。 - Frank

“交互”应该只需要“水平”属性就能够存在，为什么还需要整个向量呢？无论如何，既然这是一个性能问题，也许你可以添加一个运行时间更长的示例。set.seed(1); n = 1e5; etc - Frank

啊，好的，我不知道那个函数；从来没有用过。 - Frank

对于你的例子，我认为可以使用 setDT(list(l1,l2))[, do.call(paste, c(.SD,sep=".")), by="V1,V2"] 或者没有 by 的相同方式。在这里没有 by 更快，因为你有 10 万行和 9 万个唯一的 l1xl2 组合；如果组合数少于行数，那么 by 的方式会更快，我猜测是这样。 - Frank

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Frank · Accepted Answer

使用原帖中的例子：

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

一个新的交互的第二个想法，newint2，采取以下步骤：

唯一化数据
粘贴列
删除最右边的列
如果还有剩余列，则重复从步骤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]))