Question

我在dplyr管道的中间有一些资产数据，如下所示：

fcast <- data.frame(group = rep(c('a','b'),each=12),
                yr = rep(2018:2019,each=6,times=2),
                mo = rep(c(7:12,1:6),times=2),
                book_value = c(10000,rep(0,times=11),15000,rep(0,times=11)),
                accum_depr = c(200,rep(0,times=11),700,rep(0,times=11)),
                depr_rate = .02,
                depr_expense = c(10,rep(0,times=11),15,rep(0,times=11)),
                book_addn = c(0,0,0,0,80,0,0,40,0,0,0,0,0,0,100,70,0,0,0,0,0,0,0,0),
                book_growth = 1.01
                )

我需要对每个tidy应用一些滚动功能（最好是group），就像下面的滚动功能一样，此功能目前不起作用。

roll_depr <- function(.data) {
   r_d <- .data$depr_rate[1]
   r_g <- .data$book_growth[1]

   for(i in 2:length(.data$depreciation_rate)) {
      .data$book_value[i] <- .data$book_value[i-1]*r_g + .data$book_addn[i]
      .data$depr_expense[i] <- (.data$book_value[i] - .data$accum_depr[i-1])*r_d
      .data$accum_depr[i] <- .data$accum_depr[i-1]+.data$depr_expense[i]
   }
   return(.data)
}

为了进一步使事情复杂化，当用户输入shiny的新值时，将在book_addn仪表板中重复执行此计算。实际的数据集要大得多，for循环不会剪切它。

我知道data.table或apply必须存在一个更好的解决方案，但我一直无法弄清楚。如果可以在管道内完成，则可以加分！

编辑：我希望代码输出下表。基本上，book_value会以先前值的1％增长，并在此期间增加任何值。 depr_expense取上一个book_value的{{1}}净值，然后乘以accum_depr。最后，depr_rate会更新以计算新计算的accum_depr。

depr_expense

Answer 1

实际上，这可以通过实现for循环的两个简单函数并在mutate中使用它们来以相当快的速度完成。

关键是要认识到book_value可以在其自己的循环中独立计算。一旦完成，accum_depr[i]只是accum_depr[i-1]和book_value[i]的功能。可以将depr_expense提取为accum_depr及其滞后时间之间的差异，但是出于我的目的，我不需要它。

expn[i] = (book[i] - accum_depr[i-1])*depr_rate
accum_depr[i] = accum_depr[i-1] + expn[i]

这暗示

accum_depr[i] = accum_depr[i-1]*(1-depr_rate) + book_value[i]*depr_rate

代码：

roll_book <- function(book_val,addn,g_rate) {
  z <- rep(0,length(book_val))
  z[1] <- book_val[1]
  for(i in 2:length(book_val)) {
    z[i] <- z[i-1]*g_rate[1] + addn[i]
  }
  return(z)
}

roll_depr <- function(accum_depr,book_val,depr_rate) {
  r_d <- depr_rate[1]
  z <- rep(0, length(accum_depr))
  z[1] <- accum_depr[1]
  for(i in 2:length(accum_depr)) {
    z[i] <- book_val[i]*r_d + z[i-1]*(1-r_d)
  }
  return(z)
}

fcast <- fcast %>% 
  group_by(group) %>% 
  mutate(book_value = roll_book(book_value,book_addn,book_growth),
         accum_depr = roll_depr(accum_depr,book_value,depr_rate))

在具有约110,000行和约450组的数据集上：

Unit: milliseconds
      min       lq     mean   median       uq      max neval
 65.01492 67.14825 70.80178 69.85741 72.53611 98.75224   100

R：按组的有效滚动计算

1 个答案: