具有指定锚点的动态列位置答案

【问题标题】：Dynamic column position with specified anchor point具有指定锚点的动态列位置
【发布时间】：2018-08-13 10:50:15
【问题描述】：

我想做一个函数，我可以指定哪一列应该是锚点，或者计算的基础。

set.seed(123)
library(data.table)

dt = data.table(Acc_ID = c(1:50),
                P1 = sample((0:10000), 50, replace = T),
                P2 = sample((0:10000), 50, replace = T),
                P3 = sample((0:10000), 50, replace = T),
                P4 = sample((0:10000), 50, replace = T),
                P5 = sample((0:10000), 50, replace = T), 
                P6 = sample((0:10000), 50, replace = T),
                P7 = sample((0:10000), 50, replace = T), 
                P8 = sample((0:10000), 50, replace = T),
                P9 = sample((0:10000), 50, replace = T),
                P10 = sample((0:10000), 50, replace = T),
                P11 = sample((0:10000), 50, replace = T),
                P12 = sample((0:10000), 50, replace = T))

最终结果应如下所示：

dt[, `:=` (sumcoll1m = `P12`,
           sumcoll3m = rowSums(dt[, `P10`:`P12`]),
           sumcoll6m = rowSums(dt[,  `P7`:`P12`]),
           sumcoll12m = rowSums(dt[,  `P1`:`P12`]),
           payments1m = ifelse(dt[, `P12`] > 0, 1, 0),
           payments3m = rowSums(dt[, `P10`:`P12`] > 0),
           payments6m = rowSums(dt[, `P7`:`P12`] > 0),
           payments12m = rowSums(dt[, `P1`:`P12`] > 0))]

在本例中，锚点是 P12，但它可以是任何名称，也可以是不同的名称。我想要的是无论锚点是什么都具有相同的间隔长度 - 除了如果锚点是 P1，那么它只会在适用的地方进行计算。

有没有聪明的方法来做到这一点？

提前感谢您！

编辑：是的，它表示月份。 P5 的预期结果是：

dt[, `:=` (sumcoll1m = `P5`,
           sumcoll3m = rowSums(dt[, `P3`:`P5`]),
           payments1m = ifelse(dt[, `P5`] > 0, 1, 0),
           payments3m = rowSums(dt[, `P3`:`P5`] > 0))]

这就是我现在的位置：

dt[, `:=` (sumcoll1m = `P12`,
           sumcoll3m = rowSums(dt[, c(which(names(dt) == "P12") - seq(0, 2)), with = F]),
           sumcoll6m = rowSums(dt[,  c(which(names(dt) == "P12") - seq(0, 5)), with = F]),
           sumcoll12m = rowSums(dt[,  c(which(names(dt) == "P12") - seq(0, 11)), with = F]),
           payments1m = ifelse(dt[, `P12`] > 0, 1, 0),
           payments3m = rowSums(dt[, c(which(names(dt) == "P12") - seq(0, 2)), with = F] > 0),
           payments6m = rowSums(dt[, c(which(names(dt) == "P12") - seq(0, 5)), with = F] > 0),
           payments12m = rowSums(dt[, c(which(names(dt) == "P12") - seq(0, 11)), with = F] > 0))]

【问题讨论】：

你考虑过从宽幅到长幅重塑吗？
@Uwe，感谢您的回复。我考虑过，但我认为这不会使问题变得更容易（如果我错了，请纠正我）。我在想更多的东西，使用哪个函数来确定列 id，然后从该 id 中减去以获得间隔，但还没有弄清楚。
列是否表示月份？仅从 P 列的数量得出结论。另外，请edit您的 Q 并显示锚点的预期结果，例如 P5，以确保我完全理解您的逻辑。那么sumcoll6m P1 到 P5 列的行总和呢？

标签： r function data.table

【解决方案1】：

这是一个棘手的问题。我的建议是将数据从宽格式转换为长格式，并使用tail() 计算可变长度窗口上的聚合。

用于验证的最小数据集

但首先，我们需要定义一个最小的工作数据集，以帮助验证结果的正确性：

library(data.table)
n_row <- 2
DT <- data.table(Acc_ID = seq_len(n_row))
for (i in 1:12) {
  set(DT, , paste0("P", i), (100*seq_len(n_row) + i) * (-1)^i)
}
DT

   Acc_ID   P1  P2   P3  P4   P5  P6   P7  P8   P9 P10  P11 P12
