Iai*_*man 13 r reset cumsum dplyr
我有一个数据框,数据框已按需要排序,但现在我想在组中"切片".
此组的最大累计值应为10.当累计值> 10时,它应重置累计总和并重新开始
library(dplyr)
id <- sample(1:15)
order <- 1:15
value <- c(4, 5, 7, 3, 8, 1, 2, 5, 3, 6, 2, 6, 3, 1, 4)
df <- data.frame(id, order, value)
df
Run Code Online (Sandbox Code Playgroud)
这是我正在寻找的输出(我是"手动"完成的)
cumsum_10 <- c(4, 9, 7, 10, 8, 9, 2, 7, 10, 6, 8, 6, 9, 10, 4)
group_10 <- c(1, 1, 2, 2, 3, 3, 4, 4, 4, 5, 5, 6, 6, 6, 7)
df1 <- data.frame(df, cumsum_10, group_10)
df1
Run Code Online (Sandbox Code Playgroud)
所以我遇到了两个问题
对于第一部分,我尝试了group_by和cumsum的一些组合而没有运气
df1 <- df %>% group_by(cumsum(c(False, value < 10)))
Run Code Online (Sandbox Code Playgroud)
我更喜欢管道(%>%)解决方案而不是for循环
谢谢
我认为这不容易矢量化......至少我不知道如何.
你可以by hand通过以下方式完成:
my_cumsum <- function(x){
grp = integer(length(x))
grp[1] = 1
for(i in 2:length(x)){
if(x[i-1] + x[i] <= 10){
grp[i] = grp[i-1]
x[i] = x[i-1] + x[i]
} else {
grp[i] = grp[i-1] + 1
}
}
data.frame(grp, x)
}
Run Code Online (Sandbox Code Playgroud)
对于您的数据,这给出:
> my_cumsum(df$value)
grp x
1 1 4
2 1 9
3 2 7
4 2 10
5 3 8
6 3 9
7 4 2
8 4 7
9 4 10
10 5 6
11 5 8
12 6 6
13 6 9
14 6 10
15 7 4
Run Code Online (Sandbox Code Playgroud)
同样对于我的"反例",这给出了:
> my_cumsum(c(10,6,4))
grp x
1 1 10
2 2 6
3 2 10
Run Code Online (Sandbox Code Playgroud)
正如@Khashaa所指出的,这可以通过更有效的方式实现Rcpp.他链接到这个答案如何加速或矢量化for循环?我觉得非常有用
对于这样的迭代计算,我们可以使用 package purrrfrom tidyverse。我们这里有一个函数accumulate,专门用于类似这样的情况。
library(dplyr)
library(purrr)
df %>% mutate(cumsum_10 = accumulate(value, ~ifelse(.x + .y <= 10, .x + .y, .y)),
group_10 = cumsum(value == cumsum_10))
id order value cumsum_10 group_10
1 8 1 4 4 1
2 13 2 5 9 1
3 7 3 7 7 2
4 1 4 3 10 2
5 4 5 8 8 3
6 10 6 1 9 3
7 12 7 2 2 4
8 2 8 5 7 4
9 15 9 3 10 4
10 11 10 6 6 5
11 14 11 2 8 5
12 3 12 6 6 6
13 5 13 3 9 6
14 9 14 1 10 6
15 6 15 4 4 7
Run Code Online (Sandbox Code Playgroud)
此外,这也可以使用基 R Reduce(注意此处的大写 R)通过设置其参数来获得accumulate = TRUE,该参数随后将返回所有中间值而不是仅返回最后一个值。
library(dplyr)
library(purrr)
df %>% mutate(cumsum_10 = accumulate(value, ~ifelse(.x + .y <= 10, .x + .y, .y)),
group_10 = cumsum(value == cumsum_10))
id order value cumsum_10 group_10
1 8 1 4 4 1
2 13 2 5 9 1
3 7 3 7 7 2
4 1 4 3 10 2
5 4 5 8 8 3
6 10 6 1 9 3
7 12 7 2 2 4
8 2 8 5 7 4
9 15 9 3 10 4
10 11 10 6 6 5
11 14 11 2 8 5
12 3 12 6 6 6
13 5 13 3 9 6
14 9 14 1 10 6
15 6 15 4 4 7
Run Code Online (Sandbox Code Playgroud)
您可以定义自己的函数,然后在 dplyr 的mutate语句中使用它,如下所示:
df %>% group_by() %>%
mutate(
cumsum_10 = cumsum_with_reset(value, 10),
group_10 = cumsum_with_reset_group(value, 10)
) %>%
ungroup()
Run Code Online (Sandbox Code Playgroud)
该cumsum_with_reset()函数采用一列和一个重置总和的阈值。 cumsum_with_reset_group()类似,但标识已分组在一起的行。定义如下:
# group rows based on cumsum with reset
cumsum_with_reset_group <- function(x, threshold) {
cumsum <- 0
group <- 1
result <- numeric()
for (i in 1:length(x)) {
cumsum <- cumsum + x[i]
if (cumsum > threshold) {
group <- group + 1
cumsum <- x[i]
}
result = c(result, group)
}
return (result)
}
# cumsum with reset
cumsum_with_reset <- function(x, threshold) {
cumsum <- 0
group <- 1
result <- numeric()
for (i in 1:length(x)) {
cumsum <- cumsum + x[i]
if (cumsum > threshold) {
group <- group + 1
cumsum <- x[i]
}
result = c(result, cumsum)
}
return (result)
}
# use functions above as window functions inside mutate statement
df %>% group_by() %>%
mutate(
cumsum_10 = cumsum_with_reset(value, 10),
group_10 = cumsum_with_reset_group(value, 10)
) %>%
ungroup()
Run Code Online (Sandbox Code Playgroud)
我们可以利用cumsumbinning包中的函数MESS来执行此任务:
library(MESS)
df %>%
group_by(group_10 = cumsumbinning(value, 10)) %>%
mutate(cumsum_10 = cumsum(value))
Run Code Online (Sandbox Code Playgroud)
输出
# A tibble: 15 x 5
# Groups: group_10 [7]
id order value group_10 cumsum_10
<int> <int> <dbl> <int> <dbl>
1 6 1 4 1 4
2 10 2 5 1 9
3 1 3 7 2 7
4 5 4 3 2 10
5 3 5 8 3 8
6 9 6 1 3 9
7 14 7 2 4 2
8 11 8 5 4 7
9 15 9 3 4 10
10 8 10 6 5 6
11 12 11 2 5 8
12 2 12 6 6 6
13 4 13 3 6 9
14 7 14 1 6 10
15 13 15 4 7 4
Run Code Online (Sandbox Code Playgroud)