对子组内的计算（cumsum）使用单一、通用的组特定基线

Question

我正在寻找一个整洁的解决方案，最好使用tidyverse

这个问题与this answer 一致，但它确实有一个额外的转折。我的数据有一个整体分组变量“grp”。在每个这样的组中，我想根据“试用”定义的子组中的累积总和（cumsum）执行计算，这里是X和@987654325 @。

但是，对于两个子组（试验“X”和试验“Y”）内的计算，我需要使用单一的、共同的组特定基线，即试验是 B。

我想要的结果是Value3在下面的数据集中desired_outcome：

# library(tidyverse)
# library(dplyr)
desired_outcome # see below I got this `desired_outcome`
# A tibble: 10 x 6
# Groups:   grp [2]
   grp   trial    yr value1 value2 Value3
   <chr> <fct> <dbl>  <dbl>  <dbl>  <dbl>
 1 A     B      2021      2      0      2
 2 A     X      2022      3      1      5
 3 A     X      2023      4      2     10
 4 A     Y      2022      5      3      7
 5 A     Y      2023      6      4     16
 6 B     B      2021      0      2      0
 7 B     X      2022      1      3      3
 8 B     X      2023      2      4      8
 9 B     Y      2022      3      5      5
10 B     Y      2023      4      6     14

我的最小工作示例。数据优先，

tabl <- tribble(~grp, ~trial, ~yr, ~value1, ~value2,
                'A', "B", 2021, 2, 0,
                'A', "X", 2022, 3, 1,
                'A', "X", 2023, 4, 2,
                'A', "Y", 2022, 5, 3,
                'A', "Y", 2023, 6, 4,
                'B', "B", 2021, 0, 2,
                'B', "X", 2022, 1, 3,
                'B', "X", 2023, 2, 4,
                'B', "Y", 2022, 3, 5,
                'B', "Y", 2023, 4, 6) %>% 
 mutate(trial = factor(trial, levels = c("B", "X", "Y"))) %>% 
  arrange(grp, trial, yr) 

现在，我需要使用 group_by()，但我无法在 trial 上进行分组，因为我需要在计算“X”和“Y”时使用基线 B。

undesired_outcome_tidier_code <- tabl %>% 
  group_by(grp) %>% # this do not work!
  mutate(Value1.1 = cumsum(value1),
         Value2.1 = lag(cumsum(value2), default = 0),
         Value3   = Value1.1 + Value2.1) %>% 
         select(-Value1.1, -Value2.1)

在undesired_outcome_tidier_code 中，第 4-5 行和第 9-10 行显然没有使用第 1 行和第 6 行作为基线。如图所示，

undesired_outcome_tidier_code
# A tibble: 10 x 6
# Groups:   grp [2]
   grp   trial    yr value1 value2 Value3
   <chr> <fct> <dbl>  <dbl>  <dbl>  <dbl>
 1 A     B      2021      2      0      2
 2 A     X      2022      3      1      5
 3 A     X      2023      4      2     10
 4 A     Y      2022      5      3     17
 5 A     Y      2023      6      4     26
 6 B     B      2021      0      2      0
 7 B     X      2022      1      3      3
 8 B     X      2023      2      4      8
 9 B     Y      2022      3      5     15
10 B     Y      2023      4      6     24

我正在寻找一个解决方案，让我以整洁的方式获得desired_outcome（见下文）。

在这个较小的示例中，我可以绕过它，找到我的desired_outcome，但这是一个麻烦两步解决方案。一定有更好/更整洁的方式。

step1 <- tabl  %>% arrange(grp, trial, yr)  %>% filter(trial  != 'Y') %>% 
  group_by(grp) %>% 
  mutate(Value1.1 = cumsum(value1),
         Value2.1 = lag(cumsum(value2), default = 0),
         Value3   = Value1.1 + Value2.1)

step2 <- tabl  %>% arrange(grp, trial, yr)  %>% filter(trial  != 'X') %>% 
  group_by(grp) %>% 
  mutate(Value1.1 = cumsum(value1),
         Value2.1 = lag(cumsum(value2), default = 0),
         Value3   = Value1.1 + Value2.1)
    
desired_outcome <- rbind(step1, 
      step2 %>% filter(trial  != 'B') 
                         ) %>% select(-Value1.1, -Value2.1) %>% arrange(grp, trial, yr) 

Answer 1

加上purrr，你可以这样做：

