R：递归添加行

Question

j 次表面接触后手的细菌浓度可由以下递归关系决定：

H[j+1]=H[j]+T[j]*(S[j]-H[j])

其中 S 是手触摸的表面浓度（为方便起见，假设是随机的）。 T 是每个联系人的传输效率。我想计算最终的手浓度（起始浓度为零）。

我有一个数据框，其中包含表面接触矢量和每个表面的传输效率。我有两组 a & b 并且在每组中假设我将按顺序触摸每个 1:length(df):

 df <- data.frame(S = runif(10)*100, T = runif(10),g=rep(c("a","b"),each=5))

我想尽可能使用 dplyr 按组计算 H 的累计总和。

特例：

如果g = "a"，H的起始值为0。如果 g=="b" 则 H 的起始值是 g=="a"

时的最后一个值

Answer 1

这是我将用于此问题的另一个通用版本：

df$H <- Reduce(function(x, y) {
  x + df$T[y] * (df$g[y] == df$g[y + 1]) * (df$S[y] - x) 
}, init = 0,
seq_len(nrow(df))[-nrow(df)], accumulate = TRUE)

df

           S         T g        H
1  37.698250 0.8550377 a  0.00000
2   3.843585 0.4722659 a 32.23342
3  33.150788 0.3684791 a 18.82587
4   8.948116 0.8893603 a 24.10430
5  57.061844 0.5452377 a 10.62499
6  49.648827 0.7719067 b 10.62499
7  95.403697 0.5835950 b 40.74775
8  10.598677 0.1220491 b 72.64469
9  91.913365 0.2166443 b 65.07203
10 69.644200 0.2603413 b 70.88705

Answer 2

为了完整性和从 Arun 和 Onyambu 那里获取线索（在一个单独的问题上），我也在这里添加 baseR 答案。

transform(df, H = Reduce(function(.x, .y) .x + df$T[.y] * (df$S[.y] - .x) * !c(!duplicated(df$g)[-1], 0)[.y],
                         seq(nrow(df)),
                         init = 0,
                         accumulate = TRUE)[-(1 + nrow(df))])

           S         T g        H
1  37.698250 0.8550377 a  0.00000
2   3.843585 0.4722659 a 32.23342
3  33.150788 0.3684791 a 18.82587
4   8.948116 0.8893603 a 24.10430
5  57.061844 0.5452377 a 10.62499
6  49.648827 0.7719067 b 10.62499
7  95.403697 0.5835950 b 40.74775
8  10.598677 0.1220491 b 72.64469
9  91.913365 0.2166443 b 65.07203
10 69.644200 0.2603413 b 70.88705

较早的回答 上面我朋友的回答略有不同，希望能达到你的目的。我的唯一假设是您的数据已经按组排序，并且 a 在 b 之前（完全如示例所示）。由于你没有给出随机种子，我也拿了我朋友拿的相同数据。

Strategy/hack，我在 accumulate2 参数中使用了 T 的 0 值，因此组 a 中 H 的最后一个值是在组 b

library(tidyverse)

df <- read.table(header = TRUE, text = '           S         T g
1  37.698250 0.8550377 a
2   3.843585 0.4722659 a
3  33.150788 0.3684791 a
4   8.948116 0.8893603 a
5  57.061844 0.5452377 a
6  49.648827 0.7719067 b
7  95.403697 0.5835950 b
8  10.598677 0.1220491 b
9  91.913365 0.2166443 b
10 69.644200 0.2603413 b')

df %>%
  mutate(H = accumulate2(S, replace(T, length(g[g=='a']), 0), .init = 0, ~ ..1 + ..3 * (..2 - ..1))[-(1+n())])


           S         T g        H
1  37.698250 0.8550377 a  0.00000
2   3.843585 0.4722659 a 32.23342
3  33.150788 0.3684791 a 18.82587
4   8.948116 0.8893603 a 24.10430
5  57.061844 0.5452377 a 10.62499
6  49.648827 0.7719067 b 10.62499
7  95.403697 0.5835950 b 40.74775
8  10.598677 0.1220491 b 72.64469
9  91.913365 0.2166443 b 65.07203
10 69.644200 0.2603413 b 70.88705

#check - formula
#H[j+1]=H[j]+T[j]*(S[j]-H[j])
# for j =2
# H[2] = H[1] + T[1] * (S[1] -H[1])

0 + 0.8550377 * (37.698250 - 0)
#> [1] 32.23342

#for j=7 (second row group b)

#H[6] + T[6] * (S[6] - H[6])
10.62499 + 0.7719067 * (49.648827 - 10.62499)
#> [1] 40.74775

^{由 reprex package (v2.0.0)}

于 2021-07-10 创建

Answer 3

这是@AnilGoyal 针对一般情况展示的类似方法

library(dplyr)
library(purrr)
df %>%
    mutate(H = accumulate2(S, T* !lead(!duplicated(g), default = FALSE),
          .init = 0, ~ ..1 + ..3 * (..2 - ..1))[-n()])

R：递归添加行

R: Recursively add rows

r

dplyr

purrr

rolling-computation

accumulate