1:      1 -101 102 -103 104 -105 106 -107 108 -109 110 -111 112
2:      2 -201 202 -203 204 -205 206 -207 208 -209 210 -211 212

重塑

long <- melt(DT, "Acc_ID")
long[, variable := as.ordered(variable)]
long

    Acc_ID variable value
 1:      1       P1  -101
 2:      2       P1  -201
 3:      1       P2   102
 4:      2       P2   202
 5:      1       P3  -103
 6:      2       P3  -203
 7:      1       P4   104
 8:      2       P4   204
 9:      1       P5  -105
10:      2       P5  -205
11:      1       P6   106
12:      2       P6   206
13:      1       P7  -107
14:      2       P7  -207
15:      1       P8   108
16:      2       P8   208
17:      1       P9  -109
18:      2       P9  -209
19:      1      P10   110
20:      2      P10   210
21:      1      P11  -111
22:      2      P11  -211
23:      1      P12   112
24:      2      P12   212
    Acc_ID variable value

variable 已经是一个因子，级别按从左到右的顺序排列。但是，为了与锚点进行比较，variable 已经变成了ordered factor。这样，列就可以任意命名了，只是列的顺序很重要。

str(long)

Classes ‘data.table’ and 'data.frame':    24 obs. of  3 variables:
 $ Acc_ID  : int  1 2 1 2 1 2 1 2 1 2 ...
 $ variable: Ord.factor w/ 12 levels "P1"<"P2"<"P3"<..: 1 1 2 2 3 3 4 4 5 5 ...
 $ value   : num  -101 -201 102 202 -103 -203 104 204 -105 -205 ...
 - attr(*, ".internal.selfref")=<externalptr>

在可变长度窗口上聚合

OP 已请求计算不同窗口大小上的聚合，所有这些都以锚点结尾：

长度 1，仅包括锚点的列
长度为 3，包括锚点左侧的两列和锚点所在的列。这将在锚点 P1 和 P2 的情况下被跳过，因为列太少，无法完成一组三个。
长度为6，包括锚点左侧的五列和锚点所在的列。这只能为列P6、P7 等计算，这些列有完整的六列集合。
长度为 12，包括所有列，只能为锚点 P12 计算。

虽然 OP 没有明确提到，但可以通过使用 rowSums() 得出结论，必须分别为每一行计算聚合。在这里，我们假设Acc_ID 唯一标识每一行。

library(magrittr)
anchor <- "P5"
lapply(c(1, 3, 6, 12), 
       function(x) {
         long[variable <= anchor, 
              if (x <= .N) 
                .(sum(tail(value, x)), sum(tail(value, x) > 0)) %>% 
                  setNames(sprintf(c("sumcoll%im", "payments%im"), x)),
              by = Acc_ID]
         }
) %>% 
  Reduce(function(x, y) merge(x, y, by = "Acc_ID", all.x = TRUE), .)

   Acc_ID sumcoll1m payments1m sumcoll3m payments3m
1:      1      -105          0      -104          1
2:      2      -205          0      -204          1

说明

请注意，尽管数据已被重新调整为长格式，但术语列用于指代宽格式的数据。

第 1 行：管道用于提高代码的可读性
第 2 行：设置锚列名称
第 3 行：循环窗口大小，以列表形式返回结果
第 5 行：仅选择锚列左侧或等于锚列的列名。这是可行的，因为我们使用的是有序因子。
第 6 行：如果给定窗口大小的可用数据太少，则跳过
第 7 行：计算聚合，但仅适用于 x-last 列，使用 tail(value, x)
第 8 行：适当地命名结果
第 9 行：按 Acc_ID 分组，即逐行
第12行：重复合并列表元素得到一个结果data.table

在将各个部分合并在一起之前，lapply() 调用的输出如下所示：

[[1]]
   Acc_ID sumcoll1m payments1m
1:      1      -105          0
2:      2      -205          0

[[2]]
   Acc_ID sumcoll3m payments3m
1:      1      -104          1
2:      2      -204          1

[[3]]
Empty data.table (0 rows) of 1 col: Acc_ID

[[4]]
Empty data.table (0 rows) of 1 col: Acc_ID

演示其他锚点的函数调用

为方便起见，可以将其包装在函数调用中：

anchored_aggregate <- function(DT, anchor) {
  library(data.table)
  library(magrittr)
  long <- melt(DT, "Acc_ID")
  long[, variable := as.ordered(variable)]
  lapply(c(1, 3, 6, 12), 
         function(x) {
           long[variable <= anchor, 
                if (x <= .N) 
                  .(sum(tail(value, x)), sum(tail(value, x) > 0)) %>% 
                  setNames(sprintf(c("sumcoll%im", "payments%im"), x)),
                by = Acc_ID]
         }
  ) %>% 
    Reduce(function(x, y) merge(x, y, by = "Acc_ID", all.x = TRUE), .)
  }

