使用R按不等组滚动唯一值的计数

Question

我正在尝试为滚动窗口（例如 12 obs.）中字符列的更改次数创建一个指示器，但按组创建。在没有分组的情况下，rollapply 和 data.table 的 uniqueN 使用 data.table 可以做到这一点：

library(data.table)
library(zoo)
df <- data.table(id = c(rep(1:5, each = 53), 5), 
             time = c(rep(1:53, times = 5), 54), 
             geo = c("E","E","E","B","B","B","B","B","B","B","A","A","A","A","A","A","A","C","C","C","C","C","C","C","G","G","G","G","G","G","G","G","G","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","D","D","D","D","D","D","G","G","G","G","G","E","E","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","I","I","I","I","I","B","B","B","B","B","B","B","B","B","D","D","D","D","D","D","D","D","D","D","D","D","E","E","E","E","E","E","E","E","E","E","E","E","E","E","E","I","I","I","I","I","I","I","I","H","C","C","C","C","C","C","C","C","C","G","G","G","G","G","G","G","G","G","G","G","G","G","G","G","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","B","B","B","B","B","B","B","B","B","B","B","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","I","I","I","I","I","I","E","E","E","E","E","E","E","E","E","E","F","F","A","A","A","A","A"))

# works
df[, change := rollapply(geo, width = 12, FUN = uniqueN, na.pad = TRUE, align = "right")]

但是当我按 id 对它们进行分组时，它不起作用

# does not work
df[, change := rollapply(geo, width = 12, FUN = uniqueN, na.pad = TRUE, align = "right"), by = id]

有没有办法进行滚动唯一计数，最好使用 data.table？

Answer 1

问题已通过将 rollapply 函数包装在 as.numeric 中得到解决，因为变量 change 被创建为逻辑变量，无法处理除 0 和 1（以及 NA）以外的数字。

如果我们保留这个问题，这可能有助于其他人注意。

# works
df[, change := as.numeric(rollapplyr(geo, width = 12, FUN = uniqueN, fill = NA)), by = id]

Answer 2

新的快速版本rollapply 功能即将来到data.table。它被称为frollapply。它并不是真的那么快，但仍然应该加快一些速度。 它并没有那么快，因为它必须在滚动窗口的每次迭代中回退到 R 的 C eval 函数。

它接受数字或逻辑输入，因此为了处理您的数据，我们需要创建临时的ngeo 列。

library(data.table)
library(zoo)
df = data.table(
  id = c(rep(1:5, each = 53), 5), time = c(rep(1:53, times = 5), 54), 
  geo = c("E","E","E","B","B","B","B","B","B","B","A","A","A","A","A","A","A","C","C","C","C","C","C","C","G","G","G","G","G","G","G","G","G","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","C","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","B","D","D","D","D","D","D","G","G","G","G","G","E","E","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","I","I","I","I","I","B","B","B","B","B","B","B","B","B","D","D","D","D","D","D","D","D","D","D","D","D","E","E","E","E","E","E","E","E","E","E","E","E","E","E","E","I","I","I","I","I","I","I","I","H","C","C","C","C","C","C","C","C","C","G","G","G","G","G","G","G","G","G","G","G","G","G","G","G","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","F","B","B","B","B","B","B","B","B","B","B","B","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","A","I","I","I","I","I","I","E","E","E","E","E","E","E","E","E","E","F","F","A","A","A","A","A")
)
dt = copy(df)

# zoo rollapply
df[, change := as.numeric(rollapplyr(geo, width=12, FUN=uniqueN, fill=NA)), by=id]

# data.table frollapply
dt[, ngeo := unclass(as.factor(geo))]
dt[, change := frollapply(ngeo, 12L, FUN=uniqueN), by=id]
dt[, ngeo := NULL]

all.equal(dt, df)
#[1] TRUE

它还没有合并到data.table的master分支中，你必须尝试一下

devtools::install_github("Rdatatable/data.table@frollapply")