问题描述
我正在寻找最好使用 tidyverse
的整洁解决方案这个问题与 this answer 一致，但它确实有一个额外的转折。我的数据有一个整体分组变量“grp”。在每个这样的组中，我想根据“试验”定义的子组内的累积总和（cumsum）进行计算，这里{{1} } 和 X。
但是，对于试验“X”和试验“Y”这两个子组内的计算，我需要使用单一的、特定于组的通用基线，即试验是 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,"X",2022,3,1,2023,4,"Y",5,6,'B',6) %>%
mutate(trial = factor(trial,levels = c("B","Y"))) %>%
arrange(grp,trial,yr)
，但我不能在 group_by() 上分组，因为我需要在计算“X”和“Y”时使用基线 trial ”。
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)
行 4-5 和 9-10 中，出于显而易见的原因，没有分别使用第 1 行和第 6 行作为基线。如图所示，
undesired_outcome_tidier_code我正在寻找一种解决方案，让我以一种整洁的方式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解决方法
添加 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,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
你可以试试这个。
-
calculate_value3是一个函数，它按照您的描述计算value3。它对trial的每个字母都执行此操作。它始终包括对基线的观察。字母是否与 X 和 Y 不同并不重要。请注意，baseline可以是您想要的任何字母，我现在将其设置为“B”。 - 在管道内部，您寻求
map-reduce解决方案。map将为每个唯一的calculate_value3运行trial函数，reduce将使用coalesce（将替换所有NA--> 这就是为什么我将v3初始化为NA中所有calculate_value3的向量）
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
该解决方案对试验的标识符很灵活，并且看起来相当容易调试和编辑（至少对我而言）。
,因为 tidyverse 似乎不是一个严格的要求，所以我借此机会建议一个 data.table 替代方案：
从“desired_outcome”数据开始，只是为了更容易比较结果：
library(data.table)
setDT(desired_outcome)
desired_outcome[,v3 := {
c(value1[1],sapply(c("X",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)，循环遍历 'trial' "X" 和 "Y" (sapply(c("X","Y"))。在 by (.SD) 定义的每个子数据集中，选择“trial”等于“B”或循环的当前值 (trial %in% c("B",g)) 的行。
进行计算（cumsum(value1) + cumsum(shift(value2,fill = 0)) 并删除第一个值（[-1]）。在每个“grp”中附加第一行，即对应于试验“B”的行（{{1} }).通过引用将结果赋值给一个新变量(c(value1[1],...)