Funzione di trasferimento di intervento ARIMA - Come visualizzare l'effetto

Ho una serie temporale mensile con un intervento e vorrei quantificare l'effetto di questo intervento sul risultato. Mi rendo conto che la serie è piuttosto breve e l'effetto non è ancora concluso.

I dati

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

La metodologia

1) Le serie pre-intervento (fino a ottobre 2013) sono state utilizzate con la auto.arimafunzione. Il modello suggerito era ARIMA (1,0,0) con media diversa da zero. La trama di ACF sembrava buona.

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) Vista la trama dell'intera serie, la risposta all'impulso è stata scelta di seguito, con T = Ott 2013,

che secondo cryer e chan può essere adattato come segue con la funzione 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

I residui di questo apparivano OK:

La trama di montato e attuali:

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

Le domande

1) Questa metodologia è corretta per l'analisi di intervento?

2) Posso guardare la stima / SE per i componenti della funzione di trasferimento e dire che l'effetto dell'intervento è stato significativo?

3) Come si può visualizzare l'effetto della funzione di trasferimento (tracciarlo?)

4) C'è un modo per stimare di quanto l'intervento ha aumentato l'output dopo 'x' mesi? Immagino per questo (e forse il n. 3) chiedo come lavorare con un'equazione del modello - se questa fosse una semplice regressione lineare con variabili fittizie (ad esempio) potrei eseguire scenari con e senza l'intervento e misurare l'impatto - ma non sono sicuro di come lavorare questo tipo di modello.

INSERISCI

Per richiesta, ecco i residui delle due parametrizzazioni.

Prima dalla vestibilità:

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

Quindi, da questo attacco

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

Un modello AR (1) con l'intervento definito nell'equazione data nella domanda può essere montato come mostrato di seguito. Notare come transferviene definito l'argomento ; è inoltre necessaria una variabile indicatore xtransfper ciascuno degli interventi (l'impulso e il cambiamento transitorio):

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

È possibile verificare il significato di ciascun intervento osservando la statistica t dei coefficienti e . Per comodità, è possibile utilizzare la funzione .ω $\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

In questo caso l'impulso non è significativo al livello di significatività del . Il suo effetto può essere già acquisito dal cambiamento transitorio.$5\%$

L'effetto di intervento può essere quantificato come segue:

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)

È possibile tracciare l'effetto dell'intervento come segue:

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

L'effetto è relativamente persistente perché è vicino a (se fosse uguale a osserveremmo uno spostamento di livello permanente). 1 ω 2$\omega_2$$1$$\omega_2$$1$

Numericamente, si tratta degli aumenti stimati quantificati in ciascun momento causato dall'intervento nell'ottobre 2013:

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

L'intervento aumenta il valore della variabile osservata nell'ottobre 2013 di circa il . Nei periodi successivi l'effetto rimane ma con un peso decrescente.$75\%$

Potremmo anche creare gli interventi a mano e passarli a stats::arimaregressori esterni. Gli interventi sono un impulso più una variazione transitoria con il parametro e possono essere costruiti come segue.$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

Si ottengono le stesse stime dei coefficienti di cui sopra. Qui abbiamo corretto a . La matrice è il tipo di variabile fittizia di cui potresti aver bisogno per provare diversi scenari. È inoltre possibile impostare valori diversi per e confrontarne l'effetto. 0,9231 ω $\omega_2$$0.9231$xreg$\omega_2$

Questi interventi equivalgono a un valore anomalo additivo (AO) e un cambiamento transitorio (TC) definito nel pacchetto tsoutliers. È possibile utilizzare questo pacchetto per rilevare questi effetti come mostrato nella risposta di @forecaster o per creare i regressori utilizzati in precedenza. Ad esempio, in questo caso:

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

Modifica 1

Ho visto che l'equazione che hai dato può essere riscritta come:

e può essere specificato come hai fatto usando transfer=list(c(1, 1)).

Come mostrato di seguito, questa parametrizzazione porta, in questo caso, a stime di parametri che comportano un effetto diverso rispetto alla parametrizzazione precedente. Mi ricorda l'effetto di un outlier innovativo piuttosto che un impulso più un cambiamento transitorio.

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

Non ho molta familiarità con la notazione del pacchetto, TSAma penso che l'effetto dell'intervento ora possa essere quantificato come segue:

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

L'effetto può ora essere descritto come un forte aumento nell'ottobre 2013 seguito da una diminuzione nella direzione opposta; quindi l'effetto dell'intervento svanisce rapidamente alternando gli effetti positivi e negativi del decadimento del peso.

Questo effetto è alquanto peculiare ma potrebbe essere possibile in dati reali. A questo punto esaminerei il contesto dei tuoi dati e gli eventi che potrebbero aver influito sui dati. Ad esempio, c'è stato un cambiamento di politica, una campagna di marketing, una scoperta, ... che potrebbe spiegare l'intervento nell'ottobre 2013. In tal caso, è più sensato che questo evento abbia un effetto sui dati come descritto prima o come abbiamo trovato con la parametrizzazione iniziale?

