Накопительные депозиты с фиксированной ставкой

Question

Я пытаюсь смоделировать накопление биомассы из мертвой древесины, отложенной ежегодно. Древесина разлагается со скоростью 4,6% каждый год.

Мои данные отформатированы:

Кол-во: Лечение, Год, New.deposit Лечение (A, B, C ...) Год (0: 105) New.deposit (числовой)

В течение последних нескольких дней я пробовал комбинацию функций, которая выглядела примерно следующим образом, но в итоге получилась неправильная комбинация - возможно, я слишком усложняю:

#OBS! These code attempts are incorrect.
df <- df %>% group_by(Treatment) %>% mutate(Accumulated.deposits = cumsum(lag(New.deposit, n=1, default=0))*(1-0.046))

df <- df %>% group_by(Treatment) %>% mutate(Accumulated.deposits = cumsum((lag(Accumulated.deposits, n=1, default=0)*(1-0.046))) + new.deposit

My goal is to have one variable, Accumulated.biomass.yearY = deposit.year0 *  (1-0.046)^(Y) + deposit.year1 * (1-0.046)^(Y-1) + deposit.year2 * (1-0.046)^(Y-2)..... deposit.yearY * (1-0.046)^(Y-Y).

Мне бы хотелось, чтобы матрица показывала количество оставшейся биомассы от каждого годового депозита в год X.

Answer 1

Данные

set.seed(1)
df <- data.frame(treatment = rep(c('A','B'), each=5), years = rep(1:5, times=2), new_deposit=runif(10))

   treatment years new_deposit
1          A     1  0.26550866
2          A     2  0.37212390
3          A     3  0.57285336
4          A     4  0.90820779
5          A     5  0.20168193
6          B     1  0.89838968
7          B     2  0.94467527
8          B     3  0.66079779
9          B     4  0.62911404
10         B     5  0.06178627

Пользовательская функция

custom <- function(z, decay) { ans <- accumulate(z, function(x, y) { (x + y) * (1-decay) }, .init=0); tail(ans, -1) }

Функция будет принимать вектор z и скорость затухания decay, а при использовании purrr::accumulate будет рекурсивно применяться формула (x+y)*(1-decay), где x - это i-й элемент в векторе, а y является i+1 -ым элементом в векторе. Я дополняю вектор .init=0 начальным значением 0 и возвращаю ответ без заполнения tail(ans, -1).

Использование

df %>% 
  group_by(treatment) %>% 
  mutate(accumulated = custom(new_deposit, 0.046))

    treatment years new_deposit accumulated
   <fct>     <int>       <dbl>       <dbl>
 1 A             1      0.266        0.253
 2 A             2      0.372        0.597
 3 A             3      0.573        1.12
 4 A             4      0.908        1.93
 5 A             5      0.202        2.03
 6 B             1      0.898        0.857
 7 B             2      0.945        1.72
 8 B             3      0.661        2.27
 9 B             4      0.629        2.77
10 B             5      0.0618       2.70

Answer 2

Добро пожаловать в stackoverflow. Можете ли вы попробовать что-то подобное? Мне нравится разбивать шаги, чтобы было легче увидеть, что происходит. Если я не совсем понял, оставьте комментарий, и я обновлю свой ответ. Вы также можете использовать этот пример фрейма данных в своем вопросе и показать нам результат, который вы хотели бы видеть, чтобы мы могли следить за ним.

library(tidyverse)

df <-
  tibble(
    treatment = rep(LETTERS[1:2], 5),
    years = rep(0:4, each = 2),
    new_deposit = rep(1:5*10, each = 2)
  ) %>% 
  arrange(treatment, years, new_deposit)


df %>%
  arrange(treatment, years) %>%
  group_by(treatment) %>%
  mutate(
    prev_deposit = lag(new_deposit, default = 0),  
    running_sum = cumsum(prev_deposit),
    accumulated = running_sum * (1-0.046)^(years)
  ) %>% 
  ungroup()

#  treatment years new_deposit prev_deposit running_sum accumulated
#  <chr>     <int>       <dbl>        <dbl>       <dbl>       <dbl>
#  A             0          10            0           0        0   
#  A             1          20           10          10        9.54
#  A             2          30           20          30       27.3 
#  A             3          40           30          60       52.1 
#  A             4          50           40         100       82.8