web-dev-qa-db-ja.com

基準年と相対的なパーセンテージの変化でインデックスを計算する

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
7
Eric Fail

新しいデータセットに基づく

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
3
akrun

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