anchored_aggregate(DT, "P2")

   Acc_ID sumcoll1m payments1m
1:      1       102          1
2:      2       202          1

anchored_aggregate(DT, "P3")

   Acc_ID sumcoll1m payments1m sumcoll3m payments3m
1:      1      -103          0      -102          1
2:      2      -203          0      -202          1

anchored_aggregate(DT, "P7")

   Acc_ID sumcoll1m payments1m sumcoll3m payments3m sumcoll6m payments6m
1:      1      -107          0      -106          1        -3          3
2:      2      -207          0      -206          1        -3          3

anchored_aggregate(DT, "P12")

   Acc_ID sumcoll1m payments1m sumcoll3m payments3m sumcoll6m payments6m sumcoll12m payments12m
1:      1       112          1       111          2         3          3          6           6
2:      2       212          1       211          2         3          3          6           6

将聚合应用到原始数据集

OP 已询问如何将聚合结果附加到原始数据集。

这可以通过另一个连接操作来完成，例如，使用上面创建的函数：

DT[anchored_aggregate(DT, "P5"), on = "Acc_ID"]

   Acc_ID   P1  P2   P3  P4   P5  P6   P7  P8   P9 P10  P11 P12 sumcoll1m payments1m sumcoll3m payments3m
1:      1 -101 102 -103 104 -105 106 -107 108 -109 110 -111 112      -105          0      -104          1
2:      2 -201 202 -203 204 -205 206 -207 208 -209 210 -211 212      -205          0      -204          1

【讨论】：

非常漂亮和优雅的方法。你肯定证明我错了。对于最终结果，我将对其进行调整以处理自定义间隔和熔体中的多个 measure.var，但核心正是我想要的。非常感谢！

【解决方案2】：

这是一种不同的方法，它适用于列数据，但对有序因子和tail() 与in this answer 使用相同的技巧。 .SDcols 参数用于选择所需的列。

但是，没有必要将数据从宽格式转换为长格式。此外，这种方法会立即更新 DT by reference，因此不需要最终连接。

library(data.table)
# prepare sample data set
n_row <- 2
DT <- data.table(Acc_ID = seq_len(n_row))
for (i in 1:12) {
  set(DT, , paste0("P", i), (100*seq_len(n_row) + i) * (-1)^i)
}
# preserve unmodified copy of original dataset
DT0 <- copy(DT)

# create vector of data column names as ordered factor in order of appearance
library(magrittr)
nam_DT <- 
  # omit id column
  colnames(DT)[-1] %>% 
  forcats::fct_inorder(ordered = TRUE)

anchor <- "P5"

# start with fresh copy of original dataset
DT <- copy(DT0)
# loop ovder window sizes
lapply(c(1, 3, 6, 12),
       function(x) {
         # create character vector of columns to process
         cols <- nam_DT[nam_DT <= anchor] %>% 
           tail(x) %>% 
           as.character()
         # skip if too few columns available
         if (length(cols) == x) {
           # compute aggregates and update by reference
           DT[, sprintf(c("sumcoll%im", "payments%im"), x) := 
                .(rowSums(.SD), rowSums(.SD > 0)), .SDcols = cols]
         }
       # suppress intermediate results
       }) %>% invisible()
# print updated dataset
DT[]

   Acc_ID   P1  P2   P3  P4   P5  P6   P7  P8   P9 P10  P11 P12 sumcoll1m payments1m sumcoll3m payments3m
1:      1 -101 102 -103 104 -105 106 -107 108 -109 110 -111 112      -105          0      -104          1
2:      2 -201 202 -203 204 -205 206 -207 208 -209 210 -211 212      -205          0      -204          1

比较：

DT[anchored_aggregate(DT, "P5"), on = "Acc_ID"]

   Acc_ID   P1  P2   P3  P4   P5  P6   P7  P8   P9 P10  P11 P12 sumcoll1m payments1m sumcoll3m payments3m
1:      1 -101 102 -103 104 -105 106 -107 108 -109 110 -111 112      -105          0      -104          1
2:      2 -201 202 -203 204 -205 206 -207 208 -209 210 -211 212      -205          0      -204          1

【讨论】：

也很整洁！