map(.x = c("X", "Y"),
    ~ tabl %>%
     arrange(grp, trial, yr) %>%
     filter(trial != .x) %>%
     group_by(grp) %>% 
     mutate(value3 = cumsum(value1) + lag(cumsum(value2), default = 0))) %>% 
 reduce(full_join) %>%
 arrange(grp, trial, yr) 

  grp   trial    yr value1 value2 value3
   <chr> <fct> <dbl>  <dbl>  <dbl>  <dbl>
 1 A     B      2021      2      0      2
 2 A     X      2022      3      1      5
 3 A     X      2023      4      2     10
 4 A     Y      2022      5      3      7
 5 A     Y      2023      6      4     16
 6 B     B      2021      0      2      0
 7 B     X      2022      1      3      3
 8 B     X      2023      2      4      8
 9 B     Y      2022      3      5      5
10 B     Y      2023      4      6     14

Answer 2

你可以试试这个。

• calculate_value3 是一个计算 value3 的函数，如您所述。它对trial 的每个字母都执行此操作。它总是包括对基线的观察。字母是否不同于 X 和 Y 都没关系。请注意，baseline 可以是您想要的任何字母，我现在将其设置为“B”。
• 在管道内部，您可以使用map-reduce 解决方案。 map 将为每个唯一的trial 运行函数calculate_value3，reduce 将它们与coalesce 一起设置（这将替换所有NAs --> 这就是为什么我将v3 初始化为calculate_value3 中所有 NAs 的向量）

calculate_value3 <- function(ut, # trial under examination
                             tr, # trial vector
                             v1, # value1 vector
                             v2, # value2 vector
                             baseline = "B"){ # baseline id
  
  v3      <- rep_len(NA, length(tr))
  ind     <- ut == tr | baseline == tr
  cumv1   <- cumsum(v1[ind]) 
  cumlv2  <- cumsum(lag(v2[ind], default = 0)) 
  v3[ind] <- cumv1 + cumlv2
  v3
  
}

library(purrr)
tabl %>% 
  group_by(grp) %>% 
  mutate(value3 = reduce(
    
    map(unique(trial), calculate_value3,
        tr = trial, v1 = value1, v2 = value2), 
    
    coalesce)) %>%
  ungroup()

#> # A tibble: 10 x 6
#>    grp   trial    yr value1 value2 value3
#>    <chr> <fct> <dbl>  <dbl>  <dbl>  <dbl>
#>  1 A     B      2021      2      0      2
#>  2 A     X      2022      3      1      5
#>  3 A     X      2023      4      2     10
#>  4 A     Y      2022      5      3      7
#>  5 A     Y      2023      6      4     16
#>  6 B     B      2021      0      2      0
#>  7 B     X      2022      1      3      3
#>  8 B     X      2023      2      4      8
#>  9 B     Y      2022      3      5      5
#> 10 B     Y      2023      4      6     14

该解决方案对试验的标识符很灵活，并且似乎相当容易调试和编辑，如果需要[至少对我来说]。

Answer 3

因为tidyverse 似乎不是一个严格的要求，所以我借此机会建议一个data.table 替代方案：

从“desired_outcome”数据开始，只是为了更容易比较结果：

library(data.table)
setDT(desired_outcome)

desired_outcome[ , v3 := {
  c(value1[1], sapply(c("X", "Y"), function(g){
    .SD[trial %in% c("B", g), (cumsum(value1) + cumsum(shift(value2, fill = 0)))[-1]]
  }))}, by = grp]

#     grp trial   yr value1 value2 Value3 v3
#  1:   A     B 2021      2      0      2  2
#  2:   A     X 2022      3      1      5  5
#  3:   A     X 2023      4      2     10 10
#  4:   A     Y 2022      5      3      7  7
#  5:   A     Y 2023      6      4     16 16
#  6:   B     B 2021      0      2      0  0
#  7:   B     X 2022      1      3      3  3
#  8:   B     X 2023      2      4      8  8
#  9:   B     Y 2022      3      5      5  5
# 10:   B     Y 2023      4      6     14 14

对于每个“grp”（by = grp），循环遍历“试用”“X”和“Y”（sapply(c("X", "Y")）。在by (.SD) 定义的每个子数据集中，选择“试用”等于“B”或循环当前值 (trial %in% c("B", g)) 的行。

进行计算 (cumsum(value1) + cumsum(shift(value2, fill = 0)) 并删除第一个值 ([-1])。在每个“grp”中附加第一行，即对应于试验“B”的行 (c(value1[1], ...)。分配结果通过引用到一个新变量 (v3 := )