Secondo l'AIC, il modello iniziale sarebbe preferito perché è più basso ( contro ). La trama della serie originale non suggerisce una chiara corrispondenza con i bruschi cambiamenti coinvolti nella misurazione della seconda variabile di intervento.- $-18.94$$-15.42$

Senza conoscere il contesto dei dati, direi che un modello AR (1) con una modifica transitoria con il parametro sarebbe appropriato per modellare i dati e misurare l'intervento.$0.9$

Modifica 2

Il valore di determina la velocità con cui l'effetto dell'intervento decade a zero, quindi questo è il parametro chiave nel modello. Possiamo ispezionarlo adattando il modello per un intervallo di valori di . Di seguito, l'AIC è memorizzato per ciascuno di questi modelli.ω $\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")

L'AIC più basso si trova per (in accordo con il valore stimato prima). Questo parametro comporta un effetto relativamente persistente ma transitorio. Possiamo concludere che l'effetto è temporaneo poiché con valori superiori a aumenta l'AIC (ricorda che nel limite, , l'intervento diventa uno spostamento di livello permanente).0,9 ω 2 = $\omega_2 = 0.88$$0.9$$\omega_2=1$

L'intervento dovrebbe essere incluso nelle previsioni. Ottenere previsioni per periodi che sono già stati osservati è un esercizio utile per valutare le prestazioni delle previsioni. Il codice seguente presuppone che la serie finisca nell'ottobre 2013. Vengono quindi ottenute le previsioni includendo l'intervento con il parametro .$\omega_2=0.9$

Innanzitutto adattiamo il modello AR (1) all'intervento come regressore (con parametro ):$\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)))

Le previsioni possono essere ottenute e visualizzate come segue:

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

Le prime previsioni corrispondono relativamente bene ai valori osservati (linea tratteggiata grigia). Le restanti previsioni mostrano come la serie continuerà il percorso verso la media originale. Gli intervalli di confidenza sono comunque ampi, riflettendo l'incertezza. Dovremmo quindi essere prudenti e rivedere il modello man mano che vengono registrati nuovi dati.

$95\%$ intervalli di confidenza al possono essere aggiunti al grafico precedente come segue:

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

A volte meno è di più. Con 30 osservazioni in mano ho inviato i dati ad AUTOBOX, un software che ho aiutato a sviluppare. Inoltro la seguente analisi nella speranza di ottenere il premio +200 (sto solo scherzando!). Ho tracciato i valori effettivi e purificati suggerendo visivamente l'impatto di "attività recenti". . Il modello che è stato sviluppato automaticamente è mostrato qui. e qui . I residui di questa serie piuttosto semplice spostata di livello sono presentati qui . Le statistiche del modello sono qui . In sintesi ci sono stati interventi che potevano essere identificati empiricamente rendendo un processo ARIMA; due impulsi e 1 spostamento di livello . Il grafico Attuale / Adatta e Previsione evidenzia ulteriormente l'analisi.

Per quanto mi riguarda, vorrei vedere la trama dei residui dai modelli precedentemente specificati e, a mio avviso, potenzialmente troppo specificati.

Sulla base del mio post simile alla tua domanda precedente, ho usato la funzione tso nel pacchetto tsoutliers in e ha rilevato automaticamente una modifica temporanea a ottobre 2013. Nota che la modifica temporanea è diversa dalla rampa di spostamento nella funzione di trasferimento che è ciò che stai cercando. Non penso che ci sia un pacchetto / funzione di cui sono a conoscenza che sarebbe in grado di visualizzare la funzione di trasferimento. Spero che ciò possa fornire alcune intuizioni. Non ho usato la trasformazione del log, l'ho modellata direttamente. Il pacchetto tsoutliers può essere considerato come un rilevamento di intervento automatico.$R$

Di seguito è riportato il codice:

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

Di seguito è riportata la stima, vi è stato un aumento di ~ 2356,3 unità nell'ottobre 2013 con un errore standard di ~ 481,8 e ha successivamente un effetto di decadimento. La funzione ha identificato automaticamente AR (1). Ho dovuto fare un paio di iterazioni e portare la differenza stagionale e non stagionale a 0, che si riflette nel metodo args.ts nella funzione 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

Di seguito è riportata la trama, più semplice è l'unico pacchetto che conosco che può stampare cambiamenti temporanei così bene in una trama.

Si spera che questa analisi abbia fornito una risposta alle tue 2, 3 e 4 domande, sebbene utilizzando una diversa metdeologia. Soprattutto la trama e i coefficienti hanno fornito l'effetto di questo intervento e cosa sarebbe successo se non avessi avuto questo intervento.

Spero anche che qualcun altro possa replicare questo diagramma / analisi usando la modellazione della funzione di trasferimento in R. Non sono sicuro che ciò possa essere fatto in R, forse qualcun altro può effettivamente controllarmi su questo.