문제에 주어진 방정식에 정의 된 중재를 가진 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
ω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
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 (additive outlier) 및 TC (transitory change)와 동일합니다 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ω2비1 - ω2비피티
그리고 당신이 사용했던 것처럼 지정할 수 있습니다 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 월에 개입을 설명 할 수있는 정책 변경, 마케팅 캠페인, 발견 등이 있었습니까? 그렇다면이 이벤트가 이전에 또는 발견 한 데이터에 영향을 미치는 것이 더 합리적입니까 초기 매개 변수화?
− 18.94− 15.42
0.9
편집 2
ω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")
ω2= 0.880.9ω2= 1
ω2= 0.9
ω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")