使用bfast检测季节分量的变化

Question

bfast软件包中的bfast()函数应该能够检测长期趋势中的断点和季节性分量的变化。该图（source）是一个例子：

在此图中，子图号为。图2显示了检测到的季节性变化，而否。图3显示了趋势的断点。

但是，我不知道如何告诉bfast()查找季节性变化/断点。我得到的只是长期趋势中的断点。这是一个可重现的示例，它以季节性变量y的每周测量值（即每年52次测量值）来模拟一个50年的时间序列：

n_years <- 50
freq <- 52
y_pattern <- sin(seq(0, 2*pi, length = freq))
y <- rep(y_pattern, n_years) + rnorm(freq*n_years, sd = 0.1)
mydata <- data.frame(Year = rep(1:n_years, each = freq), Week = rep(1:freq, n_years), y)  

这些数据在数据中显示出恒定的季节性趋势，在第13周附近出现年度峰值。现在，让我们在25年开始引入季节性变化，在26-59年后的8周改变季节性周期： / p>

move_data <- function(data, year, weeks_to_move){
  x <- data[data$Year == year, "y"]
  c(x[seq(52 - weeks_to_move + 1,52)], x[seq(1, 52 - weeks_to_move)])
}

mydata$y_shifted <- mydata$y
for (year in 26:50){
  mydata$y_shifted[mydata$Year == year] <- move_data(mydata, year, weeks_to_move = 8)
}

变量y_shifted现在在1-25年的第13周左右和26-52年的第21周左右都有年度峰值。与“未移位”变量y相比，让我们对其进行绘制：

mydata$Phase <- ifelse(mydata$Year <= 25, "Year 1-25", "Year 26-50")
mydata %>%
  tidyr::gather("y_variable", "value", y, y_shifted) %>%
  ggplot(aes(Week, value, group = Year, color = Phase)) + geom_line() +
  facet_grid(.~y_variable)

