ARIMA干预传递函数-如何可视化效果


11

我有一个干预措施的每月时间序列,我想量化此干预措施对结果的影响。我意识到该系列非常短,效果尚未得出结论。

数据

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")

在此处输入图片说明

方法论

1)该auto.arima功能使用了干预前系列(直到2013年10月)。建议的模型为ARIMA(1,0,0),均值非零。ACF图看起来不错。

pre <- window(cds, start=c(2012, 01), end=c(2013, 09))

mod.pre <- auto.arima(log(pre))

# Coefficients:
#          ar1  intercept
#       0.5821     7.9652
# s.e.  0.1763     0.0810
# 
# sigma^2 estimated as 0.02709:  log likelihood=7.89
# AIC=-9.77   AICc=-8.36   BIC=-6.64

2)根据完整系列图,以下选择脉冲响应,T = 2013年10月,

在此处输入图片说明

根据cryer和chan可以使用arimax函数按以下方式进行拟合:

mod.arimax <- arimax(log(cds), order=c(1, 0, 0),
                     seasonal=list(order=c(0, 0, 0), frequency=12),
                     include.mean=TRUE,
                     xtransf=data.frame(Oct13=1 * (seq(cds) == 22)),
                     transfer=list(c(1, 1)))
mod.arimax

# Series: log(cds) 
# 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

由此产生的残差看起来还可以:

在此处输入图片说明

拟合图和实际图:

plot(fitted(mod.arimax), col="red", type="b")
lines(window(log(cds), start=c(2012, 02)), type="b")

在此处输入图片说明

问题

1)这种方法是否适合干预分析?

2)我可以看看传递函数各组成部分的估计/ SE,并说干预的效果很明显吗?

3)如何可视化传递函数的效果(作图?)

4)是否有办法估算“ x”个月后干预会增加多少产出?我想为此(也许是#3)我在问如何使用模型方程式-如果这是带有虚拟变量的简单线性回归(例如),我可以在有干预和无干预的情况下运行方案并评估影响-但我不确定如何使用这种类型的模型。

根据请求,这是两个参数化的残差。

首先适合:

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)))

plot(resid(fit), type="b")

在此处输入图片说明

然后,从这个适合

mod.arimax <- arimax(log(cds), order=c(1, 0, 0),
                     seasonal=list(order=c(0, 0, 0), frequency=12),
                     include.mean=TRUE,
                     xtransf=data.frame(Oct13=1 * (seq(cds) == 22)),
                     transfer=list(c(1, 1))) 

mod.arimax
plot(resid(mod.arimax), type="b")

在此处输入图片说明


如果我使用SAS软件为您提供解决方案,可以吗?
预报者

当然,如果您想出一个更好的模型,我会很好奇。
B_Miner 2014年

好的,该模型比最初提出的模型好一点,但类似于@javlacalle。
天气预报员

Answers:


12

可以如下所示拟合具有问题中给出的方程式定义的干预的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)")

干预效果参数化2

现在可将其描述为2013年10月的急剧增长,然后反方向的下降;干预的效果就会迅速消失,而权重衰减的正反两面也会很快消失。

这种效果有些特殊,但在实际数据中可能是可能的。在这一点上,我将研究数据的上下文以及可能影响数据的事件。例如,是否有政策变更,市场营销活动,发现...可以解释2013年10月的干预措施。初始参数化?

根据AIC,初始模型将是首选,因为它较低(对)。原始系列的图未暗示与第二干预变量的测量所涉及的急剧变化完全匹配。18.9415.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 值大于,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")

太好了,谢谢!如果您不介意的话,我进行了两次随访。1)我遵循的过程是否正确?2)您是否认为模型的拟合度“足够好”,以便使用估计值来量化干预的效果?3)我是否应该不能使用参数化,即transfer = list(c(1,1))并获得相当接近的结果?我从教科书中遵循的示例建议我应该可以,但在此示例中,结果并不接近...
B_Miner 2014年

@B_Miner你是对的,我已经编辑了答案。
javlacalle 2014年

我同意你的观点,在这两个模型中,第一个参数化(也许去除了不重要的脉冲)将是最合适的。我相信,为什么两个参数化不能产生相同的模型,这是一个谜。我将通过电子邮件发送给软件包开发人员(谁也写了有关其等效性的书)。
B_Miner 2014年

