Il modo meno stupido di prevedere una breve serie temporale multivariata

Devo prevedere le seguenti 4 variabili per la 29a unità di tempo. Ho circa 2 anni di dati storici, in cui 1, 14 e 27 sono tutti dello stesso periodo (o periodo dell'anno). Alla fine, sto facendo una decomposizione in stile Oaxaca-Blinder su , , e .$W$$wd$$wc$$p$

time    W               wd              wc               p
1       4.920725        4.684342        4.065288        .5962985
2       4.956172        4.73998         4.092179        .6151785
3       4.85532         4.725982        4.002519        .6028712
4       4.754887        4.674568        3.988028        .5943888
5       4.862039        4.758899        4.045568        .5925704
6       5.039032        4.791101        4.071131        .590314
7       4.612594        4.656253        4.136271        .529247
8       4.722339        4.631588        3.994956        .5801989
9       4.679251        4.647347        3.954906        .5832723
10      4.736177        4.679152        3.974465        .5843731
11      4.738954        4.759482        4.037036        .5868722
12      4.571325        4.707446        4.110281        .556147
13      4.883891        4.750031        4.168203        .602057
14      4.652408        4.703114        4.042872        .6059471
15      4.677363        4.744875        4.232081        .5672519
16      4.695732        4.614248        3.998735        .5838578
17      4.633575        4.6025          3.943488        .5914644
18      4.61025         4.67733         4.066427        .548952
19      4.678374        4.741046        4.060458        .5416393
20      4.48309         4.609238        4.000201        .5372143
21      4.477549        4.583907        3.94821         .5515663
22      4.555191        4.627404        3.93675         .5542806
23      4.508585        4.595927        3.881685        .5572687
24      4.467037        4.619762        3.909551        .5645944
25      4.326283        4.544351        3.877583        .5738906
26      4.672741        4.599463        3.953772        .5769604
27      4.53551         4.506167        3.808779        .5831352
28      4.528004        4.622972        3.90481         .5968299

Credo che possa essere approssimato da più errore di misura, ma si può vedere che supera sempre considerevolmente quella quantità a causa di spreco, errore di approssimazione o furto.$W$$p\cdot wd + (1 - p)\cdot wc$$W$

Ecco le mie 2 domande.

1. Il mio primo pensiero è stato quello di provare l'autoregressione vettoriale su queste variabili con 1 ritardo e una variabile di tempo e periodo esogena, ma sembra una cattiva idea, dato il numero limitato di dati che ho. Esistono metodi di serie temporali che (1) funzionano meglio di fronte alla "micro-numerosità" e (2) sarebbero in grado di sfruttare il legame tra le variabili?

2. D'altra parte, i moduli degli autovalori per il VAR sono tutti meno di 1, quindi non credo di dovermi preoccupare della non stazionarietà (sebbene il test Dickey-Fuller suggerisca diversamente). Le previsioni sembrano per lo più in linea con le proiezioni di un modello univariato flessibile con una tendenza temporale, ad eccezione di e , che sono inferiori. I coefficienti sui ritardi sembrano per lo più ragionevoli, sebbene per la maggior parte siano insignificanti. Il coefficiente di tendenza lineare è significativo, così come alcuni dei manichini del periodo. Tuttavia, ci sono ragioni teoriche per preferire questo approccio più semplice rispetto al modello VAR?$W$$p$

Divulgazione completa: ho fatto una domanda simile su Statalist senza risposta.

Comprendo che questa domanda è rimasta qui da anni, ma le seguenti idee possono essere utili:

1. Se ci sono collegamenti tra variabili (e la formula teorica non funziona così bene), PCA può essere utilizzato per cercare dipendenze (lineari) in modo sistematico. Mostrerò che questo funziona bene per i dati forniti in questa domanda.

2. Dato che non ci sono molti dati (112 numeri in totale), è possibile stimare solo alcuni parametri del modello ( ad es. Adattarsi a effetti stagionali completi non è un'opzione) e provare un modello personalizzato può avere senso.

Ecco come farei una previsione, seguendo questi principi:

Passaggio 1. Possiamo usare PCA per rivelare dipendenze nei dati. Utilizzando R, con i dati memorizzati in x:

> library(jvcoords)
> m <- PCA(x)
> m
PCA: mapping p = 4 coordinates to q = 4 coordinates

                              PC1         PC2          PC3          PC4
standard deviation     0.18609759 0.079351671 0.0305622047 0.0155353709
variance               0.03463231 0.006296688 0.0009340484 0.0002413477
cum. variance fraction 0.82253436 0.972083769 0.9942678731 1.0000000000

$W = 0.234\, wd - 1.152\, wc - 8.842 \,p$

$4\times 4$

Passaggio 2. Vi è una chiara tendenza in PC1:

> t <- 1:28
> plot(m$y[,1], type = "b", ylab = "PC1")
> trend <- lm(m$y[,1] ~ t)
> abline(trend)

Creo una copia dei punteggi del PC con questa tendenza rimossa:

> y2 <- m$y
> y2[,1] <- y2[,1] - fitted(trend)

Tracciare i punteggi degli altri PC non rivela tendenze chiare, quindi le lascio invariate.

Poiché i punteggi del PC sono centrati, la tendenza passa attraverso il centro di massa del campione PC1 e l'adattamento della tendenza corrisponde solo alla stima di un parametro.

Passaggio 3. Un diagramma a dispersione di coppia non mostra una struttura chiara, quindi modello i PC come indipendenti:

> pairs(y2, asp = 1, oma = c(1.7, 1.7, 1.7, 1.7))

Passaggio 4. Vi è una chiara periodicità in PC1, con ritardo 13 (come suggerito dalla domanda). Questo può essere visto in diversi modi. Ad esempio, l'autocorrelazione del ritardo 13 risulta significativamente diversa da 0 in un correlogramma:

> acf(y2[,1])

(La periodicità è visivamente più evidente quando si tracciano i dati insieme a una copia spostata.)

$y^{(1)}_{t+13} = \alpha_{13} y^{(1)}_t + \sigma \varepsilon_{t+13}$$\varepsilon_t$$\alpha_{13}$$\sigma$lm()

> lag13 <- lm(y2[14:28,1] ~ y2[1:15,1] + 0)
> lag13

Call:
lm(formula = y2[14:28, 1] ~ y2[1:15, 1] + 0)

Coefficients:
y2[1:15, 1]  
     0.6479  

> a13 <- coef(lag13)
> s13 <- summary(lag13)$sigma

Come test di plausibilità, tracciamo i dati dati (nero), insieme a una traiettoria casuale del mio modello per PC1 (blu), che va da un anno al futuro:

t.f <- 29:41
pc1 <- m$y[,1]
pc1.f <- (predict(trend, newdata = data.frame(t = t.f))
          + a13 * y2[16:28, 1]
          + rnorm(13, sd = s13))
plot(t, pc1, xlim = range(t, t.f), ylim = range(pc1, pc1.f),
     type = "b", ylab = "PC1")
points(t.f, pc1.f, col = "blue", type = "b")

Il pezzo di percorso simulato blu sembra una ragionevole continuazione dei dati. I correlogrammi per PC2 e PC3 non mostrano correlazioni significative, quindi modello questi componenti come rumore bianco. PC4 mostra correlazioni, ma contribuisce così poco alla varianza totale che sembra non valga la pena modellarlo, e modello anche questo componente come rumore bianco.

Qui abbiamo inserito altri due parametri. Questo ci porta a un totale di nove parametri nel modello (incluso il PCA), che non sembra assurdo quando abbiamo iniziato con dati costituiti da 112 numeri.

Previsione. Possiamo ottenere una previsione numerica tralasciando il rumore (per ottenere la media) e invertendo il PCA:

> pc1.f <- predict(trend, newdata = data.frame(t = t.f)) + a13 * y2[16:28, 1]
> y.f <- data.frame(PC1 = pc1.f, PC2 = 0, PC3 = 0, PC4 = 0)
> x.f <- fromCoords(m, y.f)
> rownames(x.f) <- t.f
> x.f
          W       wd       wc         p
29 4.456825 4.582231 3.919151 0.5616497
30 4.407551 4.563510 3.899012 0.5582053
31 4.427701 4.571166 3.907248 0.5596139
32 4.466062 4.585740 3.922927 0.5622955
33 4.327391 4.533055 3.866250 0.5526018
34 4.304330 4.524294 3.856824 0.5509898
35 4.342835 4.538923 3.872562 0.5536814
36 4.297404 4.521663 3.853993 0.5505056
37 4.281638 4.515673 3.847549 0.5494035
38 4.186515 4.479533 3.808671 0.5427540
39 4.377147 4.551959 3.886586 0.5560799
40 4.257569 4.506528 3.837712 0.5477210
41 4.289875 4.518802 3.850916 0.5499793

Le bande di incertezza possono essere ottenute analiticamente o semplicemente usando Monte Carlo:

N <- 1000 # number of Monte Carlo samples
W.f <- matrix(NA, N, 13)
for (i in 1:N) {
    y.f <- data.frame(PC1 = (predict(trend, newdata = data.frame(t = t.f))
              + a13 * y2[16:28, 1]
              + rnorm(13, sd = s13)),
              PC2 = rnorm(13, sd = sd(y2[,2])),
              PC3 = rnorm(13, sd = sd(y2[, 3])),
              PC4 = rnorm(13, sd = sd(y2[, 4])))
    x.f <- fromCoords(m, y.f)
    W.f[i,] <- x.f[, 1]
}
bands <- apply(W.f, 2,
               function(x) quantile(x, c(0.025, 0.15, 0.5, 0.85, 0.975)))
plot(t, x$W, xlim = range(t, t.f), ylim = range(x$W, bands),
     type = "b", ylab = "W")
for (b in 1:5) {
    lines(c(28, t.f), c(x$W[28], bands[b,]), col = "grey")
}

$W$