ฟังก์ชันการแทรกแซงการถ่ายโอน ARIMA - วิธีการแสดงผล

ฉันมีชุดเวลารายเดือนที่มีการแทรกแซงและฉันต้องการที่จะหาปริมาณผลกระทบของการแทรกแซงนี้ในผล ฉันรู้ว่าซีรี่ส์ค่อนข้างสั้นและยังไม่ได้สรุปผล

ข้อมูล

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) ซีรี่ส์ก่อนการแทรกแซง (จนถึงตุลาคม 2013) ถูกใช้กับauto.arimaฟังก์ชัน รูปแบบที่แนะนำคือ 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

ซึ่งเป็นไปตาม 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) ฉันถามวิธีการทำงานกับสมการของแบบจำลอง - ถ้านี่เป็นการถดถอยเชิงเส้นอย่างง่ายพร้อมตัวแปรดัมมี่ (ตัวอย่าง) ฉันสามารถเรียกใช้สถานการณ์ที่มีและไม่มีการแทรกแซงและวัดผลกระทบ - แต่ฉันแค่ไม่แน่ใจว่าจะใช้รูปแบบนี้ได้อย่างไร

เพิ่ม

ต่อคำขอนี่คือส่วนที่เหลือจากทั้งสอง parametrizations

ก่อนจากความพอดี:

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

แบบจำลอง 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

$\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

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

$\omega_2$$1$$\omega_2$$1$

ตัวเลขเหล่านี้คือจำนวนที่เพิ่มขึ้นโดยประมาณในแต่ละช่วงเวลาที่เกิดจากการแทรกแซงในเดือนตุลาคม 2556:

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

$\omega_2$$0.9231$xreg$\omega_2$

การแทรกแซงเหล่านี้จะเทียบเท่ากับขอบเขตสารเติมแต่ง (AO) และการเปลี่ยนแปลงชั่วคราว (TC) tsoutliersที่กำหนดไว้ในแพคเกจ คุณสามารถใช้แพ็คเกจนี้เพื่อตรวจหาเอฟเฟกต์เหล่านี้ดังที่แสดงในคำตอบโดย @forecaster หรือสร้าง regressors ที่ใช้ก่อนหน้านี้ ตัวอย่างเช่นในกรณีนี้:

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

ฉันได้เห็นว่าสมการที่คุณให้สามารถเขียนใหม่เป็น:

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

ผลกระทบสามารถอธิบายได้ในขณะนี้ว่าเพิ่มขึ้นอย่างมากในเดือนตุลาคม 2556 ตามด้วยการลดลงในทิศทางตรงกันข้าม จากนั้นผลของการแทรกแซงก็หายไปอย่างรวดเร็วสลับผลบวกและลบของน้ำหนักเนื้อที่

ผลกระทบนี้ค่อนข้างแปลก แต่อาจเป็นไปได้ในข้อมูลจริง ณ จุดนี้ฉันจะดูบริบทของข้อมูลของคุณและเหตุการณ์ที่อาจส่งผลกระทบต่อข้อมูล ตัวอย่างเช่นมีการเปลี่ยนแปลงนโยบายแคมเปญการตลาดการค้นพบ ... ที่อาจอธิบายถึงการแทรกแซงในเดือนตุลาคม 2556 หากเป็นเช่นนั้นเป็นเรื่องที่สมเหตุสมผลหรือไม่ที่เหตุการณ์นี้มีผลต่อข้อมูลตามที่อธิบายไว้ก่อนหน้านี้หรือตามที่เราพบ ด้วยการตั้งค่าเริ่มต้น?

$-18.94$$-15.42$

$0.9$

แก้ไข 2

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

$\omega_2 = 0.88$$0.9$$\omega_2=1$

$\omega_2=0.9$

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

การคาดการณ์สามารถรับและแสดงดังนี้:

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

บางครั้งก็น้อยมาก ด้วยการสังเกต 30 ครั้งในมือฉันส่งข้อมูลไปยัง AUTOBOX ซึ่งเป็นชิ้นส่วนของซอฟต์แวร์ที่ฉันได้ช่วยพัฒนา ฉันส่งการวิเคราะห์ต่อไปนี้โดยหวังว่าจะได้รางวัล +200 (ล้อเล่น!) ฉันได้วางแผนค่าที่เกิดขึ้นจริงและชำระแล้วเพื่อเป็นการชี้ให้เห็นถึงผลกระทบของ "กิจกรรมล่าสุด" . รูปแบบที่ได้รับการพัฒนาโดยอัตโนมัติจะแสดงที่นี่ และที่นี่ เหลือจากชุดระดับขยับตัวนี้ค่อนข้างง่ายนำเสนอที่นี่ สถิติรูปแบบอยู่ที่นี่ โดยสรุปมีการแทรกแซงที่สามารถระบุการแสดงผลกระบวนการ ARIMA; สองพัลส์และ 1 กะระดับ กราฟที่เกิดขึ้นจริง / พอดีและการคาดการณ์เน้นการวิเคราะห์ต่อไป

ฉันคนหนึ่งอยากจะเห็นพล็อตของส่วนที่เหลือจากที่ระบุไว้ก่อนหน้านี้และในความคิดของฉันแบบจำลองที่อาจระบุมากเกินไป

$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

ด้านล่างคือการประมาณการมีการเพิ่มขึ้น ~ 2356.3 หน่วยในเดือนตุลาคม 2013 โดยมีข้อผิดพลาดมาตรฐานที่ ~ 481.8 และมีผลในการสลายตัวหลังจากนั้น ฟังก์ชั่นระบุ AR อัตโนมัติ (1) ฉันต้องทำซ้ำสองครั้งและทำทั้งความแตกต่างของฤดูกาลและไม่ใช่ฤดูกาลที่ 0 ซึ่งสะท้อนให้เห็นใน args.tsmethod ในฟังก์ชัน tso

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, 3และ4 ของคุณแม้ว่าจะใช้ methdeology อื่น โดยเฉพาะพล็อตและค่าสัมประสิทธิ์ให้ผลของการแทรกแซงนี้และสิ่งที่จะเกิดขึ้นหากคุณไม่ได้มีการแทรกแซงนี้

ยังหวังว่าคนอื่นจะสามารถทำซ้ำพล็อต / การวิเคราะห์นี้ได้โดยใช้ฟังก์ชั่นการถ่ายโอนแบบจำลองในอาร์ฉันไม่แน่ใจว่าสิ่งนี้สามารถทำได้ใน R หรือไม่อาจเป็นคนอื่นที่สามารถตรวจสอบฉันได้