ARIMA Müdahale Transfer Fonksiyonu - Etkinin Görselleştirilmesi

Müdahaleli aylık bir zaman serim var ve bu müdahalenin sonuç üzerindeki etkisini ölçmek istiyorum. Dizinin oldukça kısa olduğunu ve etkinin henüz sonuçlanmadığını fark ediyorum.

Veri

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

Metodoloji

1) Müdahalede ön müdahale serisi (Ekim 2013'e kadar) kullanılmıştır auto.arima. Önerilen model sıfır olmayan ortalamalı ARIMA (1,0,0) idi. Acf arsa iyi görünüyordu.

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) Tam serinin çizimi göz önüne alındığında, nabız yanıtı aşağıda seçildi, T = Ekim 2013,

Bu fritöz ve chan göre arimax fonksiyonu ile aşağıdaki gibi uygun olabilir:

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

Bundan kalanlar iyi görünüyordu:

Donatılmış ve gerçekler grafiği:

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

Sorular

1) Bu metodoloji müdahale analizi için doğru mu?

2) Transfer fonksiyonunun bileşenleri için tahmine / SE'ye bakabilir ve müdahalenin etkisinin önemli olduğunu söyleyebilir miyim?

3) Transfer fonksiyonu efektini nasıl görselleştirebiliriz (çizin?)

4) Müdahalenin 'x' aydan sonra çıktıyı ne kadar artırdığını tahmin etmenin bir yolu var mı? Bunun için tahmin ediyorum (ve belki de # 3) Modelin bir denklemi ile nasıl çalışacağımı soruyorum - eğer bu kukla değişkenlerle basit bir doğrusal regresyon olsaydı (örneğin) müdahale ile ve müdahale olmadan senaryoları çalıştırabilir ve etkisini ölçebilirim - ama bu tür bir modelin nasıl çalışacağından emin değilim.

EKLE

İstek üzerine, iki parametreden kalan kalıntılar.

İlk olarak:

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

Sonra, bu uyumdan

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

Soruda verilen denklemde tanımlanan müdahaleye sahip bir AR (1) modeli, aşağıda gösterildiği gibi takılabilir. Argümanın nasıl transfertanımlandığına dikkat edin ; ayrıca xtransfmüdahalelerin her biri için bir gösterge değişkenine ihtiyacınız vardır (nabız ve geçici değişiklik):

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

ve katsayılarının t istatistiklerine bakarak her müdahalenin önemini test edebilirsiniz . Kolaylık sağlamak için işlevi kullanabilirsiniz .ω $\omega_0$$\omega_1$coeftest

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

Bu durumda nabız önem düzeyinde anlamlı değildir. Etkisi geçici değişiklik tarafından zaten yakalanmış olabilir.$5\%$

Müdahale etkisi aşağıdaki gibi ölçülebilir:

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)

Müdahalenin etkisini aşağıdaki gibi çizebilirsiniz:

plot(100 * (intv.effect - 1), type = "h", main = "Total intervention effect")

Çünkü etkisi nispeten kalıcı olur yakın olmaktır (eğer eşit olduğu biz kalıcı bir seviye kayması gözlemlemek olacaktır). 1 ω 2$\omega_2$$1$$\omega_2$$1$

Sayısal olarak, bunlar Ekim 2013'teki müdahalenin neden olduğu her bir zaman noktasında ölçülen tahmini artışlardır:

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

Müdahale Ekim 2013'te gözlemlenen değişkenin değerini yaklaşık arttırmaktadır . Sonraki periyotlarda etki azalır, ancak ağırlığı azalır.$75\%$

Ayrıca müdahaleleri elle yaratabilir ve stats::arimaharici regresörler olarak aktarabiliriz . Müdahaleler bir darbe artı parametresi ile geçici bir değişikliktir ve aşağıdaki gibi oluşturulabilir.$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

Yukarıdaki katsayıların tahminleri aynıdır. Burada değerini düzelttik . Matris , farklı senaryoları denemeniz gereken kukla değişken türüdür. Ayrıca için farklı değerler ayarlayabilir ve etkisini karşılaştırabilirsiniz. 0.9231 ω $\omega_2$$0.9231$xreg$\omega_2$

Bu müdahaleler, ilave bir aykırı değer aykırı değer (AO) ve pakette tanımlanan geçici bir değişikliğe (TC) eşdeğerdir tsoutliers. Bu paketi, @forecaster tarafından verilen yanıtta gösterildiği gibi bu efektleri algılamak veya daha önce kullanılan regresörleri oluşturmak için kullanabilirsiniz. Örneğin, bu durumda:

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

Düzenle 1

Verdiğiniz denklemin şu şekilde yeniden yazılabileceğini gördüm:

ve kullandığınız gibi belirtilebilir transfer=list(c(1, 1)).

Aşağıda gösterildiği gibi, bu parametreleştirme, bu durumda, önceki parametreleştirmeye kıyasla farklı bir etki içeren parametre tahminlerine yol açar. Bana nabız artı geçici bir değişimden ziyade yenilikçi bir aykırı değerlerin etkisini hatırlatıyor.

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

Paket notasyonuna çok aşina değilim TSAama müdahalenin etkisinin şu şekilde nicelendirilebileceğini düşünüyorum:

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

Etki şimdi Ekim 2013'te keskin bir artış ve ardından ters yönde bir azalma olarak tanımlanabilir; o zaman müdahalenin etkisi hızla azalan ağırlığın olumlu ve olumsuz etkilerini ortadan kaldırır.

Bu etki biraz tuhaftır, ancak gerçek verilerde mümkün olabilir. Bu noktada verilerinizin bağlamına ve verileri etkileyebilecek olaylara bakacağım. Örneğin, Ekim 2013'teki müdahaleyi açıklayabilecek bir politika değişikliği, pazarlama kampanyası, keşif ... oldu. Öyleyse, bu olayın daha önce veya bulduğumuz gibi veriler üzerinde bir etkisi olması daha mantıklı mı? ilk parametrelendirme ile?

göre, başlangıç ​​modeli daha düşük olduğu için tercih edilecektir ( karşı ). Orijinal serinin grafiği, ikinci müdahale değişkeninin ölçümündeki keskin değişikliklerle net bir uyum önermez.- $-18.94$$-15.42$

Verilerin bağlamını bilmeden, parametre ile geçici bir değişiklik içeren bir AR (1) modelinin, verileri modellemek ve müdahaleyi ölçmek için uygun olacağını söyleyebilirim .$0.9$

Düzenle 2

değeri , müdahalenin etkisinin sıfıra ne kadar hızlı belirler, bu nedenle modeldeki anahtar parametredir. Modeli değer aralığına . Aşağıda, bu modellerin her biri için AIC saklanır.ω $\omega_2$$\omega_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")

En düşük AIC, (daha önce tahmin edilen değerle uyumlu olarak). Bu parametre nispeten kalıcı ancak geçici bir etki içerir. Etkinin geçici olduğu sonucuna varabiliriz çünkü yüksek değerlerle AIC artar (unutmayın, sınırında müdahale kalıcı bir seviye kayması haline gelir).0,9 ω 2 = $\omega_2 = 0.88$$0.9$$\omega_2=1$

Müdahale tahminlere dahil edilmelidir. Daha önce gözlemlenmiş olan dönemler için tahmin almak, tahminlerin performansını değerlendirmek için yararlı bir uygulamadır. Aşağıdaki kod, serinin Ekim 2013'te sona erdiğini varsayar. Daha sonra, parametresi ile müdahale de dahil olmak üzere tahminler elde edilir .$\omega_2=0.9$

İlk olarak, AR (1) modelini bir olarak müdahaleye ( parametresi ile ):$\omega_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)))

Tahminler aşağıdaki gibi elde edilebilir ve görüntülenebilir:

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

İlk tahminler gözlemlenen değerlerle (gri noktalı çizgi) nispeten iyi eşleşir. Kalan tahminler, serinin orijinal ortalamanın yolunu nasıl sürdüreceğini gösterir. Güven aralıkları yine de belirsizliği yansıtan büyüktür. Bu nedenle, yeni veriler kaydedildikçe dikkatli olmalı ve modeli revize etmeliyiz.

$95\%$Önceki grafiğe güven aralıkları aşağıdaki gibi eklenebilir:

lines(exp(p$pred + 1.96 * p$se), lty = 2, col = "red")
lines(exp(p$pred - 1.96 * p$se), lty = 2, col = "red")

Bazen daha az. Elimizdeki 30 gözlemle, verileri geliştirmemde yardımcı olduğum bir yazılım olan AUTOBOX'a gönderdim. +200 ödülünü alma umuduyla aşağıdaki analizi yapıyorum (şaka yapıyorum!). Gerçek ve Temizlenmiş Değerleri görsel olarak "son faaliyetlerin" etkisini ima eden bir grafik çizdim. . Otomatik olarak geliştirilen model burada gösterilmektedir. ve burada . Bu oldukça basit seviye kaydırmalı seriden artıklar burada sunulmaktadır . Model istatistikleri burada . Özetle, ARIMA sürecini gerçekleştirerek ampirik olarak tanımlanabilecek müdahaleler vardı; iki darbe ve 1 seviye kaydırma . Fiili / Sığdır ve Tahmin grafiği analizi daha da vurgular.

Ben daha önce belirtilen ve bence potansiyel olarak aşırı belirtilen modellerden kalıntıların grafiğini görmek istiyorum.

$R$

Kod aşağıdadı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

Aşağıda, Ekim 2013'te ~ 481.8 standart hata ile ~ 2356.3 birim artış olduğu ve daha sonra azalan bir etkisi olduğu tahmin edilmektedir. Fonksiyon otomatik olarak AR (1) tanımladı. Birkaç yineleme yapmak ve tso işlevinde args.tsmethod'a yansıyan mevsimsel ve mevsimsel olmayan farklılığı 0 yapmak zorunda kaldım.

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

Aşağıda çizim, tsoutlier, geçici değişiklikleri bu güzel bir şekilde yazdırabildiğimi bildiğim tek paket.

Bu analiz umarım farklı bir metheoloji kullansanız da 2, 3 ve 4 sorularınıza cevap vermiştir. Özellikle arsa ve katsayılar bu müdahalenin etkisini ve bu müdahaleniz olmasaydı ne olurdu?

Ayrıca başka birisinin R'deki transfer fonksiyonu modellemesini kullanarak bu arsa / analizi çoğaltabileceğini umuyorum.