如何加快計算取決於上一行中的值的值？

Question

我試圖加快這個計算速度，至少擺脫內部循環，因為它在很多 id 上真的很慢。 對於每個 ID，我都有一個“x”值向量，並試圖計算“y”值，這些值取決於“x”的當前值和“y”的先前值。 換句話說，對於每個 ID y[1] = x[1] 和后續行，y[i]=y[i-1]*x[i]。

誰能幫我加快速度？ 我試圖找到解決方案，但無法弄清楚。

這是一些可重現的代碼，可以滿足我的要求，但速度很慢：

#Calculate y[i]=y[i-1]*x[i]

#Make some dummy data
  dat<-data.frame(id=c(rep(1,10), rep(2,10)), 
                  x=c(0.95,1,1,1,0.98,0.96,0.93,1,0.94,0.9, 
                  0.97,1,1,0.94,0.93,1,1,0.97,0.99,0.95),
                  y=rep(0,20))
                


#Calculate y[i]=x[i]*y[i-1]
    idx<-1
    #Loop over individuals 
    ids<-unique(dat$id)
      for (j in 1:length(ids)){
        #Extract data for individual i
        temp<-dat[dat$id==ids[j],]
        #Initialize y[1]=x[1]
        temp$y[1]<-temp$x[1]
        #Calculate y[i]=x[i]*y[i-1] for remaining rows starting with row 2
        for (i in 2:nrow(temp)){
          temp$y[i]<-temp$x[i]*temp$y[i-1]
        }  
        #Store results in "dat"
        dat$y[idx:(nrow(temp)+idx-1)]<-temp$y
        idx<-nrow(temp)+1
        rm(temp)
      }
  

Answer 1

這是一個選項，您可以更廣泛地旋轉數據，然后可以一次對所有 ID 進行計算，因此您只需遍歷每個 ID 中的觀察數，而不是每個 ID。

xmat <- dat %>% 
  group_by(id) %>% 
  mutate(obs=seq_along(id)) %>% 
  select(-y) %>% 
  pivot_wider(names_from="id", values_from="x", names_sep="_") %>% 
  as.matrix() %>%
  .[,-1]
ymat <- xmat[1, , drop=FALSE]
for(i in 2:nrow(xmat)){
  ymat <- rbind(ymat, xmat[i,]*ymat[(i-1), ])
}

colnames(ymat) <- paste0("y_", colnames(ymat))
colnames(xmat) <- paste0("x_", colnames(xmat))
mats <- as.data.frame(cbind(xmat, ymat))
mats %>% pivot_longer(everything(), names_pattern="(.*)_(.*)", names_to=c(".value", "id"))

這是否以及加快速度取決於您擁有多少數據。 這里有一些基准。 在下面的代碼中，標記為循環的一個是您的原始代碼，而標記為樞軸的一個是我的代碼。 對於具有 20 行的原始數據，旋轉速度要慢得多：

microbenchmark(pivot=f1(), loops=f2(), times = 250)
#Unit: microseconds
#  expr      min       lq     mean   median       uq       max neval cld
# pivot 8861.625 9032.000 9734.104 9164.167 9768.792 25119.918   250   b
# loops  223.293  235.334  258.029  261.334  271.876   398.293   250  a 

但是，隨着您獲得更多數據，它相對於循環變得更快。 這里有 100 個 ID，每個 ID 有 20 個觀察值：

microbenchmark(pivot=f1(), loops=f2(), times = 25)
# Unit: milliseconds
#  expr      min       lq     mean   median       uq      max neval cld
# pivot 11.13217 12.22788 14.35621 12.58250 13.08083 35.59029    25  a 
# loops 17.23871 18.42488 18.60614 18.54304 19.08754 20.24063    25   b

在這里，沒有太大的收獲，但平均而言，旋轉方式略快一些。 使用 1000 個 ID 和每個 ID 20 個 obs，旋轉方式要快得多：

microbenchmark(pivot=f1(), loops=f2(), times = 25)
#Unit: milliseconds
#  expr       min        lq      mean    median        uq       max neval cld
# pivot  30.25879  31.13842  32.52211  31.31271  31.97708  46.16475    25  a 
# loops 270.93421 292.02204 310.56463 293.39604 306.38221 605.06092    25   b

對於 1000 個 ID，旋轉方式比循環快大約 10 倍。 所有這一切都是說，如果你有大量數據，那么旋轉方式可能是有意義的。

Answer 2

library(tidyverse)

dat <- data.frame(id=c(rep(1,10), rep(2,10)), 
                  x=c(0.95,1,1,1,0.98,0.96,0.93,1,0.94,0.9, 
                      0.97,1,1,0.94,0.93,1,1,0.97,0.99,0.95),
                  y=rep(0,20)) %>% 
  as_tibble()

dat %>%
  group_by(id) %>% 
  mutate(y = case_when(row_number() == 1 ~ x, 
                       TRUE ~ cumprod(y + x)))
#> # A tibble: 20 × 3
#> # Groups:   id [2]
#>       id     x     y
#>    <dbl> <dbl> <dbl>
#>  1     1  0.95 0.95 
#>  2     1  1    0.95 
#>  3     1  1    0.95 
#>  4     1  1    0.95 
#>  5     1  0.98 0.931
#>  6     1  0.96 0.894
#>  7     1  0.93 0.831
#>  8     1  1    0.831
#>  9     1  0.94 0.781
#> 10     1  0.9  0.703
#> 11     2  0.97 0.97 
#> 12     2  1    0.97 
#> 13     2  1    0.97 
#> 14     2  0.94 0.912
#> 15     2  0.93 0.848
#> 16     2  1    0.848
#> 17     2  1    0.848
#> 18     2  0.97 0.823
#> 19     2  0.99 0.814
#> 20     2  0.95 0.774

^{由reprex 包於 2022-06-29 創建 (v2.0.1)}