基準年と相対的なパーセンテージの変化でインデックスを計算する
Idとグループ内で、valueのラグ（またはリード）と新しいインデックス番号idx_valueを使用して100にインデックスを作成し、次のインデックス番号を計算する方法を探しています。
# install.packages(c("tidyverse"), dependencies = TRUE)
library(tibble)
library(magrittr)
同様に、私はこのデータフレームを持っています：
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
ここで、id 1 grp 1を取得してインデックスを作成し、次にid 1 grp 1年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
しかし、私が到達しようとしているのは：
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
どんな助けでも感謝します。多分 答えはここにあります 。
問題を説明するための小さな追加の小さなサンプルデータ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
これを手作業で計算すると、次のようになります。
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
新しいデータセットに基づく
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
そして '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
baseだけを使用して、少なくともこの2つの例で必要なデータフレームを返すこの関数を書きました。
addIdxValue <- function(X) {
idx <- function(y) {
u <- (100+c(0, y[-1]))/100
v <- 1
for (i in 1:(length(u)-1)) {
v[i+1] <- v[i]*u[i+1]
}
100*v
}
X[,"idx_values"] <- unlist(tapply(X[,4], list(X[,2], X[,1]), idx))
X
}
> addIdxValue(start_tbl)
id grp year value idx_values
1 1 1 7 2.0 100.00000
2 1 1 8 -7.0 93.00000
3 1 1 9 -2.3 90.86100
4 1 1 10 1.1 91.86047
5 1 2 7 -1.0 100.00000
6 1 2 8 -12.0 88.00000
7 1 2 9 -4.0 84.48000
8 1 2 10 2.0 86.16960
9 2 1 7 1.0 100.00000
10 2 1 8 -3.0 97.00000
11 2 1 9 2.0 98.94000
12 2 2 7 -1.0 100.00000
13 2 2 8 -4.0 96.00000
14 2 2 9 -2.0 94.08000
> addIdxValue(start_tbl2)
id grp year value idx_values
1 1 1 7 2.0 100.000
2 1 1 8 -12.0 88.000
3 1 1 9 -18.3 71.896
4 1 1 10 100.0 143.792
5 1 2 7 15.0 100.000
6 1 2 8 30.0 130.000
7 1 2 9 40.0 182.000
8 1 2 10 -50.0 91.000