可以如下所示拟合具有问题中给出的方程式定义的干预的AR(1)模型。注意参数transfer
是如何定义的;您还需要xtransf
为每种干预措施(脉搏和短暂变化)输入一个指标变量:
require(TSA)
cds <- structure(c(2580L, 2263L, 3679L, 3461L, 3645L, 3716L, 3955L, 3362L,
2637L, 2524L, 2084L, 2031L, 2256L, 2401L, 3253L, 2881L,
2555L, 2585L, 3015L, 2608L, 3676L, 5763L, 4626L, 3848L,
4523L, 4186L, 4070L, 4000L, 3498L),
.Dim = c(29L, 1L),
.Dimnames = list(NULL, "CD"),
.Tsp = c(2012, 2014.33333333333, 12),
class = "ts")
fit <- arimax(log(cds), order = c(1, 0, 0),
xtransf = data.frame(Oct13a = 1 * (seq_along(cds) == 22),
Oct13b = 1 * (seq_along(cds) == 22)),
transfer = list(c(0, 0), c(1, 0)))
fit
# Coefficients:
# ar1 intercept Oct13a-MA0 Oct13b-AR1 Oct13b-MA0
# 0.5599 7.9643 0.1251 0.9231 0.4332
# s.e. 0.1563 0.0684 0.1911 0.1146 0.2168
# sigma^2 estimated as 0.02131: log likelihood = 14.47, aic = -18.94
您可以通过查看系数和的t统计量来检验每种干预措施的。为了方便起见,您可以使用函数。ω0ω1coeftest
require(lmtest)
coeftest(fit)
# Estimate Std. Error z value Pr(>|z|)
# ar1 0.559855 0.156334 3.5811 0.0003421 ***
# intercept 7.964324 0.068369 116.4896 < 2.2e-16 ***
# Oct13a-MA0 0.125059 0.191067 0.6545 0.5127720
# Oct13b-AR1 0.923112 0.114581 8.0564 7.858e-16 ***
# Oct13b-MA0 0.433213 0.216835 1.9979 0.0457281 *
# ---
# Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
在这种情况下,脉冲在显着性水平上不显着。它的效果可能已经被短暂的变化所捕获。5%
干预效果可以量化如下:
intv.effect <- 1 * (seq_along(cds) == 22)
intv.effect <- ts(
intv.effect * 0.1251 +
filter(intv.effect, filter = 0.9231, method = "rec", sides = 1) * 0.4332)
intv.effect <- exp(intv.effect)
tsp(intv.effect) <- tsp(cds)
您可以绘制干预效果,如下所示:
plot(100 * (intv.effect - 1), type = "h", main = "Total intervention effect")
该效果相对持久,因为接近(如果等于我们将观察到一个永久的电平移动)。ω21ω21
从数字上讲,这些是在2013年10月的干预措施在每个时间点量化的估算增加量:
window(100 * (intv.effect - 1), start = c(2013, 10))
# Jan Feb Mar Apr May Jun Jul Aug Sep Oct
# 2013 74.76989
# 2014 40.60004 36.96366 33.69046 30.73844 28.07132
# Nov Dec
# 2013 49.16560 44.64838
干预措施在2013年10月将观察到的变量的值增加了约。在随后的时期中,效果仍然存在,但重量逐渐减少。75%
我们还可以手动创建干预措施,并将其stats::arima
作为外部回归变量传递给我们。干预是脉冲加参数的瞬时变化,可以按以下方式构建。0.9231
xreg <- cbind(
I1 = 1 * (seq_along(cds) == 22),
I2 = filter(1 * (seq_along(cds) == 22), filter = 0.9231, method = "rec",
sides = 1))
arima(log(cds), order = c(1, 0, 0), xreg = xreg)
# Coefficients:
# ar1 intercept I1 I2
# 0.5598 7.9643 0.1251 0.4332
# s.e. 0.1562 0.0671 0.1563 0.1620
# sigma^2 estimated as 0.02131: log likelihood = 14.47, aic = -20.94
获得与以上相同的系数估计。在这里,我们将固定为。矩阵是您可能需要尝试不同方案的虚拟变量。您还可以为设置不同的值并比较其效果。ω20.9231xreg
ω2
这些干预等效于包装中定义的加和异常值(AO)和暂时性变化(TC)tsoutliers
。您可以使用此包来检测这些影响,如@forecaster的答案所示,或构建以前使用的回归器。例如,在这种情况下:
require(tsoutliers)
mo <- outliers(c("AO", "TC"), c(22, 22))
oe <- outliers.effects(mo, length(cds), delta = 0.9231)
arima(log(cds), order = c(1, 0, 0), xreg = oe)
# Coefficients:
# ar1 intercept AO22 TC22
# 0.5598 7.9643 0.1251 0.4332
# s.e. 0.1562 0.0671 0.1563 0.1620
# sigma^2 estimated as 0.02131: log likelihood=14.47
# AIC=-20.94 AICc=-18.33 BIC=-14.1
编辑1
我已经看到您给出的等式可以重写为:
(ω0+ω1)−ω0ω2B1−ω2BPt
可以像使用一样指定它transfer=list(c(1, 1))
。
如下所示,在这种情况下,此参数化导致参数估计与先前的参数化相比具有不同的效果。它使我想起了创新离群值的影响,而不是一时的冲动加上短暂的变化。
fit2 <- arimax(log(cds), order=c(1, 0, 0), include.mean = TRUE,
xtransf=data.frame(Oct13 = 1 * (seq(cds) == 22)), transfer = list(c(1, 1)))
fit2
# ARIMA(1,0,0) with non-zero mean
# Coefficients:
# ar1 intercept Oct13-AR1 Oct13-MA0 Oct13-MA1
# 0.7619 8.0345 -0.4429 0.4261 0.3567
# s.e. 0.1206 0.1090 0.3993 0.1340 0.1557
# sigma^2 estimated as 0.02289: log likelihood=12.71
# AIC=-15.42 AICc=-11.61 BIC=-7.22
我对包装的符号不是很熟悉,TSA
但是我认为现在可以将干预的效果量化为:
intv.effect <- 1 * (seq_along(cds) == 22)
intv.effect <- ts(intv.effect * 0.4261 +
filter(intv.effect, filter = -0.4429, method = "rec", sides = 1) * 0.3567)
tsp(intv.effect) <- tsp(cds)
window(100 * (exp(intv.effect) - 1), start = c(2013, 10))
# Jan Feb Mar Apr May Jun Jul Aug
# 2014 -3.0514633 1.3820052 -0.6060551 0.2696013 -0.1191747
# Sep Oct Nov Dec
# 2013 118.7588947 -14.6135216 7.2476455
plot(100 * (exp(intv.effect) - 1), type = "h",
main = "Intervention effect (parameterization 2)")
现在可将其描述为2013年10月的急剧增长,然后反方向的下降;干预的效果就会迅速消失,而权重衰减的正反两面也会很快消失。
这种效果有些特殊,但在实际数据中可能是可能的。在这一点上,我将研究数据的上下文以及可能影响数据的事件。例如,是否有政策变更,市场营销活动,发现...可以解释2013年10月的干预措施。初始参数化?
根据AIC,初始模型将是首选,因为它较低(对)。原始系列的图未暗示与第二干预变量的测量所涉及的急剧变化完全匹配。−18.94−15.42
在不了解数据上下文的情况下,我想说带有参数的短暂变化的AR(1)模型将适合于对数据进行建模并衡量干预措施。0.9
编辑2
的值确定干预效果衰减到零的速度,因此这是模型中的关键参数。我们可以通过拟合模型的值范围来进行。下面,为每个模型存储AIC。ω2ω2
omegas <- seq(0.5, 1, by = 0.01)
aics <- rep(NA, length(omegas))
for (i in seq(along = omegas)) {
tc <- filter(1 * (seq_along(cds) == 22), filter = omegas[i], method = "rec",
sides = 1)
tc <- ts(tc, start = start(cds), frequency = frequency(cds))
fit <- arima(log(cds), order = c(1, 0, 0), xreg = tc)
aics[i] <- AIC(fit)
}
omegas[which.min(aics)]
# [1] 0.88
plot(omegas, aics, main = "AIC for different values of the TC parameter")
发现最低的AIC为(与之前估计的值一致)。此参数涉及相对持久但短暂的效果。我们可以得出结论,这种影响是暂时的,因为当AIC 值大于,AIC会增加(请记住,在极限值,干预将变为永久的水平移动)。ω2=0.880.9ω2=1
干预措施应包括在预测中。获得已经观察到的期间的预测对于评估预测的效果是很有帮助的。下面的代码假定该系列于2013年10月结束。随后将获得预测,包括参数的干预。ω2=0.9
首先,我们将AR(1)模型与干预作为回归变量(参数):ω2=0.9
tc <- filter(1 * (seq.int(length(cds) + 12) == 22), filter = 0.9, method = "rec",
sides = 1)
tc <- ts(tc, start = start(cds), frequency = frequency(cds))
fit <- arima(window(log(cds), end = c(2013, 10)), order = c(1, 0, 0),
xreg = window(tc, end = c(2013, 10)))
可以获取预测并显示如下:
p <- predict(fit, n.ahead = 19, newxreg = window(tc, start = c(2013, 11)))
plot(cbind(window(cds, end = c(2013, 10)), exp(p$pred)), plot.type = "single",
ylab = "", type = "n")
lines(window(cds, end = c(2013, 10)), type = "b")
lines(window(cds, start = c(2013, 10)), col = "gray", lty = 2, type = "b")
lines(exp(p$pred), type = "b", col = "blue")
legend("topleft",
legend = c("observed before the intervention",
"observed after the intervention", "forecasts"),
lty = rep(1, 3), col = c("black", "gray", "blue"), bty = "n")
第一次预测与观测值相对匹配(灰色虚线)。其余的预测表明该系列将如何继续朝着原始均值的方向发展。但是,置信区间很大,反映了不确定性。因此,我们应谨慎行事,并在记录新数据时修改模型。
95%可以将置信区间添加到上一个图,如下所示:
lines(exp(p$pred + 1.96 * p$se), lty = 2, col = "red")
lines(exp(p$pred - 1.96 * p$se), lty = 2, col = "red")