R Notebook
Programa de Pós-Graduação em Economia
Econometria de Séries Temporais
Aluno: Vitor Nayron
Prof. Dr. Cássio Besarria
O objetivo do Exercício 5 é realizar o teste de quebra estrutural a partir de séries simuladas pelo método de Monte Carlo e, posteriormente, em uma série temporal com dados reais.
Criação de uma série com 1 quebra estrutural
# Limpando o R
rm(list=ls(all=TRUE))
# Pacotes Necessários
library(tseries)## Warning: package 'tseries' was built under R version 4.2.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(strucchange)## Warning: package 'strucchange' was built under R version 4.2.3## Carregando pacotes exigidos: zoo## Warning: package 'zoo' was built under R version 4.2.3##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Carregando pacotes exigidos: sandwich## Warning: package 'sandwich' was built under R version 4.2.3library(ggplot2)## Warning: package 'ggplot2' was built under R version 4.2.3library(urca)## Warning: package 'urca' was built under R version 4.2.3library(readxl)## Warning: package 'readxl' was built under R version 4.2.3# Número de observações
n <- 300
# Posição da quebra estrutural
breakpoint <- 150
# Simular uma série temporal com uma mudança na média na posição do breakpoint
set.seed(123) # Para reprodutibilidade
series <- c(rnorm(breakpoint, mean = 0, sd = 1), rnorm(n - breakpoint, mean = 3, sd = 1))
# Criando um data frame para ggplot2
data <- data.frame(Time = 1:n, Value = series)
# Criar o gráfico com ggplot2
ggplot(data, aes(x = Time, y = Value)) +
geom_line(color = "blue") +
geom_vline(xintercept = breakpoint, color = "red", linetype = "dashed", size = 0.5) +
annotate("rect", xmin = breakpoint - 1, xmax = breakpoint + 1, ymin = min(series), ymax = max(series),
alpha = 0.01, fill = "red") +
labs(title = "Série Temporal com Quebra Estrutural - Posição 150",
x = "Tempo",
y = "Valor",
fill = "Legenda") +
theme_minimal() +
theme(legend.position = "bottom") +
annotate("text", x = breakpoint + 20, y = max(series), label = "Quebra Estrutural", color = "red", hjust = 0) +
scale_fill_manual(values = c("red"), labels = c("Área de Quebra Estrutural"))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Teste de Chow
#Teste de Chow
# Ajustar um modelo de regressão linear
model <- lm(Value ~ Time, data = data)
breakpoint_time <- breakpoint
test_result <- sctest(model, type = "Chow", point = breakpoint_time)
# Exibir os resultados do teste
print(test_result) #Há quebra estrutural##
## M-fluctuation test
##
## data: model
## f(efp) = 2.7097, p-value = 1.677e-06Como o p-valor do teste de Chow é muito próximo de 0, há evidências fortes de quebra estrutural no ponto 150 da série temporal simulada.
Teste de Perron
# Realizar o teste de Perron para a quebra estrutural
test_result_perron <- ur.pp(series, type = "Z-tau", model = "trend", lags = "short")
# Exibir os resultados do teste
summary(test_result_perron) #há quebra estrutural ##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.0344 -0.7349 -0.0570 0.6421 4.4930
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.964457 0.105414 9.149 < 2e-16 ***
## y.l1 0.375084 0.053888 6.960 2.19e-11 ***
## trend 0.009704 0.001135 8.550 6.67e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.15 on 296 degrees of freedom
## Multiple R-squared: 0.6049, Adjusted R-squared: 0.6022
## F-statistic: 226.6 on 2 and 296 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -12.4402
##
## aux. Z statistics
## Z-tau-mu 5.8423
## Z-tau-beta 9.1790
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.992267 -3.426308 -3.136072Os valores críticos para o teste de Perron são:
1% -> - 3,99
5% -> -3,42
10% -> -3,13
Como o resultado do teste foi de -12,44. Diante disso, há evidência de quebra estrutural na série.
Teste de Zivot-Andrews
# Teste de Zivot
test_result_za <- ur.za(series, model = "both", lag = 1)
# Exibir os resultados do teste
summary(test_result_za)##
## ################################
## # Zivot-Andrews Unit Root Test #
## ################################
##
##
## Call:
## lm(formula = testmat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.1098 -0.6769 -0.1004 0.6118 3.0824
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.201182 0.159653 1.260 0.2086
## y.l1 -0.152664 0.081136 -1.882 0.0609 .
## trend -0.002932 0.001826 -1.605 0.1095
## y.dl1 0.104069 0.056914 1.829 0.0685 .
## du 3.659011 0.331139 11.050 <2e-16 ***
## dt 0.004769 0.002573 1.854 0.0648 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.9439 on 292 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.7366, Adjusted R-squared: 0.7321
## F-statistic: 163.4 on 5 and 292 DF, p-value: < 2.2e-16
##
##
## Teststatistic: -14.2066
## Critical values: 0.01= -5.57 0.05= -5.08 0.1= -4.82
##
## Potential break point at position: 150Como resultado, o teste de Zivot-Andrews indicou a quebra estrutural exatamente no ponto 150 da série temporal simulada.
Criação de uma série com 2 quebras estruturais
Na sequência, foi simulada uma segunda série temporal com 300 observações, mas com duas quebras estruturais: uma no ponto 150 e outra no ponto 250.
# Número de observações
n1 <- 300
# Posições das quebras estruturais
breakpoint1 <- 150
breakpoint2 <- 250
# Simular uma série temporal com duas mudanças na média nas posições dos breakpoints
set.seed(123) # Para reprodutibilidade
series1 <- c(rnorm(breakpoint1, mean = 0, sd = 1),
rnorm(breakpoint2 - breakpoint1, mean = 3, sd = 1),
rnorm(n1 - breakpoint2, mean = -2, sd = 1))
# Criando um data frame para ggplot2
data1 <- data.frame(Time = 1:n1, Value = series1)
# Criar o gráfico com ggplot2
ggplot(data1, aes(x = Time, y = Value)) +
geom_line(color = "blue") +
geom_vline(xintercept = c(breakpoint1, breakpoint2), color = "red", linetype = "dashed", size = 0.5) +
annotate("rect", xmin = breakpoint1 - 2, xmax = breakpoint1 + 2, ymin = min(series1), ymax = max(series1),
alpha = 0.2, fill = "red") +
annotate("rect", xmin = breakpoint2 - 2, xmax = breakpoint2 + 2, ymin = min(series1), ymax = max(series1),
alpha = 0.2, fill = "red") +
labs(title = "Série Temporal com Duas Quebras Estruturais",
x = "Tempo",
y = "Valor") +
theme_minimal() +
theme(legend.position = "bottom") +
annotate("text", x = breakpoint1 + 10, y = max(series1), label = "Quebra Estrutural 1", color = "red", hjust = 0) +
annotate("text", x = breakpoint2 + 10, y = max(series1), label = "Quebra Estrutural 2", color = "red", hjust = 0)
Teste de Chow
#Teste de Chow
# Ajustar um modelo de regressão linear
model1 <- lm(Value ~ Time, data = data1)
#Quebra 1
breakpoint_time1 <- breakpoint1
test_result1 <- sctest(model1, type = "Chow", point = breakpoint_time1)
# Exibir os resultados do teste
print(test_result1) #Há quebra estrutural##
## M-fluctuation test
##
## data: model1
## f(efp) = 5.1383, p-value < 2.2e-16#Quebra 2
breakpoint_time2 <- breakpoint2
test_result2 <- sctest(model1, type = "Chow", point = breakpoint_time2)
# Exibir os resultados do teste
print(test_result2) #Há quebra estrutural##
## M-fluctuation test
##
## data: model1
## f(efp) = 5.1383, p-value < 2.2e-16O teste de Chow apresentou evidência de quebra estrutural no ponto testado (150). Entretando, ao tentar testar a quebra no ponto 250, o resultado da estatística de teste e o p-valor apresentou o mesmo valor.
Teste de Perron
# Realizar o teste de Perron para a quebra estrutural
test_result_perron1 <- ur.pp(series1, type = "Z-tau", model = "trend", lags = "short")
# Exibir os resultados do teste
summary(test_result_perron) #há quebra estrutural ##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.0344 -0.7349 -0.0570 0.6421 4.4930
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.964457 0.105414 9.149 < 2e-16 ***
## y.l1 0.375084 0.053888 6.960 2.19e-11 ***
## trend 0.009704 0.001135 8.550 6.67e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.15 on 296 degrees of freedom
## Multiple R-squared: 0.6049, Adjusted R-squared: 0.6022
## F-statistic: 226.6 on 2 and 296 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -12.4402
##
## aux. Z statistics
## Z-tau-mu 5.8423
## Z-tau-beta 9.1790
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.992267 -3.426308 -3.136072Para o teste de Perron, o resultado também apresentou evidência de quebra estrutural na série temporal simulada.
Teste de Zivot-Andrews
# Teste de Zivot
test_result_za1 <- ur.za(series1, model = "both", lag = 1)
# Exibir os resultados do teste
summary(test_result_za1) #Detectou apenas uma das quebras (a mais forte)##
## ################################
## # Zivot-Andrews Unit Root Test #
## ################################
##
##
## Call:
## lm(formula = testmat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.8738 -0.7126 -0.0506 0.6762 4.3962
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.493259 0.157901 -3.124 0.001964 **
## y.l1 0.465290 0.062215 7.479 8.84e-13 ***
## trend 0.009063 0.001454 6.234 1.59e-09 ***
## y.dl1 -0.200117 0.055461 -3.608 0.000363 ***
## du -3.128681 0.460276 -6.797 6.00e-11 ***
## dt 0.005190 0.011298 0.459 0.646332
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.136 on 292 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.6797, Adjusted R-squared: 0.6742
## F-statistic: 123.9 on 5 and 292 DF, p-value: < 2.2e-16
##
##
## Teststatistic: -8.5945
## Critical values: 0.01= -5.57 0.05= -5.08 0.1= -4.82
##
## Potential break point at position: 250Por fim, o teste de Zivot-Andrews identificou o ponto de maior quebra estrutural, que foi o ponto 250 da série temporal simulada.
WTI PRICE
Agora, para realizar os teste de quebra estrutural com uma série real, foi escolhida a série de preços do petróleo WTI em dólares (US$). Os dados foram coletados da U.S Energy Information Administration (EIA). A série utiliza foi de 1986 até 2024 com a frequência mensal.
Além disso, foi colocado no gráfico área hachuradas para os períodos de crise internacional que tiveram impacto no preço do petróleo.
Crise do Petróleo de 1990 (Crise do Golfo Pérsico) - Invasão do Kuwait pelo Iraque, liderado por Saddam Hussein, que causou aumento no preço do petróleo;
Crise do Petróleo de 1998 (Queda dos Preços) - Crise financeira asiática, que reduziu a demanda por petróleo na região;
Crise de 2008 - Aumento da demanda global, especialmente da China e Índia e Crise financeira global que começou em 2007, levando a uma desaceleração econômica;
Queda dos Preços do Petróleo de 2014-2016 - Aumento na produção de petróleo de xisto no EUA; decisão da OPEP de não redução da produção para manter a participação no mercado e o crescimento mais lento das economias;
Queda dos Preços do Petróleo de 2020 (Pandemia de COVID-19) - queda nos preços pela redução da demanda global; e
Crise do Petróleo de 2022-2023 - invasão da Ucrânia pela Rússia.
# Ler o arquivo Excel e preparar os dados
wti_price_month <- read_excel("wti_price_month.xlsx", col_types = c("date", "numeric"))
# Converter para data frame, caso ainda não esteja
wti_price_month <- as.data.frame(wti_price_month)
# Garantir que a coluna de datas esteja em formato Date e renomear colunas para facilitar
colnames(wti_price_month) <- c("Data", "Preco")
wti_price_month$Data <- as.Date(wti_price_month$Data)
# Definir os períodos de crise para hachurar
crisis_periods <- data.frame(
start = as.Date(c("1990-01-01", "1997-01-01", "2008-01-01", "2014-01-01", "2020-01-01", "2022-01-01")),
end = as.Date(c("1991-12-31", "1998-12-31", "2009-12-31", "2016-12-31", "2021-01-30", "2023-12-31"))
)
# Criar o gráfico de linhas com ggplot2
ggplot(data = wti_price_month, aes(x = Data, y = Preco)) +
geom_line(color = "blue") + # Linha azul
labs(title = "Preço do Petróleo WTI - 1986 a 2024",
x = "Data",
y = "Preço (US$)") +
theme_minimal() + # Tema minimalista para um visual mais limpo
geom_rect(data = crisis_periods, inherit.aes = FALSE,
aes(xmin = start, xmax = end, ymin = -Inf, ymax = Inf),
fill = "grey", alpha = 0.3) # Áreas hachuradas em cinza
Teste de Chow
Para o teste de Chow, foi selecionado um período em 2014, mais exatamente a observação 347, que corresponde ao dia 15 de novembro de 2014.
#Teste de Chow
wti_preco_ts <- ts(as.numeric(wti_price_month$Preco), start = c(1986, 1), frequency = 12)
# Ajustar um modelo de regressão linear
model3 <- lm(Preco ~ Data, data = wti_price_month)
#Quebra 1
breakpoint_time_wti <- 347 #2014-11-15
test_result_wti <- sctest(model3, type = "Chow", point = breakpoint_time_wti)
# Exibir os resultados do teste
print(test_result_wti) #Há quebra estrutural##
## M-fluctuation test
##
## data: model3
## f(efp) = 5.1534, p-value < 2.2e-16O resultado do teste evidencia a presença de quebra estrutural para o período analisado.
Teste de Perron
# Realizar o teste de Perron para a quebra estrutural
test_result_perron_wti <- ur.pp(wti_preco_ts, type = "Z-tau", model = "trend", lags = "short")
# Exibir os resultados do teste
summary(test_result_perron_wti) ##
## ##################################
## # Phillips-Perron Unit Root Test #
## ##################################
##
## Test regression with intercept and trend
##
##
## Call:
## lm(formula = y ~ y.l1 + trend)
##
## Residuals:
## Min 1Q Median 3Q Max
## -26.2395 -1.6178 0.2174 1.9083 16.9565
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.465565 0.560003 2.617 0.00916 **
## y.l1 0.971710 0.010962 88.644 < 2e-16 ***
## trend 0.005039 0.002444 2.062 0.03982 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.699 on 456 degrees of freedom
## Multiple R-squared: 0.9749, Adjusted R-squared: 0.9748
## F-statistic: 8863 on 2 and 456 DF, p-value: < 2.2e-16
##
##
## Value of test-statistic, type: Z-tau is: -3.2828
##
## aux. Z statistics
## Z-tau-mu 0.8595
## Z-tau-beta 2.5507
##
## Critical values for Z statistics:
## 1pct 5pct 10pct
## critical values -3.982223 -3.421484 -3.133204O teste de Perron se apresentou estatisticamente significante apenas a 10% de significância.
Teste de Zivot-Andrews
# Teste de Zivot
test_result_za_wti <- ur.za(wti_preco_ts, model = "both", lag = 1)
# Exibir os resultados do teste
summary(test_result_za_wti) #Detectou apenas uma das quebras (a mais forte)##
## ################################
## # Zivot-Andrews Unit Root Test #
## ################################
##
##
## Call:
## lm(formula = testmat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.9141 -2.0870 -0.0116 1.9755 15.0450
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.223584 0.474546 -0.471 0.637758
## y.l1 0.934105 0.012733 73.360 < 2e-16 ***
## trend 0.018172 0.004131 4.399 1.36e-05 ***
## y.dl1 0.356772 0.043190 8.260 1.62e-15 ***
## du -4.147021 1.092026 -3.798 0.000166 ***
## dt 0.018643 0.012409 1.502 0.133699
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 4.32 on 452 degrees of freedom
## (2 observations deleted due to missingness)
## Multiple R-squared: 0.9789, Adjusted R-squared: 0.9787
## F-statistic: 4201 on 5 and 452 DF, p-value: < 2.2e-16
##
##
## Teststatistic: -5.1751
## Critical values: 0.01= -5.57 0.05= -5.08 0.1= -4.82
##
## Potential break point at position: 345Por fim, o teste de Zivot-Andrews evidenciou a quebra estrutural no ponto 345 que corresponde ao dia 15 de setembro de 2014.