(1-previous_record)*current_record 的累积乘积

Posted 2023-02-22

【中文标题】(1-previous_record)*current_record 的累积乘积

【英文标题】：Cumulative product of (1-previous_record)*current_record

【发布时间】：2020-11-12 15:31:11

【问题描述】：

数据框包含两个变量（time 和 rate）和 10 个观测值

time <- seq(1:10) 
rate <- 1-(0.99^time)
dat <- data.frame(time, rate)

我需要添加一个新列（称为new_rate）。

new_rate定义如下

注意：new_rate_1 是 new 列 new_rate 等的第一次观察。

new_rate_1 = rate_1
new_rate_2 = (1-rate_1)*rate_2
new_rate_3 = (1-rate_1)*(1-rate_2)*rate_3
new_rate_4 = (1-rate_1)*(1-rate_2)*(1-rate_3)*rate_4
...
new_rate_10 = (1-rate_1)*(1-rate_2)*(1-rate_3)*(1-rate_4)*(1-rate_5)*(1-rate_6)*(1-rate_7)*(1-rate_8)*(1-rate_9)*rate_10

如何在 base R 或 dplyr 中做到这一点？

【参考方案1】：

cumprod 救援（向@Cole 致敬以简化代码）：

dat$rate * c(1, cumprod(1 - head(dat$rate, -1)))

逻辑是，您实际上是在做 1 - dat$rate 的 cumulative product 乘以当前步骤。 第一步，你可以只保留现有的值，但是你需要偏移两个向量，以便相乘得到想要的结果。

证明：

out <- c(
dat$rate[1],
(1-dat$rate[1])*dat$rate[2],
(1-dat$rate[1])*(1-dat$rate[2])*dat$rate[3],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*dat$rate[4],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*dat$rate[5],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*(1-dat$rate[5])*dat$rate[6],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*(1-dat$rate[5])*(1-dat$rate[6])*dat$rate[7],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*(1-dat$rate[5])*(1-dat$rate[6])*(1-dat$rate[7])*dat$rate[8],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*(1-dat$rate[5])*(1-dat$rate[6])*(1-dat$rate[7])*(1-dat$rate[8])*dat$rate[9],
(1-dat$rate[1])*(1-dat$rate[2])*(1-dat$rate[3])*(1-dat$rate[4])*(1-dat$rate[5])*(1-dat$rate[6])*(1-dat$rate[7])*(1-dat$rate[8])*(1-dat$rate[9])*dat$rate[10]
)

all.equal(
  dat$rate * c(1, cumprod(1 - head(dat$rate, -1))),
  out
)
#[1] TRUE

【参考方案2】：

使用cumprod 的简单数学方法应该可以工作

> c(1, head(cumprod(1 - rate), -1)) * rate
 [1] 0.01000000 0.01970100 0.02881885 0.03709807 0.04432372 0.05033049
 [7] 0.05500858 0.05830607 0.06022773 0.06083074

---

如果你想练习递归，可以试试下面的方法

f <- function(v, k = length(v)) 
    if (k == 1) 
        return(v[k])
    
    u <- f(v, k - 1)
    c(u, tail(u, 1) * (1 / v[k - 1] - 1) * v[k])

这样

> f(rate)
 [1] 0.01000000 0.01970100 0.02881885 0.03709807 0.04432372 0.05033049
 [7] 0.05500858 0.05830607 0.06022773 0.06083074

【讨论】：

对我来说这种方法是最好的。简单直接。不用说已经 +1了

但我还没有回答这个问题！ :D

@AnilGoyal 哈哈，我的错。我把 Anoushiravan R 的答案当作你的答案

@AnilGoyal 如果您对这个问题有任何想法，欢迎随时分享您的答案：P

我会使用cumprod() 的方式来解决这个问题。这就是为什么我喜欢你的。 :)

【参考方案3】：

如果您仍然对如何使用 purrr::reduce 系列函数感兴趣。这里有两个解决方案：

在每次迭代中，如果将累积/前一个值乘以（1/前一个速率值 - 1）*（当前速率值），您将在每一行中获得所需的输出

library(purrr)

accumulate2(dat$rate[-nrow(dat)], dat$rate[-1], .init = dat$rate[1], 
           ~ ..1 * (1/..2 - 1) * ..3) %>%
  simplify()

 [1] 0.01000000 0.01970100 0.02881885 0.03709807 0.04432372 0.05033049 0.05500858 0.05830607
 [9] 0.06022773 0.06083074

在 base R 中，我们还可以执行以下操作：

Reduce(function(x, y) 
  x * (1/dat$rate[y - 1] - 1) * dat$rate[y]
, init = dat$rate[1], 
seq_len(nrow(dat))[-1], accumulate = TRUE)

 [1] 0.01000000 0.01970100 0.02881885 0.03709807 0.04432372 0.05033049 0.05500858 0.05830607
 [9] 0.06022773 0.06083074