[

这种季节性的突然变化应该很容易发现。但是，当我运行`bfast（）时，它不会检测到任何更改：

y_ts <- ts(mydata$y_shifted, start = c(1,1), frequency = freq)
fit <- bfast(y_ts, h=.15, season="harmonic", max.iter=20, breaks=3)
plot(fit)

如您所见，季节性没有变化（上面的子图2）。残差（子图4）反映了季节性的变化，如果我们按年份绘制残差，则很明显：

mydata$Residuals <- fit$output[[1]]$Nt
ggplot(mydata, aes(Week, Residuals, group = Year, color = Phase)) + geom_point()

我感觉需要更改一些参数或选项以使bfast()查找季节性变化，但是哪个？我还无法从文档中找出此信息。

Answer 1

在我的消费者投资组合数据上测试bfast时，我遇到了同样的问题，但是找不到任何真正的解决方案。我继续研究了来自地球感知社区的bfast文献，bfast是最早开发和广泛使用的地方。我的读物是，要使bfast始终适合有用的季节性成分，您几乎无能为力。

几天前，我在the best software for time series analysis上遇到了Quora讨论，发现有一个新的R包Rbeast用于断点检测和时间序列分解。还有一条很好的推文，显示了快速比较between bfast and Rbeast。

经过一些试验，我发现Rbeast可以在我的数据以及您的数据中查明季节性断点。坦白地说，我不知道Rbeast的工作方式。 Rbeast中的BEAST算法似乎相当复杂，具有大量的输出。它没有很好的文档记录，并且不如bfast易于使用。让我展示一下我得到的东西，首先使用您的数据，然后使用第二个人工时间序列。

您的数据

# The original code to generate your data
n_years <- 50
freq    <- 52
y_pattern <- sin(seq(0, 2*pi, length = freq))
y         <- rep(y_pattern, n_years) + rnorm(freq*n_years, sd = 0.1)
mydata    <- data.frame(Year = rep(1:n_years, each = freq), Week = rep(1:freq, n_years), y) 

move_data <- function(data, year, weeks_to_move){
  x <- data[data$Year == year, "y"]
  c(x[seq(52 - weeks_to_move + 1,52)], x[seq(1, 52 - weeks_to_move)])
}

mydata$y_shifted <- mydata$y
for (year in 26:50){
  mydata$y_shifted[mydata$Year == year] <- move_data(mydata, year, weeks_to_move = 8)
}

# You data analyzed by the BEAST algorithm in Rbeast
library(Rbeast) 
# Rbeast's input should be a data vector not a ts object.
# '52' is the frequency (called period in BEAST)
fit <- beast(mydata$y_shifted,52)
plot(fit)

# another way to run BEAST by customizing the parameters explicitly
opt$period=52         # ts frequency/period
opt$minSeasonOrder=1  # min harmonic order used to fit seasonal cmpnt
opt$maxSeasonOrder=5  # max harmonic order used to fit seasonal cmpnt
fit <- beast(mydata$y_shifted,opt)
plot(fit)

精确地检测到突然的季节性变化。 Rbeast还提供了检测季节性和趋势断点的可能性（上图的子图中的黑色曲线）。检测到的季节性变化的可能性非常高，大于0.91。您的数据具有恒定趋势（即无趋势）。 Rbeast在趋势中未找到断点，但拟合的趋势显示为非线性（灰色信封是置信区间）。我猜这是非线性的，因为BEAST将许多个体趋势平均在一起。在上面的图中，检测趋势中断的可能性看起来也很奇怪。由于y缩放，事实证明这是一种幻想。

我以正常的y比例重新绘制趋势结果。

par( mar = c(3, 5, 3, 2), mfrow=c(2,1) )
plot( fit$t,  main='trend',  type='l', ylim=c(-0.1,0.1) )
plot( fit$tProb,main='changepoint probability in trend',type='l', ylim=c(0,1) )

下图显示了趋势基本上是零的常数，并且在趋势中找到断点（即Rbeast中使用的变更点）的可能性也始终接近零。

---

---

第二时间序列

Rbeast的一个很酷的功能是估计谐波季节模型的正弦/余弦阶数。下面我生成了一个时间序列，该时间序列在季节性成分中具有三个细分部分（即两个休息时间）加上一个没有休息时间的倾斜趋势。这三个季节部分的犯罪顺序不同，分别为1、2和3。

# Generate a sample time series with three seasonal segments
# the sin/cos orders for the three segs are different.
seg1 <- 1:1000
seg2 <- 1001:2000
seg3 <- 2001:3000
new_data <- c( sin(seg1*2*pi/52), 0.6*sin( seg2*2*pi/52*2), 0.3*sin( seg3*2*pi/52*3)) + (1:3000)*0.0002+ rnorm(3000, sd = 0.1)

# Test bfast using new_data
y_ts <- ts(new_data, start = c(1,1), frequency = 52)
fit  <- bfast(y_ts, h=.15, season="harmonic", max.iter=20, breaks=3)
plot(fit)

令人惊讶的是，尽管在所绘制的数据Yt中三个部分很容易被盯住，但是bfast并未发现季节性中断。

# Analyze the new_data time series using Rbeast

opt=list()
opt$period=52
opt$minSeasonOrder=1
opt$maxSeasonOrder=4
opt$samples = 6000  
opt$computeHarmonicOrder = 1 # "1" asks BEAST to output seasonal order
fit <- beast(new_data ,opt)
plot(fit)

以上是Rbeast结果。恢复了两个休息和三个季节部分。同样，趋势没有中断。趋势的断点概率表明可能存在一些断点，但概率曲线实际上接近于零，并且未在正常y范围内绘制。

设置“ opt $ computeHarmonicOrder”告诉野兽保存估计的季节性谐波订单以适合$ horder。下图是输出。这三个罪恶命令也得到了很好的恢复。该曲线还显示了两个季节性休假的位置。

plot(fit$horder,type='l')