跨列的条件滚动总和

Question

我有一个跨连续年份（列）的值的数据框，用于唯一个体（行）。此处提供了一个虚拟数据示例：

dt = structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), `2015` = c(0, 
0.8219178, 0, 0.1369863, 0, 1.369863, 0.2739726, 0.8219178, 5, 
0), `2016` = c(0, 1.369863, 0, 0.2739726, 0, 0.2739726, 0, 3.2876712, 
0, 0), `2017` = c(0.6849315, 0, 0, 0.6849315, 0, 0.5479452, 0, 
0, 0, 0), `2018` = c(1.0958904, 0.5479452, 1.9178082, 0, 0, 0, 
0, 0, 0, 3), `2019` = c(0, 0, 0, 1.0958904, 0, 0.9589041, 0.5479452, 
0, 0, 0), `2020` = c(0.4383562, 0, 0, 0, 0.2739726, 0.6849315, 
0, 0, 0, 0)), class = c("tbl_df", "tbl", "data.frame"), row.names = c(NA, 
-10L))

我想创建一个数据集，其中每个人每年应该出现的最大值为 1。如果超过这个值，我想将超过 1 的值结转到下一年（列) 并将其与当年每个人的价值相加，依此类推。

预期结果是：

dt_expected = structure(list(ID = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), `2015` = c(0, 
0.8219178, 0, 0.1369863, 0, 1, 0.2739726, 0.8219178, 1, 0), `2016` = c(0, 
1, 0, 0.2739726, 0, 0.6438356, 0, 1, 1, 0), `2017` = c(0.6849315, 
0.369863, 0, 0.6849315, 0, 0.5479452, 0, 1, 1, 0), `2018` = c(1, 
0.5479452, 1, 0, 0, 0, 0, 1, 1, 1), `2019` = c(0.0958904, 0, 
0.9178082, 1, 0, 0.9589041, 0.5479452, 0.2876712, 1, 1), `2020` = c(0.4383562, 
0, 0, 0.0958904, 0.2739726, 0.6849315, 0, 0, 0, 1)), class = c("tbl_df", 
"tbl", "data.frame"), row.names = c(NA, -10L))

我完全不知道从哪里开始解决这个问题，因此非常感谢使用 data.table 实现此目的的任何帮助。我唯一的想法是对条件组件使用 lapply 和 ifelse 函数。那么我应该使用 rowSums 还是 Reduce 来实现跨列移动多余值的结果？

Answer 1

不是特别漂亮或高效，但作为起点，我使用 pmin() 和 pmax() 每年（以及随后的一年）迭代更新。当前年份为当前年份和1(pmin(x, 1))中的最小值；下一年是当前下一年加上上一年的超出部分(pmax(x - 1, 0))

update <- function(df) {
    result = df
    for (idx in 2:(ncol(df) - 1)) {
        x = result[[ idx ]]
        result[[ idx ]] = pmin(x, 1)
        result[[ idx + 1 ]] = result[[ idx + 1 ]] + pmax(x - 1, 0)
    }
    result
}

我们有

> all.equal(update(dt), dt_expected)
[1] TRUE

我不知道如何将其转化为有效的 data.table 语法，但是 'works' 函数在 data.table、update(as.data.table(dt)).[=17 上=]

Answer 2

不确定是否有更有效的内置函数方法，但我只是编写了一个递归函数来实现您描述的行算法，然后将其应用于每一行。

f <- function(l, rest = 0, out = list()) {
  if (length(l) == 0) return(unlist(out))
  if (l[[1]] + rest <= 1) {
    f(l[-1], rest = 0, out = append(out, list(l[[1]] + rest)))
  } else (
    f(l[-1], rest = l[[1]] + rest - 1, out = append(out, list(1)))
  )
}

dt[-1] <- apply(dt[-1], 1, f, simplify = F) |> 
  do.call(what = rbind)

dt
#> # A tibble: 10 × 7
#>       ID `2015` `2016` `2017` `2018` `2019` `2020`
#>    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
#>  1     1  0      0      0.685  1     0.0959 0.438 
#>  2     2  0.822  1      0.370  0.548 0      0     
#>  3     3  0      0      0      1     0.918  0     
#>  4     4  0.137  0.274  0.685  0     1      0.0959
#>  5     5  0      0      0      0     0      0.274 
#>  6     6  1      0.644  0.548  0     0.959  0.685 
#>  7     7  0.274  0      0      0     0.548  0     
#>  8     8  0.822  1      1      1     0.288  0     
#>  9     9  1      1      1      1     1      0     
#> 10    10  0      0      0      1     1      1

^{由 reprex package (v2.0.1)}

于 2022-03-25 创建

Answer 3

Martin Morgan 对 data.table 的回答的翻译：

for (i in 2:(ncol(dt) - 1)) {
  x = dt[[i]]
  set(dt, j = i, value = pmin(x, 1))
  set(dt, j = i + 1, value = dt[[i + 1L]] + pmax(x - 1, 0))
}

Answer 4

这是我的解决方案：

dt |>
  pivot_longer(cols = -ID, "year") |>
  arrange(ID, year) |>
  group_by(ID) |>
  mutate(x = {
    r <- accumulate(value,
                    ~max(0,.y + .x - 1),
                    .init = 0)
    pmin(1, value + head(r, -1))
  }) |>
  select(x, year, ID) |>
  pivot_wider(names_from = "year", values_from = "x")

##> + # A tibble: 10 × 7
##> # Groups:   ID [10]
##>       ID `2015` `2016` `2017` `2018` `2019` `2020`
##>    <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
##>  1     1  0      0      0.685  1     0.0959 0.438 
##>  2     2  0.822  1      0.370  0.548 0      0     
##>  3     3  0      0      0      1     0.918  0     
##>  4     4  0.137  0.274  0.685  0     1      0.0959
##>  5     5  0      0      0      0     0      0.274 
##>  6     6  1      0.644  0.548  0     0.959  0.685 
##>  7     7  0.274  0      0      0     0.548  0     
##>  8     8  0.822  1      1      1     0.288  0     
##>  9     9  1      1      1      1     1      0     
##> 10    10  0      0      0      1     1      1

跨列的条件滚动总和

Conditional rolling sum across columns

r

dataframe

data.table

lapply

rowsum