Eri*_*ail 7 r percentage dplyr mutate tibble
我正在寻找一种方法,在 id 和组中,使用 100 的滞后(或领先) value和新索引号idx_value来计算下一个索引号。
# install.packages(c("tidyverse"), dependencies = TRUE)
library(tibble)
library(magrittr)
Run Code Online (Sandbox Code Playgroud)
就像,我有这个数据框:
start_tbl <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L), grp = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L,
1L, 1L, 2L, 2L, 2L), year = c(7L, 8L, 9L, 10L, 7L, 8L, 9L, 10L,
7L, 8L, 9L, 7L, 8L, 9L), value = c(2, -7, -2.3, 1.1, -1, -12,
-4, 2, 1, -3, 2, -1, -4, -2)), row.names = c(NA, -14L), class = c("tbl_df",
"tbl", "data.frame"))
start_tbl
# A tibble: 14 x 4
id grp year value
<int> <int> <int> <dbl>
1 1 1 7 2
2 1 1 8 -7
3 1 1 9 -2.3
4 1 1 10 1.1
5 1 2 7 -1
6 1 2 8 -12
7 1 2 9 -4
8 1 2 10 2
9 2 1 7 1
10 2 1 8 -3
11 2 1 9 2
12 2 2 7 -1
13 2 2 8 -4
14 2 2 9 -2
Run Code Online (Sandbox Code Playgroud)
现在我想取 id 1 grp 1 并制作索引,然后将 id 1 grp 1 year 7 计算为 100*(1+-7/100) = 93.0,接下来使用该结果 93 来计算下一年:93 *(1+-2.3/100)= 90.861,依此类推。在所有索引年重新开始,这是一个新的 id 和一个新的 grp 和基准年 7。
我非常接近:
tbl %>% group_by(id) %>% mutate(idx_value = value-lag(value), idx_value = 100*(1+value/100) )
# A tibble: 14 x 5
# Groups: id [2]
id grp year value idx_value
<int> <int> <int> <dbl> <dbl>
1 1 1 7 2 102
2 1 1 8 -7 93
3 1 1 9 -2.3 97.7
4 1 1 10 1.1 101.
5 1 2 7 -1 99
6 1 2 8 -12 88
7 1 2 9 -4 96
8 1 2 10 2 102
9 2 1 7 1 101
10 2 1 8 -3 97
11 2 1 9 2 102
12 2 2 7 -1 99
13 2 2 8 -4 96
14 2 2 9 -2 98
Run Code Online (Sandbox Code Playgroud)
但我想要的是:
end_tbl <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L,
2L, 2L, 2L, 2L), grp = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L,
1L, 1L, 2L, 2L, 2L), year = c(7L, 8L, 9L, 10L, 7L, 8L, 9L, 10L,
7L, 8L, 9L, 7L, 8L, 9L), value = c(2, -7, -2.3, 1.1, -1, -12,
-4, 2, 1, -3, 2, -1, -4, -2), idx_value = c(100L, 93L, 91L, 92L,
100L, 88L, 84L, 86L, 100L, 97L, 99L, 100L, 96L, 94L)), row.names = c(NA,
-14L), class = c("tbl_df", "tbl", "data.frame"))
end_tbl
# A tibble: 14 x 5
id grp year value idx_value
<int> <int> <int> <dbl> <int>
1 1 1 7 2 100
2 1 1 8 -7 93
3 1 1 9 -2.3 91
4 1 1 10 1.1 92
5 1 2 7 -1 100
6 1 2 8 -12 88
7 1 2 9 -4 84
8 1 2 10 2 86
9 2 1 7 1 100
10 2 1 8 -3 97
11 2 1 9 2 99
12 2 2 7 -1 100
13 2 2 8 -4 96
14 2 2 9 -2 94
Run Code Online (Sandbox Code Playgroud)
任何帮助表示赞赏。也许答案就在这里。
start_tbl2来说明问题。如果我使用start_tbl2如下所示的起始标题 start_tbl2 <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L),
grp = c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L),
year = c(7L, 8L, 9L, 10L, 7L, 8L, 9L, 10L),
value = c(2, -12, -18.3, 100, 15, 30, 40, -50)),
row.names = c(NA, -8L), class = c("tbl_df", "tbl", "data.frame"))
library(dplyr)
start_tbl2 %>%
group_by(id, grp) %>%
mutate(idx_value = c(100, round(100 * (1 + cumsum(value[-1])/100))))
# A tibble: 8 x 5
# Groups: id, grp [2]
id grp year value idx_value
<int> <int> <int> <dbl> <dbl>
1 1 1 7 2 100
2 1 1 8 -12 88
3 1 1 9 -18.3 70
4 1 1 10 100 170
5 1 2 7 15 100
6 1 2 8 30 130
7 1 2 9 40 170
8 1 2 10 -50 120
Run Code Online (Sandbox Code Playgroud)
而当我手动计算时我得到了这个:
Percentage_change cal_by_hand cumsum diff
2 100 100 0
-12 88 88 0
-18.3 71.896 70 1.896
100 143.792 170 -26.208
15 100 100 0
30 130 130 0
40 182 170 12
-50 91 120 -29
Run Code Online (Sandbox Code Playgroud)
cumprod()另一种方法是将值转换为百分比后使用:
library(dplyr)
start_tbl %>%
group_by(id, grp) %>%
mutate(idx_value = cumprod(c(100, (100 + value[-1]) / 100)))
# A tibble: 14 x 5
# Groups: id, grp [4]
id grp year value idx_value
<int> <int> <int> <dbl> <dbl>
1 1 1 7 2 100
2 1 1 8 -7 93
3 1 1 9 -2.3 90.9
4 1 1 10 1.1 91.9
5 1 2 7 -1 100
6 1 2 8 -12 88
7 1 2 9 -4 84.5
8 1 2 10 2 86.2
9 2 1 7 1 100
10 2 1 8 -3 97
11 2 1 9 2 98.9
12 2 2 7 -1 100
13 2 2 8 -4 96
14 2 2 9 -2 94.1
Run Code Online (Sandbox Code Playgroud)
基于新数据集
library(purrr)
library(dplyr)
start_tbl2 %>%
group_by(id, grp) %>%
mutate(idx_vlue = accumulate(value[-1], ~ .x * (1 + .y/100), .init = 100 ))
# A tibble: 8 x 5
# Groups: id, grp [2]
# id grp year value idx_vlue
# <int> <int> <int> <dbl> <dbl>
#1 1 1 7 2 100
#2 1 1 8 -12 88
#3 1 1 9 -18.3 71.9
#4 1 1 10 100 144.
#5 1 2 7 15 100
#6 1 2 8 30 130
#7 1 2 9 40 182
#8 1 2 10 -50 91
Run Code Online (Sandbox Code Playgroud)
并使用'start_tbl
start_tbl %>%
group_by(id, grp) %>%
mutate(idx_vlue = accumulate(value[-1], ~ .x * (1 + .y/100), .init = 100 ))
# A tibble: 14 x 5
# Groups: id, grp [4]
# id grp year value idx_vlue
# <int> <int> <int> <dbl> <dbl>
# 1 1 1 7 2 100
# 2 1 1 8 -7 93
# 3 1 1 9 -2.3 90.9
# 4 1 1 10 1.1 91.9
# 5 1 2 7 -1 100
# 6 1 2 8 -12 88
# 7 1 2 9 -4 84.5
# 8 1 2 10 2 86.2
# 9 2 1 7 1 100
#10 2 1 8 -3 97
#11 2 1 9 2 98.9
#12 2 2 7 -1 100
#13 2 2 8 -4 96
#14 2 2 9 -2 94.1
Run Code Online (Sandbox Code Playgroud)