对正或负“条纹”的值求和

Question

我正在使用 R 中的数据，如下图所示，查看每周的体重变化。

ID	Week	Weight Change
1	1	-0.5
1	2	-0.2
1	3	1
1	4	0.5
1	5	-0.5
2	1	-0.2
2	2	-0.2
2	3	0.6
2	4	-0.5
2	5	-0.3

输入是

df <- tibble(
  ID = c(rep(1,5), rep(2,5)),
  Week = rep(1:5,2),
  WeightChange = c(-0.5,-0.2,1,
                   0.5,-0.5,-0.2,-0.2,
                   0.6,-0.5,-0.3)
  )
)

我有兴趣尝试计算每个人的“连续”体重减轻或增加的数量以及每次连续的周数，类似于下表。我的 R 技能非常基础，所以我不确定从哪里开始。实际数据集包含约 75 名参与者的约 40 周数据。任何帮助将不胜感激。

ID	Streak Length	Weight Change
1	2	-0.7
1	2	1.5
1	1	-0.5
2	2	-0.4
2	1	0.6
2	2	-0.8

Answer 1

这样就可以了

df <- read.table(text = 'ID Week    WeightChange
1   1   -0.5
1   2   -0.2
1   3   1
1   4   0.5
1   5   -0.5
2   1   -0.2
2   2   -0.2
2   3   0.6
2   4   -0.5
2   5   -0.3', header = T)

library(tidyverse)
library(data.table)

df %>% group_by(ID, running_streak = rleid(WeightChange > 0)) %>%
  summarise(running_streak = n(),
            WeightChange = sum(WeightChange), .groups = 'drop')
#> # A tibble: 6 x 3
#>      ID running_streak WeightChange
#>   <int>          <int>        <dbl>
#> 1     1              2         -0.7
#> 2     1              2          1.5
#> 3     1              1         -0.5
#> 4     2              2         -0.4
#> 5     2              1          0.6
#> 6     2              2         -0.8

^{由reprex package (v2.0.0) 于 2021-05-10 创建}

由于几乎同时发布了类似的答案，因此可以使用 baseR rle 替代，即不使用 data.table

library(dplyr)

df %>% group_by(ID, running_streak = with(rle(WeightChange > 0), rep(seq_len(length(lengths)), lengths))) %>%
  summarise(running_streak = n(),
            WeightChange = sum(WeightChange), .groups = 'drop')
#> # A tibble: 6 x 3
#>      ID running_streak WeightChange
#>   <int>          <int>        <dbl>
#> 1     1              2         -0.7
#> 2     1              2          1.5
#> 3     1              1         -0.5
#> 4     2              2         -0.4
#> 5     2              1          0.6
#> 6     2              2         -0.8

^{由reprex package (v2.0.0) 于 2021-05-10 创建}

Answer 2

1) data.table/dplyr 按ID和streak分组（使用符号的rleid计算），汇总结果并丢弃我们不再需要的streak。 rleid 是 data.table 中唯一使用的函数。

library(data.table)
library(dplyr)

dat %>%
  group_by(ID, streak = rleid(sign(`Weight Change`))) %>%
  summarize(`Streak Length` = n(), `Weight Change` = sum(`Weight Change`), .groups = "drop") %>%
  select(-streak)

给予：

# A tibble: 6 x 3
     ID `Streak Length` `Weight Change`
  <int>           <int>           <dbl>
1     1               2            -0.7
2     1               2             1.5
3     1               1            -0.5
4     2               2            -0.4
5     2               1             0.6
6     2               2            -0.8

2) collapse/magrittr 我们可以交替使用 collapse 包和 magrittr。 groupid 类似于 data.table 中的 rleid。

library(collapse)
library(magrittr)

dat %>%
  tfm(streak = groupid(sign(`Weight Change`)), `Streak Length` = 1) %>%
  collap(~ ID + streak, fsum, cols = c("Weight Change", "Streak Length")) %>%
  slt(-streak)

给予：

  ID Weight Change Streak Length
1  1          -0.7             2
2  1           1.5             2
3  1          -0.5             1
4  2          -0.4             2
5  2           0.6             1
6  2          -0.8             2

3) data.table 仅使用 data.table 我们有：

as.data.table(dat)[, .(`Streak Length` = .N, `Weight Change` = sum(`Weight Change`)), 
  by = .(ID, rleid(sign(`Weight Change`)))][, -2]

给予：

   ID Streak Length Weight Change
1:  1             2          -0.7
2:  1             2           1.5
3:  1             1          -0.5
4:  2             2          -0.4
5:  2             1           0.6
6:  2             2          -0.8

注意

dat <- 
structure(list(ID = c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L), 
    Week = c(1L, 2L, 3L, 4L, 5L, 1L, 2L, 3L, 4L, 5L), `Weight Change` = c(-0.5, 
    -0.2, 1, 0.5, -0.5, -0.2, -0.2, 0.6, -0.5, -0.3)), class = "data.frame", row.names = c(NA, 
-10L))