多个变量的可变移码滚动平均值答案

【问题标题】：Variable frameshift rolling average for multiple variables多个变量的可变移码滚动平均值
【发布时间】：2021-02-10 19:48:19
【问题描述】：

我有类似的数据集

index <- seq(2000,2020)
weight <-seq(50,70)
length <-seq(10,50,2)
data <- cbind(index,weight,length)
row.names(data) <-as.character(seq(1:21))
data

   index weight length
1   2000     50     10
2   2001     51     12
3   2002     52     14
4   2003     53     16
5   2004     54     18
6   2005     55     20
7   2006     56     22
8   2007     57     24
9   2008     58     26
10  2009     59     28
11  2010     60     30
12  2011     61     32
13  2012     62     34
14  2013     63     36
15  2014     64     38
16  2015     65     40
17  2016     66     42
18  2017     67     44
19  2018     68     46
20  2019     69     48
21  2020     70     50

我需要创建几个新变量来表示所有间隔的先前测量值。

我需要为每一行（每个索引）设置这些值：

测量前 1 天体重
测量前 1-2 天的平均体重
测量前 1-3 天的平均体重
等。最长 10 天 [帧从 1 到 10 不等，帧移位等于 1]

之后：

测量前 2 天的体重
测量前 2-3 天的平均体重
测量前 2-4 天的平均体重
等。最长 11 天 [帧从 1 到 10 不等，帧移位等于 2]

并继续直到等于 30 的移码。因此，帧的平均值在 1 天到 10 天之间变化，并且该帧从测量前 1 天转移到测量前 30 天。

另外，我需要为多列（大约 10 个）执行此操作。

谢谢！

【问题讨论】：

标签： r dataframe tidyverse

【解决方案1】：

如下使用rollapplyr。将第二组的 offsets 更改为 -(2:11)。

library(zoo)

offsets <- -(1:10)

n <- length(offsets)
means <- function(x) c(cumsum(x) / seq_along(x), NA * offsets)[1:n]
r <- rollapplyr(data[, "weight"], list(offsets), means, partial = TRUE, fill = NA)
colnames(r) <- -offsets
cbind(data, r)

给予：

   index weight length  1    2  3    4  5    6  7    8  9   10
1   2000     50     10 NA   NA NA   NA NA   NA NA   NA NA   NA
2   2001     51     12 50   NA NA   NA NA   NA NA   NA NA   NA
3   2002     52     14 51 50.5 NA   NA NA   NA NA   NA NA   NA
4   2003     53     16 52 51.5 51   NA NA   NA NA   NA NA   NA
5   2004     54     18 53 52.5 52 51.5 NA   NA NA   NA NA   NA
6   2005     55     20 54 53.5 53 52.5 52   NA NA   NA NA   NA
7   2006     56     22 55 54.5 54 53.5 53 52.5 NA   NA NA   NA
8   2007     57     24 56 55.5 55 54.5 54 53.5 53   NA NA   NA
9   2008     58     26 57 56.5 56 55.5 55 54.5 54 53.5 NA   NA
10  2009     59     28 58 57.5 57 56.5 56 55.5 55 54.5 54   NA
11  2010     60     30 59 58.5 58 57.5 57 56.5 56 55.5 55 54.5
12  2011     61     32 60 59.5 59 58.5 58 57.5 57 56.5 56 55.5
13  2012     62     34 61 60.5 60 59.5 59 58.5 58 57.5 57 56.5
14  2013     63     36 62 61.5 61 60.5 60 59.5 59 58.5 58 57.5
15  2014     64     38 63 62.5 62 61.5 61 60.5 60 59.5 59 58.5
16  2015     65     40 64 63.5 63 62.5 62 61.5 61 60.5 60 59.5
17  2016     66     42 65 64.5 64 63.5 63 62.5 62 61.5 61 60.5
18  2017     67     44 66 65.5 65 64.5 64 63.5 63 62.5 62 61.5
19  2018     68     46 67 66.5 66 65.5 65 64.5 64 63.5 63 62.5
20  2019     69     48 68 67.5 67 66.5 66 65.5 65 64.5 64 63.5
21  2020     70     50 69 68.5 68 67.5 67 66.5 66 65.5 65 64.5

【讨论】：

【解决方案2】：

考虑到包tidyverse 和zoo 这是一个命题：

准备环境

library(tidyverse)
data <- tibble(
  index = seq(2000,2020),
  weight = seq(50,70),
  length = seq(10,50,2)
)

完成工作：

遍历所有移码并计算从 1 到 10 的所有滚动平均值：

lapply(1:30, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:10, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

最后，您只需要将生成的 tibble 与您的数据绑定...

移码为 3 且 rollmean 最大为 5 的样本

res <- lapply(3, function(frameshift) {
  w <- lag(data$weight, frameshift)
  lapply(1:5, function(k) {
    name <- sprintf("frameshift%i_k%i", frameshift, k)
    tibble("{name}" := zoo::rollmean(x = w, k = k, fill = NA, align = "r"))
  }) %>% bind_cols()
}) %>% bind_cols()

bind_cols(data, res)

A tibble: 21 x 8
  index weight length frameshift3_k1 frameshift3_k2 frameshift3_k3 frameshift3_k4 frameshift3_k5
   <int>  <int>  <dbl>          <dbl>          <dbl>          <dbl>          <dbl>          <dbl>
 1  2000     50     10             NA           NA               NA           NA               NA
 2  2001     51     12             NA           NA               NA           NA               NA
 3  2002     52     14             NA           NA               NA           NA               NA
 4  2003     53     16             50           NA               NA           NA               NA
 5  2004     54     18             51           50.5             NA           NA               NA
 6  2005     55     20             52           51.5             51           NA               NA
 7  2006     56     22             53           52.5             52           51.5             NA
 8  2007     57     24             54           53.5             53           52.5             52
 9  2008     58     26             55           54.5             54           53.5             53
10  2009     59     28             56           55.5             55           54.5             54

【讨论】：