如何解决在子组内使用单一的、特定于组的通用基线进行计算累计
我正在寻找最好使用 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],...
)
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。