数据是每月开立的存款证明的数量。干预是从10月13日开始的平均利率上升。自10月13日以来,利率水平一直保持相对恒定。在我认为上升之后,对该产品的需求开始逐渐减弱-我不确定它是否会回到先前的均值或稳定在某个较高的水平(从先前)。
B_Miner 2014年

B_miner,基于我们无法真正得出结论的数据,如果需求将稳定到新的均值。
预报者

4

有时少即是多。进行了30次观察后,我将数据提交给了AUTOBOX,这是我帮助开发的软件。我提交以下分析,以期获得+200的奖励(开玩笑!)。我已经绘制了“实际值”和“清洗后的值”,从视觉上暗示了“最近活动”的影响。在此处输入图片说明。这里显示了自动开发的模型。在此处输入图片说明在这里在此处输入图片说明。这里给出了这个相当简单的电平移位序列的残差在此处输入图片说明。模型统计信息在这里在此处输入图片说明。总之,有一项干预措施可以根据经验加以识别,从而形成ARIMA过程; 2个脉冲和1个电平移位在此处输入图片说明。实际/适合和预测图进一步突出了分析。在此处输入图片说明

我想看看先前指定的残差图,我认为这可能是过度指定的模型。


我对Autobox不熟悉,但是模型的噪声部分是否与我最初使用的相同:非零均值和AR(1)?
B_Miner 2014年

此输出是否表示10月13日到当前时间段的唯一“干预”是10月13日的单个脉冲,然后该系列返回其正常平均水平?
B_Miner 2014年

我添加了两个参数化的残差。在我看来,似乎我列出的第一个(最初由javlacalle选出的)更好。同意?
B_Miner 2014年

1)噪声部分是具有非零均值的AR(1)
IrishStat

1)噪声部分是平均值非零的AR(1); 2)有22个干预期和3个干预期,10月13日之后又回到了9月13日开始的新水平;3)考虑到您提到的两者之间的选择,我同意,但我更喜欢AUTOBOX模型,因为它具有简单性和效率。您可以了解更多有关AUTOBOX autobox.com/cms
IrishStat

3

基于与上一个问题类似的帖子,我在 tsoutliers包中使用了tso函数,并在2013年10月自动检测到临时更改。请注意,临时更改与传递函数中的斜线移位不同,这就是您要追求的。我认为没有一个包/函数可以使传递函数可视化。希望这将提供一些见解。我没有使用日志转换,而是直接对其建模。tsoutliers软件包可被视为自动干预检测。R

下面是代码:

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")
arimatr <- tsoutliers::tso(cds,args.tsmethod=list(d=0,D=0))
plot(arimatr)
arimatr

以下是估算值,2013年10月增加了〜2356.3个单位,标准误差为〜481.8,此后具有衰减作用。该函数自动识别AR(1)。我必须进行几次迭代,并将季节和非季节差异都设为0,这反映在tso函数的args.tsmethod中。

Series: cds 
ARIMA(1,0,0) with non-zero mean 

Coefficients:
         ar1  intercept       TC22
      0.5969  3034.6560  2356.2914
s.e.  0.1495   206.5202   481.7981

sigma^2 estimated as 209494:  log likelihood=-219.03
AIC=446.06   AICc=447.73   BIC=451.53

Outliers:
  type ind    time coefhat tstat
1   TC  22 2013:10    2356 4.891

下面是该图,tsoutlier是我所知的唯一可以在图中很好地打印出临时更改的软件包。

在此处输入图片说明

尽管使用了不同的方法该分析有望为您的2、34个问题提供答案。尤其是图和系数提供了此干预的效果以及如果您没有此干预将会发生的情况。

还希望其他人可以使用R中的传递函数建模来复制此图/分析。我不确定是否可以在R中完成,也许有人可以对此进行检查。


谢谢。是的,这是我想从arimax模型中得到的图-查看有无干预(减去)。我认为R中的过滤器函数可用于生成每个月的传递函数值(然后将其绘制为可视化),但我无法弄清楚如何针对任意脉冲干预函数执行此操作。
B_Miner 2014年
By using our site, you acknowledge that you have read and understand our Cookie Policy and Privacy Policy.
Licensed under cc by-sa 3.0 with attribution required.