Econometria de Séries Temporais
Aluno: Vitor Nayron Moreira
Prof. Dr. Cássio Besarria
Aplicação do Modelo TAR e MTAR
Coleta dos dados
Para o exercÃcio, foi escolhida a série de tempo com as cotações mensais do petróleo WTI para o perÃodo de janeiro de 2001 a maio de 2024. Os dados foram coletados da U.S. Energy Information Administration.
Fonte: https://www.eia.gov/dnav/pet/hist/LeafHandler.ashx?n=PET&s=RWTC&f=M
#Limpando o R
rm(list=ls())
#Pacotes Necessários
library(quantmod)## Warning: package 'quantmod' was built under R version 4.2.3## Carregando pacotes exigidos: xts## Warning: package 'xts' 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: TTR## Warning: package 'TTR' was built under R version 4.2.3## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(dplyr)## Warning: package 'dplyr' was built under R version 4.2.3##
## ######################### Warning from 'xts' package ##########################
## # #
## # The dplyr lag() function breaks how base R's lag() function is supposed to #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or #
## # source() into this session won't work correctly. #
## # #
## # Use stats::lag() to make sure you're not using dplyr::lag(), or you can add #
## # conflictRules('dplyr', exclude = 'lag') to your .Rprofile to stop #
## # dplyr from breaking base R's lag() function. #
## # #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning. #
## # #
## #################################################################################
## Attaching package: 'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.2.3library(tsDyn)## Warning: package 'tsDyn' was built under R version 4.2.3library(readxl)## Warning: package 'readxl' was built under R version 4.2.3#Dados
wti_price <- read_excel("G:/Meu Drive/1. Mestrado/P3/Econometria de Séries Temporais/ExercÃcios/ExercÃcio 8/wti_price.xlsx",
col_types = c("date", "numeric"))
as.data.frame(wti_price)## date adjusted_close
## 1 2000-01-15 27.26
## 2 2000-02-15 29.37
## 3 2000-03-15 29.84
## 4 2000-04-15 25.72
## 5 2000-05-15 28.79
## 6 2000-06-15 31.82
## 7 2000-07-15 29.70
## 8 2000-08-15 31.26
## 9 2000-09-15 33.88
## 10 2000-10-15 33.11
## 11 2000-11-15 34.42
## 12 2000-12-15 28.44
## 13 2001-01-15 29.59
## 14 2001-02-15 29.61
## 15 2001-03-15 27.25
## 16 2001-04-15 27.49
## 17 2001-05-15 28.63
## 18 2001-06-15 27.60
## 19 2001-07-15 26.43
## 20 2001-08-15 27.37
## 21 2001-09-15 26.20
## 22 2001-10-15 22.17
## 23 2001-11-15 19.64
## 24 2001-12-15 19.39
## 25 2002-01-15 19.72
## 26 2002-02-15 20.72
## 27 2002-03-15 24.53
## 28 2002-04-15 26.18
## 29 2002-05-15 27.04
## 30 2002-06-15 25.52
## 31 2002-07-15 26.97
## 32 2002-08-15 28.39
## 33 2002-09-15 29.66
## 34 2002-10-15 28.84
## 35 2002-11-15 26.35
## 36 2002-12-15 29.46
## 37 2003-01-15 32.95
## 38 2003-02-15 35.83
## 39 2003-03-15 33.51
## 40 2003-04-15 28.17
## 41 2003-05-15 28.11
## 42 2003-06-15 30.66
## 43 2003-07-15 30.76
## 44 2003-08-15 31.57
## 45 2003-09-15 28.31
## 46 2003-10-15 30.34
## 47 2003-11-15 31.11
## 48 2003-12-15 32.13
## 49 2004-01-15 34.31
## 50 2004-02-15 34.69
## 51 2004-03-15 36.74
## 52 2004-04-15 36.75
## 53 2004-05-15 40.28
## 54 2004-06-15 38.03
## 55 2004-07-15 40.78
## 56 2004-08-15 44.90
## 57 2004-09-15 45.94
## 58 2004-10-15 53.28
## 59 2004-11-15 48.47
## 60 2004-12-15 43.15
## 61 2005-01-15 46.84
## 62 2005-02-15 48.15
## 63 2005-03-15 54.19
## 64 2005-04-15 52.98
## 65 2005-05-15 49.83
## 66 2005-06-15 56.35
## 67 2005-07-15 59.00
## 68 2005-08-15 64.99
## 69 2005-09-15 65.59
## 70 2005-10-15 62.26
## 71 2005-11-15 58.32
## 72 2005-12-15 59.41
## 73 2006-01-15 65.49
## 74 2006-02-15 61.63
## 75 2006-03-15 62.69
## 76 2006-04-15 69.44
## 77 2006-05-15 70.84
## 78 2006-06-15 70.95
## 79 2006-07-15 74.41
## 80 2006-08-15 73.04
## 81 2006-09-15 63.80
## 82 2006-10-15 58.89
## 83 2006-11-15 59.08
## 84 2006-12-15 61.96
## 85 2007-01-15 54.51
## 86 2007-02-15 59.28
## 87 2007-03-15 60.44
## 88 2007-04-15 63.98
## 89 2007-05-15 63.46
## 90 2007-06-15 67.49
## 91 2007-07-15 74.12
## 92 2007-08-15 72.36
## 93 2007-09-15 79.92
## 94 2007-10-15 85.80
## 95 2007-11-15 94.77
## 96 2007-12-15 91.69
## 97 2008-01-15 92.97
## 98 2008-02-15 95.39
## 99 2008-03-15 105.45
## 100 2008-04-15 112.58
## 101 2008-05-15 125.40
## 102 2008-06-15 133.88
## 103 2008-07-15 133.37
## 104 2008-08-15 116.67
## 105 2008-09-15 104.11
## 106 2008-10-15 76.61
## 107 2008-11-15 57.31
## 108 2008-12-15 41.12
## 109 2009-01-15 41.71
## 110 2009-02-15 39.09
## 111 2009-03-15 47.94
## 112 2009-04-15 49.65
## 113 2009-05-15 59.03
## 114 2009-06-15 69.64
## 115 2009-07-15 64.15
## 116 2009-08-15 71.05
## 117 2009-09-15 69.41
## 118 2009-10-15 75.72
## 119 2009-11-15 77.99
## 120 2009-12-15 74.47
## 121 2010-01-15 78.33
## 122 2010-02-15 76.39
## 123 2010-03-15 81.20
## 124 2010-04-15 84.29
## 125 2010-05-15 73.74
## 126 2010-06-15 75.34
## 127 2010-07-15 76.32
## 128 2010-08-15 76.60
## 129 2010-09-15 75.24
## 130 2010-10-15 81.89
## 131 2010-11-15 84.25
## 132 2010-12-15 89.15
## 133 2011-01-15 89.17
## 134 2011-02-15 88.58
## 135 2011-03-15 102.86
## 136 2011-04-15 109.53
## 137 2011-05-15 100.90
## 138 2011-06-15 96.26
## 139 2011-07-15 97.30
## 140 2011-08-15 86.33
## 141 2011-09-15 85.52
## 142 2011-10-15 86.32
## 143 2011-11-15 97.16
## 144 2011-12-15 98.56
## 145 2012-01-15 100.27
## 146 2012-02-15 102.20
## 147 2012-03-15 106.16
## 148 2012-04-15 103.32
## 149 2012-05-15 94.66
## 150 2012-06-15 82.30
## 151 2012-07-15 87.90
## 152 2012-08-15 94.13
## 153 2012-09-15 94.51
## 154 2012-10-15 89.49
## 155 2012-11-15 86.53
## 156 2012-12-15 87.86
## 157 2013-01-15 94.76
## 158 2013-02-15 95.31
## 159 2013-03-15 92.94
## 160 2013-04-15 92.02
## 161 2013-05-15 94.51
## 162 2013-06-15 95.77
## 163 2013-07-15 104.67
## 164 2013-08-15 106.57
## 165 2013-09-15 106.29
## 166 2013-10-15 100.54
## 167 2013-11-15 93.86
## 168 2013-12-15 97.63
## 169 2014-01-15 94.62
## 170 2014-02-15 100.82
## 171 2014-03-15 100.80
## 172 2014-04-15 102.07
## 173 2014-05-15 102.18
## 174 2014-06-15 105.79
## 175 2014-07-15 103.59
## 176 2014-08-15 96.54
## 177 2014-09-15 93.21
## 178 2014-10-15 84.40
## 179 2014-11-15 75.79
## 180 2014-12-15 59.29
## 181 2015-01-15 47.22
## 182 2015-02-15 50.58
## 183 2015-03-15 47.82
## 184 2015-04-15 54.45
## 185 2015-05-15 59.27
## 186 2015-06-15 59.82
## 187 2015-07-15 50.90
## 188 2015-08-15 42.87
## 189 2015-09-15 45.48
## 190 2015-10-15 46.22
## 191 2015-11-15 42.44
## 192 2015-12-15 37.19
## 193 2016-01-15 31.68
## 194 2016-02-15 30.32
## 195 2016-03-15 37.55
## 196 2016-04-15 40.75
## 197 2016-05-15 46.71
## 198 2016-06-15 48.76
## 199 2016-07-15 44.65
## 200 2016-08-15 44.72
## 201 2016-09-15 45.18
## 202 2016-10-15 49.78
## 203 2016-11-15 45.66
## 204 2016-12-15 51.97
## 205 2017-01-15 52.50
## 206 2017-02-15 53.47
## 207 2017-03-15 49.33
## 208 2017-04-15 51.06
## 209 2017-05-15 48.48
## 210 2017-06-15 45.18
## 211 2017-07-15 46.63
## 212 2017-08-15 48.04
## 213 2017-09-15 49.82
## 214 2017-10-15 51.58
## 215 2017-11-15 56.64
## 216 2017-12-15 57.88
## 217 2018-01-15 63.70
## 218 2018-02-15 62.23
## 219 2018-03-15 62.73
## 220 2018-04-15 66.25
## 221 2018-05-15 69.98
## 222 2018-06-15 67.87
## 223 2018-07-15 70.98
## 224 2018-08-15 68.06
## 225 2018-09-15 70.23
## 226 2018-10-15 70.75
## 227 2018-11-15 56.96
## 228 2018-12-15 49.52
## 229 2019-01-15 51.38
## 230 2019-02-15 54.95
## 231 2019-03-15 58.15
## 232 2019-04-15 63.86
## 233 2019-05-15 60.83
## 234 2019-06-15 54.66
## 235 2019-07-15 57.35
## 236 2019-08-15 54.81
## 237 2019-09-15 56.95
## 238 2019-10-15 53.96
## 239 2019-11-15 57.03
## 240 2019-12-15 59.88
## 241 2020-01-15 57.52
## 242 2020-02-15 50.54
## 243 2020-03-15 29.21
## 244 2020-04-15 16.55
## 245 2020-05-15 28.56
## 246 2020-06-15 38.31
## 247 2020-07-15 40.71
## 248 2020-08-15 42.34
## 249 2020-09-15 39.63
## 250 2020-10-15 39.40
## 251 2020-11-15 40.94
## 252 2020-12-15 47.02
## 253 2021-01-15 52.00
## 254 2021-02-15 59.04
## 255 2021-03-15 62.33
## 256 2021-04-15 61.72
## 257 2021-05-15 65.17
## 258 2021-06-15 71.38
## 259 2021-07-15 72.49
## 260 2021-08-15 67.73
## 261 2021-09-15 71.65
## 262 2021-10-15 81.48
## 263 2021-11-15 79.15
## 264 2021-12-15 71.71
## 265 2022-01-15 83.22
## 266 2022-02-15 91.64
## 267 2022-03-15 108.50
## 268 2022-04-15 101.78
## 269 2022-05-15 109.55
## 270 2022-06-15 114.84
## 271 2022-07-15 101.62
## 272 2022-08-15 93.67
## 273 2022-09-15 84.26
## 274 2022-10-15 87.55
## 275 2022-11-15 84.37
## 276 2022-12-15 76.44
## 277 2023-01-15 78.12
## 278 2023-02-15 76.83
## 279 2023-03-15 73.28
## 280 2023-04-15 79.45
## 281 2023-05-15 71.58
## 282 2023-06-15 70.25
## 283 2023-07-15 76.07
## 284 2023-08-15 81.39
## 285 2023-09-15 89.43
## 286 2023-10-15 85.64
## 287 2023-11-15 77.69
## 288 2023-12-15 71.90
## 289 2024-01-15 74.15
## 290 2024-02-15 77.25
## 291 2024-03-15 81.28
## 292 2024-04-15 85.35
## 293 2024-05-15 80.12# Criando o gráfico usando ggplot2
wti_plot <- ggplot(data = wti_price, aes(x = date, y = adjusted_close)) +
geom_line(color = "blue", size = 1) +
labs(title = "Preço do Petróleo WTI - Janeiro de 2001 a Maio de 2024",
x = "Data",
y = "Preço Ajustado (USD)") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, size = 14, face = "bold"),
axis.title.x = element_text(size = 12),
axis.title.y = element_text(size = 12))## 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.# Exibir o gráfico
print(wti_plot)
Modelagem TAR - Preço do Petróleo
O modelo Thereshold Autoregressivo (TAR) é um tipo de modelagem autoregressivo que tem como caracterÃstica a permissão de diferentes dinâmicas lineares em diferentes regimes observados.
A série é dividida em diferentes regimes com base em valores de um parâmetro threshold. Além disso, um ou mais limiares são definidos para segmentar a série temporal.
# Transformando os dados em uma série temporal
wti_ts <- ts(wti_price$adjusted_close, start = c(2000, 1), frequency = 12)
# Ajustando o modelo TAR
tar_model <- setar(wti_ts, m = 2, thDelay = 1, trim = 0.1, model = "TAR")
# Resumo do modelo TAR
summary(tar_model)##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2
## 1.1295258 1.2223835 -0.2324495
##
## High regime:
## const.H phiH.1 phiH.2
## 31.2055150 1.5569509 -0.8723469
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 97.63
## Proportion of points in low regime: 89.69% High regime: 10.31%
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.3283 -3.4659 0.2314 3.1602 14.6957
##
## Fit:
## residuals variance = 26.56, AIC = 975, MAPE = 6.871%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L 1.129526 0.926409 1.2193 0.2237496
## phiL.1 1.222384 0.060479 20.2119 < 2.2e-16 ***
## phiL.2 -0.232450 0.061694 -3.7678 0.0001999 ***
## const.H 31.205515 11.530972 2.7062 0.0072125 **
## phiH.1 1.556951 0.115221 13.5127 < 2.2e-16 ***
## phiH.2 -0.872347 0.145304 -6.0036 5.818e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 97.63# Plotar o ajuste do modelo TAR
plot(tar_model)
Modelagem MTAR - Preço do Petróleo
Já o modelo NTAR, é uma generalização do modelo TAR. O NTAR permite uma maior flexibilidade na forma como os regimes são definidos e como as transições suavez entre regimes ocorrem.
# Ajustar o modelo MTAR usando a função lstar para transições suaves
ntar_model <- lstar(wti_ts, m = 2, thDelay = 1, trace = TRUE)## Using maximum autoregressive order for low regime: mL = 2
## Using maximum autoregressive order for high regime: mH = 2
## Performing grid search for starting values...
## Starting values fixed: gamma = 77.15385 , th = 98.21151 ; SSE = 7781.973
## Optimization algorithm converged
## Problem: singular hessian
## Optimized values fixed for regime 2 : gamma = 77.15385 , th = 98.21151 ; SSE = 7781.973# Resumo do modelo NTAR
summary(ntar_model)## Warning in vcov.lstar(object): singular Hessian##
## Non linear autoregressive model
##
## LSTAR model
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2
## 1.1295258 1.2223835 -0.2324495
##
## High regime:
## const.H phiH.1 phiH.2
## 30.0759892 0.3345674 -0.6398974
##
## Smoothing parameter: gamma = 77.15
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 98.21
##
## Residuals:
## Min 1Q Median 3Q Max
## -20.3283 -3.4659 0.2314 3.1602 14.6957
##
## Fit:
## residuals variance = 26.56, AIC = 977, MAPE = 6.871%
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|z|)
## const.L 1.12953 NA NA NA
## phiL.1 1.22238 NA NA NA
## phiL.2 -0.23245 NA NA NA
## const.H 30.07599 NA NA NA
## phiH.1 0.33457 NA NA NA
## phiH.2 -0.63990 NA NA NA
## gamma 77.15385 NA NA NA
## th 98.21151 NA NA NA
##
## Non-linearity test of full-order LSTAR model against full-order AR model
## F = 6.542 ; p-value = 0.001667
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)# Plotar o ajuste do modelo NTAR
#plot(ntar_model)No modelo acima, a Matriz Hessiana é singular, ou seja, a matriz para a estimação não é invertÃvel, o que significa que o seu determinante é zero. Diante disso, será realizada uma nova modelagem utilizando a série de sentimento textual para a demanda por petróleo.
Modelagem TAR e NTAR - Sentimento Textual do Petróleo
library(readr)## Warning: package 'readr' was built under R version 4.2.3result_lm_index <- read_csv("G:/Meu Drive/1. Mestrado/P3/Econometria de Séries Temporais/ExercÃcios/ExercÃcio 8/result_lm_index.csv",
col_types = cols(data = col_character()))
# Transformar em uma série temporal
lm_index_ts <- ts(result_lm_index$sentiment1, start = c(2001, 1), frequency = 12)
# Modelo TAR
lm_tar_model <- setar(lm_index_ts, m = 2, thDelay = 1, trim = 0.1, model = "TAR")## Warning: Possible unit root in the high regime. Roots are: 0.7712 0.7712# Resumo do melhor modelo TAR
summary(lm_tar_model)##
## Non linear autoregressive model
##
## SETAR model ( 2 regimes)
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2
## -0.03343569 0.62271593 0.18839859
##
## High regime:
## const.H phiH.1 phiH.2
## 0.4738692 0.3882317 -1.6815587
##
## Threshold:
## -Variable: Z(t) = + (0) X(t)+ (1)X(t-1)
## -Value: 0.1489
## Proportion of points in low regime: 89.93% High regime: 10.07%
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.493194 -0.116829 -0.010341 0.121187 0.658854
##
## Fit:
## residuals variance = 0.03161, AIC = -953, MAPE = 115.2%
##
## Coefficient(s):
##
## Estimate Std. Error t value Pr(>|t|)
## const.L -0.033436 0.017629 -1.8967 0.05892 .
## phiL.1 0.622716 0.060594 10.2769 < 2.2e-16 ***
## phiL.2 0.188399 0.065636 2.8704 0.00442 **
## const.H 0.473869 0.117117 4.0461 6.778e-05 ***
## phiH.1 0.388232 0.178556 2.1743 0.03054 *
## phiH.2 -1.681559 0.396250 -4.2437 3.012e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 0.1489# Plotar o ajuste do melhor modelo TAR
plot(lm_tar_model)
#Modelo NTAR
# Ajustar o modelo NTAR usando a função lstar para transições suaves
ntar_lm <- lstar(lm_index_ts, m = 2, thDelay = 1, trace = TRUE)## Using maximum autoregressive order for low regime: mL = 2
## Using maximum autoregressive order for high regime: mH = 2
## Performing grid search for starting values...
## Starting values fixed: gamma = 100 , th = 0.1492553 ; SSE = 8.834035
## Grid search selected lower/upper bound gamma (was: 1 100 ]).
## Might try to widen bound with arg: 'starting.control=list(gammaInt=c(1,200))'
## Optimization algorithm converged
## Optimized values fixed for regime 2 : gamma = 100 , th = 0.1566989 ; SSE = 8.825651# Resumo do modelo NTAR
summary(ntar_lm)##
## Non linear autoregressive model
##
## LSTAR model
## Coefficients:
## Low regime:
## const.L phiL.1 phiL.2
## -0.03617812 0.62609667 0.17871977
##
## High regime:
## const.H phiH.1 phiH.2
## 0.5722404 -0.2303062 -2.0481407
##
## Smoothing parameter: gamma = 100
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)
##
## Value: 0.1567
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.4935475 -0.1138355 -0.0082389 0.1207779 0.6630712
##
## Fit:
## residuals variance = 0.03152, AIC = -952, MAPE = 115.8%
##
## Coefficient(s):
## Estimate Std. Error t value Pr(>|z|)
## const.L -0.036178 0.022317 -1.6211 0.1049884
## phiL.1 0.626097 0.065061 9.6232 < 2.2e-16 ***
## phiL.2 0.178720 0.085689 2.0857 0.0370084 *
## const.H 0.572240 0.173437 3.2994 0.0009689 ***
## phiH.1 -0.230306 0.225218 -1.0226 0.3065000
## phiH.2 -2.048141 0.479417 -4.2721 1.936e-05 ***
## gamma 100.000004 486.255095 0.2057 0.8370617
## th 0.156699 0.023374 6.7039 2.030e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Non-linearity test of full-order LSTAR model against full-order AR model
## F = 1.4393 ; p-value = 0.2389
##
## Threshold
## Variable: Z(t) = + (0) X(t) + (1) X(t-1)# Plotar o ajuste do modelo NTAR
plot(ntar_lm)
