R中的居中移动平均线（不使用包）答案

【问题标题】：Centered moving average in R (without using packages)R中的居中移动平均线（不使用包）
【发布时间】：2023-04-08 11:21:01
【问题描述】：

我一直在R中构建一个居中移动平均的函数（不使用任何包），遇到了如下挑战：

如您所知，居中移动平均线包含合并“不完整部分”的概念（即在数据点的开头和结尾处）。例如，考虑下面的向量p：

p <- c(10,20,30,40,50,60,70,80,90)

在这种情况下，我感兴趣的居中移动平均线如下所示：

x <- ((10+20)/2, (10+20+30)/3, (20+30+40)/3 ..... (70+80+90)/3, (80+90)/2)

为了实现上述目的，我尝试了以下 if 函数：

wd 表示window size

mov_avg <- function(p, wd) {
  x <- c(0, cumsum(p))
  if ((p > p[1])&(p < p[length(p)])) {
    neut <- 1:(length(p)-(wd-1))
    upper <- neut+(wd-1)
    x <- (x[upper]-x[neut])/(upper-neut)
  } else if (p==p[1]) {
    neut <- 0
    upper <- neut+3
    x <- (x[upper]-x[neut])/(upper-1-neut)
  } else if (p==p[length(p)]) {
    upper <-(length(p)+1)
    neut <- (length(p)-(wd-2))
    x <- (x[upper]-x[neut])/(upper-neut)
  }
  return(x)
}

然后我进入下面一行执行：

mov_avg(p, 3)

我遇到了如下错误：

numeric(0)
Warning messages:
1: In if ((p > p[1]) & (p < p[length(p)])) { :
  the condition has length > 1 and only the first element will be used
2: In if (p == p[1]) { :
  the condition has length > 1 and only the first element will be used

有人可以帮我把它变成一个工作函数吗？

谢谢！

【问题讨论】：

您的警告来自您在 if() 中比较的事实 - 将整个向量 p 与单个值进行比较。所以你需要在那里进行一些调整。实际上，你想在那里测试什么，或者换句话说，你试图在那里捕捉的三个案例是什么？不确定和口味不同，但我也认为 cumsum 可能不是实现目标的最简单方法。
非常感谢丹尼尔的评论。我正在尝试在时间序列上制作事件的概率轨迹，并正在开发几种不同的移动平均模型，包括这个。其他将是 TMA（三角移动平均线）和 EMA（指数移动平均线）..
对不起，这可能是一个误解，我的意思是你的三个 if-case 是什么？对我来说，这似乎有点像，当你在“中间”时，第一个应该去拿箱子，而另外两个应该在你在边境的时候去拿箱子？！但这行不通，因为您只需在函数中遍历整个内容，然后创建一个 x-vector。因此，如果您仍想使用您的函数（而不是已经建议的解决方案），我认为您仍然需要围绕 if 子句进行循环，然后您需要组合输出而不是仅仅覆盖它。
是的，丹尼尔，这就是我想做的……你明白了。另外，我知道我需要创建一个循环。我会试试看。 :) 再次感谢！
也许只是为了完成，你也可以看看这个旧线程stackoverflow.com/questions/743812/calculating-moving-average

标签： r moving-average

【解决方案1】：

在基本 R 中这样的东西怎么样：

window <- 3
p <- c(10,20,30,40,50,60,70,80,90)

x <- c(NA, p, NA)
sapply(seq_along(x[-(1:(window - 1))]), function(i)
    mean(x[seq(i, i + window - 1)], na.rm = T))
#[1] 15 20 30 40 50 60 70 80 85

诀窍是添加侧翼NAs，然后使用mean 和na.rm = T。

我知道你说“不使用包”，但使用 zoo::rollapply 时同样更短

library(zoo)
rollapply(c(NA, p, NA), 3, mean, na.rm = T)
#[1] 15 20 30 40 50 60 70 80 85

【讨论】：

还有rollmean函数可能有用。
非常感谢 Maurits！我猜这是解决问题的一种优雅方式！此外，感谢介绍该软件包、Ronak 和 Maurits。我也会尝试使用它！

【解决方案2】：

另一种方法是创建一个函数，我们可以在其中使用变量windows 进行调整

mov_avg <- function(p, window) {
 mean_number = numeric()
 index = 1
 while(index < length(p)) {
   if (index == 1 | index == length(p) - 1) 
    mean_number = c(mean_number, mean(p[index:(index + window - 2)]))
   else 
    mean_number = c(mean_number, mean(p[index:(index + window - 1)]))
  index = index + 1
  }
  mean_number
}

mov_avg(p, 3)
#[1] 15 30 40 50 60 70 80 85

mov_avg(p, 2)
#[1] 10 25 35 45 55 65 75 80

【讨论】：

这是我想最接近我想创建的。谢谢！我很想学习优雅地使用循环。 :)

【解决方案3】：

在列为 x 的矩阵中按行取平均值，在头部和尾部分别附加前两个和最后两个元素的平均值。

apply( matrix( c(x, 
               c( x[1]+x[2])/2, head(x,-1) ),
               c( tail(x,-1), sum( tail(x,2))/2)  ),
               ncol = 3),
       1, mean)

【讨论】：

【解决方案4】：

我们也可以使用rowMeans

rowMeans(embed(c(NA, p, NA),  3)[, 3:1], na.rm = TRUE)
#[1] 15 20 30 40 50 60 70 80 85

【讨论】：

这是一个非常好的方法！但真的需要[, 3:1] 部分吗？