R语言如何逐行累计计算wells与eur相关系数并存为新列

问题说明 #

现有tibble格式数据集tmp，结构与构建代码如下：

tmp <- tibble::tibble(id = rep(1, 16), wells = 1:16, eur = c(21,23,45,43,23,55,34,44,65,56,66,76,87,67,76,56))

# 数据集预览
#> # A tibble: 16 × 3
#>       id wells   eur
#>    <dbl> <int> <dbl>
#>  1     1     1    21
#>  2     1     2    23
#>  3     1     3    45
#>  4     1     4    43
#>  5     1     5    23
#>  6     1     6    55
#>  7     1     7    34
#>  8     1     8    44
#>  9     1     9    65
#> 10     1    10    56
#> 11     1    11    66
#> 12     1    12    76
#> 13     1    13    87
#> 14     1    14    67
#> 15     1    15    76
#> 16     1    16    56

需要新增列存储wells和eur的累计相关系数，规则为：

• 第1行取值为1
• 第n（n≥2）行取值为前n行记录中，wells列1:n取值和eur列前n个值的皮尔逊相关系数
  直接调用全局cor()函数仅能返回全量数据的单个相关系数，无法满足逐行累计计算需求。

实现代码 #

方案1：tidyverse生态实现（适配tibble操作习惯） #

使用dplyr做数据框操作，slider包实现滑动窗口计算，代码简洁可读性强：

library(dplyr)
library(slider)

tmp <- tmp %>%
  mutate(
    cum_cor = slide2_dbl(
      .x = wells,
      .y = eur,
      .f = ~cor(.x, .y),
      .before = Inf # 窗口覆盖从第一行到当前行的所有记录
    )
  )
# 第一行单样本相关系数返回NA，按需求手动修正为1
tmp$cum_cor[1] <- 1

方案2：base R实现（无需安装额外包） #

直接用基础R的sapply逐行索引计算，无第三方包依赖：

tmp$cum_cor <- sapply(
  seq_len(nrow(tmp)),
  function(i) {
    if (i == 1) return(1)
    cor(tmp$wells[seq_len(i)], tmp$eur[seq_len(i)])
  }
)

结果说明 #

• 两种方案计算结果完全一致，最后一行的累计相关系数和全局调用cor(tmp$wells, tmp$eur)的返回值完全匹配，逻辑自洽
• 计算得到的前3行cum_cor值分别为1.000、1.000（前2组数据完全线性正相关）、0.901，符合累计计算规则

内容的提问来源于stack exchange，提问作者Solicia