R data.table 按组高效复制

Question

我在尝试使用 data.table 和 rep 按组复制一些数据时遇到了一些内存分配问题。

这是一些示例数据：

ob1 <- as.data.frame(cbind(c(1999),c("THE","BLACK","DOG","JUMPED","OVER","RED","FENCE"),c(4)),stringsAsFactors=FALSE)
ob2 <- as.data.frame(cbind(c(2000),c("I","WALKED","THE","BLACK","DOG"),c(3)),stringsAsFactors=FALSE)
ob3 <- as.data.frame(cbind(c(2001),c("SHE","PAINTED","THE","RED","FENCE"),c(1)),stringsAsFactors=FALSE)
ob4 <- as.data.frame(cbind(c(2002),c("THE","YELLOW","HOUSE","HAS","BLACK","DOG","AND","RED","FENCE"),c(2)),stringsAsFactors=FALSE)
sample_data <- rbind(ob1,ob2,ob3,ob4)
colnames(sample_data) <- c("yr","token","multiple")

我想要做的是将令牌（按当前顺序）复制为每年的倍数。

以下代码有效，并给出了我想要的答案：

good_solution1 <- ddply(sample_data, "yr", function(x) data.frame(rep(x[,2],x[1,3])))

good_solution2 <- data.table(sample_data)[, rep(token,unique(multiple)),by = "yr"]

问题在于，当我将其扩展到 40 毫米以上的行时，两种可能的解决方案都会出现内存问题。

如果我的理解是正确的，这些解决方案本质上是在做一个每次都分配的 rbind。

谁有更好的解决方案？

我查看了 data.table 的 set()，但遇到了问题，因为我想在每次复制时保持令牌的顺序相同。

Answer 1

一种方法是：

require(data.table)
dt <- data.table(sample_data)
# multiple seems to be a character, convert to numeric
dt[, multiple := as.numeric(multiple)]
setkey(dt, "multiple")
dt[J(rep(unique(multiple), unique(multiple))), allow.cartesian=TRUE]

除了最后一行之外的所有内容都应该简单明了。最后一行在J(.) 的帮助下使用了一个使用键列的子集。对于J(.)中的每个值，对应的值与“键列”匹配，并返回匹配的子集。

也就是说，如果您执行dt[J(1)]，您将获得multiple = 1 所在的子集。如果你仔细注意，dt[J(rep(1,2)] 会给你相同的子集，但是两次。请注意，传递dt[J(1,1)] 和dt[J(rep(1,2)] 是有区别的。前者是将 (1,1) 的值分别与 data.table 的 first-two-key-columns 匹配，而后者是通过将 (1 和 2) 与 first-key 列。

因此，如果我们要在 J(.) 中将列的相同值传递 2 次，那么它会被复制两次。我们使用这个技巧来传递 1 1 次、2 2 次等。这就是 rep(.) 部分所做的。 rep(.) 给出 1,2,2,3,3,3,4,4,4,4。

如果连接产生的行数多于max(nrow(dt), nrow(i))（i 是J(.) 中的代表向量），则您必须明确使用allow.cartesian = TRUE 来执行此连接（我猜这是来自数据表 1.8.8)。

---

编辑：这是我对“相对”大数据所做的一些基准测试。我没有看到这两种方法的内存分配有任何峰值。但是我还没有找到一种方法来监控 R 函数中的峰值内存使用情况。我确信我已经在 SO 上看到过这样的帖子，但它现在让我失望了。我会再回信。现在，这里有一个测试数据和一些初步结果，以防有人有兴趣/想自己运行它。

# dummy data
set.seed(45)
yr <- 1900:2013
sz <- sample(10:50, length(yr), replace = TRUE)
token <- unlist(sapply(sz, function(x) do.call(paste0, data.frame(matrix(sample(letters, x*4, replace=T), ncol=4)))))
multiple <- rep(sample(500:5000, length(yr), replace=TRUE), sz)

DF <- data.frame(yr = rep(yr, sz), 
                 token = token, 
                 multiple = multiple, stringsAsFactors=FALSE)

# Arun's solution
ARUN.DT <- function(dt) {
    setkey(dt, "multiple")
    idx <- unique(dt$multiple)
    dt[J(rep(idx,idx)), allow.cartesian=TRUE]
}

# Ricardo's solution
RICARDO.DT <- function(dt) {
    setkey(dt, key="yr")
    newDT <- setkey(dt[, rep(NA, list(rows=length(token) * unique(multiple))), by=yr][, list(yr)], 'yr')
    newDT[, tokenReps := as.character(NA)]

    # Add the rep'd tokens into newDT, using recycling
    newDT[, tokenReps := dt[.(y)][, token], by=list(y=yr)]
    newDT
}

# create data.table
require(data.table)
DT <- data.table(DF)

# benchmark both versions
require(rbenchmark)
benchmark(res1 <- ARUN.DT(DT), res2 <- RICARDO.DT(DT), replications=10, order="elapsed")

#                     test replications elapsed relative user.self sys.self
# 1    res1 <- ARUN.DT(DT)           10   9.542    1.000     7.218    1.394
# 2 res2 <- RICARDO.DT(DT)           10  17.484    1.832    14.270    2.888

但正如 Ricardo 所说，内存不足可能并不重要。因此，在这种情况下，必须在速度和内存之间进行权衡。我想验证的是两种方法中使用的峰值内存，如果使用Join 更好的话。

Answer 2

您可以尝试先为所有行分配内存，然后迭代地填充它们。
例如：

  # make sure `sample_data$multiple` is an integer
  sample_data$multiple <- as.integer(sample_data$multiple)

  # create data.table
  S <- data.table(sample_data, key='yr')

  # optionally, drop original data.frame if not needed
  rm(sample_data)

  ## Allocate the memory first
  newDT <- data.table(yr = rep(sample_data$yr, sample_data$multiple), key="yr")
  newDT[, tokenReps := as.character(NA)]

  # Add the rep'd tokens into newDT, using recycling
  newDT[, tokenReps := S[.(y)][, token], by=list(y=yr)]

---

两个注意事项：

(1) sample_data$multiple 当前是一个字符，因此在传递给 rep 时会被强制转换（在您的原始示例中）。如果情况也是如此，可能值得仔细检查您的真实数据。

(2) 我使用以下方法来确定每年所需的行数

S[, list(rows=length(token) * unique(multiple)), by=yr]