Maneira menos estúpida de prever uma série temporal curta e multivariada

Preciso prever as seguintes 4 variáveis ​​para a 29ª unidade de tempo. Eu tenho aproximadamente 2 anos de dados históricos, onde 1, 14 e 27 são todos do mesmo período (ou época do ano). No final, estou fazendo uma decomposição no estilo Oaxaca-Blinder em $W$ , , e .w c $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

Acredito que $W$ pode ser aproximada por $p\cdot wd + (1 - p)\cdot wc$ além de erros de medição, mas você pode ver que $W$ sempre excede consideravelmente a quantidade por causa de resíduos, erro de aproximação, ou roubo.

Aqui estão as minhas 2 perguntas.

1. Meu primeiro pensamento foi tentar a auto-regressão vetorial nessas variáveis ​​com 1 lag e uma variável exógena de tempo e período, mas isso parece uma péssima ideia, dada a pouca quantidade de dados que tenho. Existem métodos de séries temporais que (1) tenham um desempenho melhor diante da "microinumerosidade" e (2) possam explorar o vínculo entre as variáveis?

2. Por outro lado, os módulos dos autovalores para o VAR são todos menores que 1, então não acho que precise me preocupar com não estacionariedade (embora o teste de Dickey-Fuller sugira o contrário). As previsões parecem principalmente alinhadas às projeções de um modelo univariado flexível com uma tendência temporal, exceto e p , que são mais baixos. Os coeficientes nos atrasos parecem razoavelmente razoáveis, embora na maioria sejam insignificantes. O coeficiente de tendência linear é significativo, assim como alguns dos manequins do período. Ainda assim, existem razões teóricas para preferir essa abordagem mais simples do que o modelo VAR?$W$$p$

Divulgação completa: fiz uma pergunta semelhante no Statalist sem resposta.

Entendo que essa pergunta está aqui há anos, mas ainda assim, as seguintes idéias podem ser úteis:

1. Se houver links entre variáveis ​​(e a fórmula teórica não funcionar tão bem), o PCA poderá ser usado para procurar dependências (lineares) de maneira sistemática. Vou mostrar que isso funciona bem para os dados fornecidos nesta pergunta.

2. Dado que não há muitos dados (112 números no total), apenas alguns parâmetros do modelo podem ser estimados ( por exemplo, ajustar efeitos sazonais completos não é uma opção), e tentar um modelo personalizado pode fazer sentido.

Aqui está como eu faria uma previsão, seguindo estes princípios:

Passo 1. Podemos usar o PCA para revelar dependências nos dados. Usando R, com os dados armazenados em 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$

Etapa 2. Há uma tendência clara no PC1:

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

Crio uma cópia das pontuações do PC com essa tendência removida:

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

A plotagem das pontuações dos outros PCs não revela tendências claras, então eu as deixo inalteradas.

Como as pontuações do PC são centralizadas, a tendência passa pelo centro de massa da amostra PC1 e o ajuste da tendência corresponde apenas à estimativa de um parâmetro.

Etapa 3. Um gráfico de dispersão de pares não mostra uma estrutura clara, então eu modelo os PCs como independentes:

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

Etapa 4. Há uma periodicidade clara no PC1, com atraso 13 (conforme sugerido pela pergunta). Isso pode ser visto de diferentes maneiras. Por exemplo, a autocorrelação do atraso 13 mostra-se significativamente diferente de 0 em um correlograma:

> acf(y2[,1])

(A periodicidade é visualmente mais impressionante ao plotar os dados junto com uma cópia deslocada.)

$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

Como teste de plausibilidade, planto os dados fornecidos (preto), juntamente com uma trajetória aleatória do meu modelo para PC1 (azul), variando um ano no 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")

O trecho azul simulado do caminho parece uma continuação razoável dos dados. Os correlogramas para PC2 e PC3 não mostram correlações significativas, então eu modelo esses componentes como ruído branco. O PC4 mostra correlações, mas contribui tão pouco para a variação total que parece não valer a pena modelar, e eu também modelo esse componente como ruído branco.

Aqui nós ajustamos mais dois parâmetros. Isso nos leva a um total de nove parâmetros no modelo (incluindo o PCA), o que não parece absurdo quando começamos com dados que consistem em 112 números.

Previsão. Podemos obter uma previsão numérica deixando de fora o ruído (para obter a média) e revertendo o 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

As faixas de incerteza podem ser obtidas analiticamente ou simplesmente 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$