TS-Consessões
Vitor Klein Schmidt
14 abril, 2021
1 Pacotes
library(readxl)
library(lubridate)
library(forecast)
library(urca)
library(tidyverse)
library(tseries)
library(plotly)
library(prophet) # link para a documentação do prophet: https://cran.r-project.org/web/packages/prophet/prophet.pdf
library(caret)
library(DMwR)2 Dados
dados <- read_excel('C:/Users/user/Desktop/Vida acadêmica/Projetos outros/Caroline/Dados_Importacao.xlsx')
dados$Data <- ymd(dados$Data)
dados_Projeção <- read_excel('C:/Users/user/Desktop/Vida acadêmica/Projetos outros/Caroline/Dados_Importacao_Projeção.xlsx')
dados_Projeção$Data <- ymd(dados_Projeção$Data)3 Concessão 1
dados1 <- dados[,c(1,2, 31:53)]
names(dados1)## [1] "Data" "Concessão_P1"
## [3] "DU" "PIB"
## [5] "Selic_Ano" "Selic_Mes"
## [7] "IGPM" "IPCA"
## [9] "Dólar" "Desemprego"
## [11] "Endividamento" "Tx_Crédito_Total_País"
## [13] "Tx_Crédito_PF_País" "Tx_Crédito_PJ_País"
## [15] "Saldo_Crédito_Total_País" "Saldo_Crédito_PF_País"
## [17] "Saldo_Crédito_PJ_País" "Inadimplência_PF_País"
## [19] "Inadimplência_PJ_País" "Produção_Industrial_País"
## [21] "Ibovespa" "Clientes_PF"
## [23] "Cliente_PJ" "IBCBR"
## [25] "Comprometimento_Renda"3.1 Correlação da Concessão 1 com as demais variáveis
correlação1 <- cor(dados1[-1])[,1]
correlação1## Concessão_P1 DU PIB
## 1.00000000 0.37803398 -0.14548899
## Selic_Ano Selic_Mes IGPM
## 0.37973547 0.43715639 -0.45066623
## IPCA Dólar Desemprego
## -0.07050329 -0.64860535 -0.44835925
## Endividamento Tx_Crédito_Total_País Tx_Crédito_PF_País
## -0.69300767 -0.66675806 -0.57453634
## Tx_Crédito_PJ_País Saldo_Crédito_Total_País Saldo_Crédito_PF_País
## -0.65960540 -0.65706874 -0.51475713
## Saldo_Crédito_PJ_País Inadimplência_PF_País Inadimplência_PJ_País
## -0.52527777 0.14838834 0.42143387
## Produção_Industrial_País Ibovespa Clientes_PF
## 0.23751729 -0.26623458 -0.50754578
## Cliente_PJ IBCBR Comprometimento_Renda
## -0.22720210 0.50069154 -0.504700413.2 Visualização gráfica, coloquei so algumas para demonstrar
aqui tu pode adicionar qualquer outra variável do teu interesse, basta usar o código: geom_line(aes(y = scale(SUA_VARIÁVEL), color = ‘SUA_VARIÁVEL’))
g1 <- ggplot(dados1, aes(x = Data)) +
geom_line(aes(y = scale(Concessão_P1), color = 'Concessão_P1')) +
geom_line(aes(y = scale(PIB), color = 'PIB')) +
geom_line(aes(y = scale(Selic_Mes), color = 'Selic_Mes')) +
guides(color = guide_legend(title = "Variável")) +
labs(title = "Variação ao longo do tempo") + xlab("Período") + ylab("Valores Padronizados") +
theme_bw()
ggplotly(g1)Gráfico com todas, você pode retirar as que não tiver interesse através dos mecanismos de seleção do Plotly, o gráfico é interativa e tu pode escolher o que quer mostrar
g2 <- ggplot(dados1, aes(x = Data)) +
geom_line(aes(y = scale(Concessão_P1), color = 'Concessão_P1')) +
geom_line(aes(y = scale(DU), color = 'DU')) +
geom_line(aes(y = scale(PIB), color = 'PIB')) +
geom_line(aes(y = scale(Selic_Ano), color = 'Selic_Ano')) +
geom_line(aes(y = scale(Selic_Mes), color = 'Selic_Mes')) +
geom_line(aes(y = scale(IGPM), color = 'IGPM')) +
geom_line(aes(y = scale(IPCA), color = 'IPCA')) +
geom_line(aes(y = scale(Dólar), color = 'Dólar')) +
geom_line(aes(y = scale(Desemprego), color = 'Desemprego')) +
geom_line(aes(y = scale(Endividamento), color = 'Endividamento')) +
geom_line(aes(y = scale(Tx_Crédito_Total_País), color = 'Tx_Crédito_Total_País')) +
geom_line(aes(y = scale(Tx_Crédito_PF_País), color = 'Tx_Crédito_PF_País')) +
geom_line(aes(y = scale(Tx_Crédito_PJ_País), color = 'Tx_Crédito_PJ_País')) +
geom_line(aes(y = scale(Saldo_Crédito_Total_País), color = 'Saldo_Crédito_Total_País')) +
geom_line(aes(y = scale(Saldo_Crédito_PF_País), color = 'Saldo_Crédito_PF_País')) +
geom_line(aes(y = scale(Saldo_Crédito_PJ_País), color = 'Saldo_Crédito_PJ_País')) +
geom_line(aes(y = scale(Inadimplência_PF_País), color = 'Inadimplência_PF_País')) +
geom_line(aes(y = scale(Produção_Industrial_País), color = 'Produção_Industrial_País')) +
geom_line(aes(y = scale(Ibovespa), color = 'Ibovespa')) +
geom_line(aes(y = scale(Clientes_PF), color = 'Clientes_PF')) +
geom_line(aes(y = scale(Cliente_PJ), color = 'Cliente_PJ')) +
geom_line(aes(y = scale(IBCBR), color = 'IBCBR')) +
geom_line(aes(y = scale(Comprometimento_Renda), color = 'Comprometimento_Renda')) +
guides(color = guide_legend(title = "Variável")) +
labs(title = "Variação ao longo do tempo") + xlab("Período") + ylab("Valores Padronizados") +
theme_bw()
ggplotly(g2)4 Seleção de variáveis usando Regressão de Lasso
For the LASSO estimate, we cannot really compute standard errors anyway, so any assumption of dependence between the observations is inconsequential.
dadosLasso <- dados1[,c(2:25)]
custom <- trainControl(method = "LOOCV",
number = 5,
verboseIter = F)
lambda <- 10^seq(-3, 3, length = 100)
set.seed(123)
lasso <- train(Concessão_P1 ~.,
dadosLasso,
method = "glmnet",
tuneGrid = expand.grid(alpha = 1,
lambda = lambda),
trControl = custom)
coef(lasso$finalModel, lasso$bestTune$lambda)## 24 x 1 sparse Matrix of class "dgCMatrix"
## 1
## (Intercept) 6.954552e+08
## DU 1.247400e+07
## PIB 5.697050e+02
## Selic_Ano -1.932728e+07
## Selic_Mes 1.295553e+08
## IGPM -2.535824e+06
## IPCA 2.261995e+07
## Dólar 4.744521e+07
## Desemprego -5.921812e+07
## Endividamento -1.049097e+08
## Tx_Crédito_Total_País 3.640589e+03
## Tx_Crédito_PF_País 1.884349e+06
## Tx_Crédito_PJ_País -2.951470e+07
## Saldo_Crédito_Total_País 3.098924e+05
## Saldo_Crédito_PF_País .
## Saldo_Crédito_PJ_País 7.666484e+05
## Inadimplência_PF_País -5.157194e+07
## Inadimplência_PJ_País 3.352774e+07
## Produção_Industrial_País -1.044517e+05
## Ibovespa 5.370691e+02
## Clientes_PF 2.906503e+02
## Cliente_PJ 1.602118e+03
## IBCBR 3.705860e+06
## Comprometimento_Renda 5.725402e+07plot(varImp(lasso, scale = F))
variáveisImportantes <- varImp(lasso, scale = F) # Variáveis mais importantes5 Série temporal
dados1TS <- ts(dados1[,c(2:25)], start = c(2016, 01), frequency = 12) # Converter para série temporal
head(dados1TS) # Olhar os dados## Concessão_P1 DU PIB Selic_Ano Selic_Mes IGPM IPCA Dólar
## Jan 2016 732223429 20 489389.9 14.25 1.06 1.14 1.27 4.052350
## Feb 2016 761342507 18 491575.1 14.25 1.00 1.29 0.90 3.973742
## Mar 2016 844149991 23 518518.1 14.25 1.16 0.51 0.43 3.703918
## Apr 2016 815859400 21 509721.8 14.25 1.06 0.33 0.61 3.565845
## May 2016 854205768 21 513321.5 14.25 1.11 0.82 0.78 3.539290
## Jun 2016 799453446 22 535242.3 14.25 1.16 1.69 0.35 3.424477
## Desemprego Endividamento Tx_Crédito_Total_País Tx_Crédito_PF_País
## Jan 2016 9.829346 44.48 26.95336 13.39973
## Feb 2016 10.054738 44.08 26.64960 13.30822
## Mar 2016 10.266298 43.94 26.42989 13.26485
## Apr 2016 10.611380 43.68 26.10488 13.16853
## May 2016 10.835435 43.50 26.07055 13.19456
## Jun 2016 11.134848 43.33 25.72066 13.08476
## Tx_Crédito_PJ_País Saldo_Crédito_Total_País Saldo_Crédito_PF_País
## Jan 2016 13.55363 3208.124 1521.900
## Feb 2016 13.34138 3192.287 1522.813
## Mar 2016 13.16504 3170.854 1527.590
## Apr 2016 12.93635 3150.823 1526.375
## May 2016 12.87600 3157.795 1533.354
## Jun 2016 12.63590 3140.231 1536.798
## Saldo_Crédito_PJ_País Inadimplência_PF_País Inadimplência_PJ_País
## Jan 2016 1686.224 6.25 4.64
## Feb 2016 1669.474 6.20 4.74
## Mar 2016 1643.264 6.17 4.85
## Apr 2016 1624.448 6.25 5.04
## May 2016 1624.441 6.32 5.25
## Jun 2016 1603.433 6.15 5.07
## Produção_Industrial_País Ibovespa Clientes_PF Cliente_PJ IBCBR
## Jan 2016 76.3 40405.99 3277126 204752 128.36
## Feb 2016 75.8 42793.86 3277969 204592 130.81
## Mar 2016 83.7 50055.27 3282949 205093 140.49
## Apr 2016 83.0 53910.51 3274930 204939 136.01
## May 2016 86.3 48471.71 3277311 205347 133.65
## Jun 2016 87.7 51526.93 3275237 205354 135.31
## Comprometimento_Renda
## Jan 2016 20.63
## Feb 2016 20.75
## Mar 2016 20.96
## Apr 2016 20.93
## May 2016 21.12
## Jun 2016 21.13summary(dados1TS) # Resumo estatísticos dos dados## Concessão_P1 DU PIB Selic_Ano
## Min. :626965489 Min. :17.00 Min. :489390 Min. : 2.000
## 1st Qu.:762244650 1st Qu.:20.00 1st Qu.:534881 1st Qu.: 5.375
## Median :807876459 Median :21.00 Median :567468 Median : 6.500
## Mean :796123172 Mean :20.87 Mean :571641 Mean : 7.883
## 3rd Qu.:852643113 3rd Qu.:22.00 3rd Qu.:599621 3rd Qu.:11.500
## Max. :923523140 Max. :23.00 Max. :661349 Max. :14.250
## Selic_Mes IGPM IPCA Dólar
## Min. :0.1500 Min. :-1.1000 Min. :-0.3800 Min. :3.104
## 1st Qu.:0.4675 1st Qu.: 0.1375 1st Qu.: 0.1575 1st Qu.:3.271
## Median :0.5400 Median : 0.5300 Median : 0.3050 Median :3.766
## Mean :0.6247 Mean : 0.7003 Mean : 0.3565 Mean :3.888
## 3rd Qu.:0.8850 3rd Qu.: 1.0050 3rd Qu.: 0.4575 3rd Qu.:4.111
## Max. :1.2200 Max. : 4.3400 Max. : 1.3500 Max. :5.643
## Desemprego Endividamento Tx_Crédito_Total_País Tx_Crédito_PF_País
## Min. : 9.829 Min. :41.21 Min. :23.61 Min. :12.68
## 1st Qu.:11.846 1st Qu.:41.77 1st Qu.:24.24 1st Qu.:12.99
## Median :12.247 Median :42.97 Median :25.35 Median :13.32
## Mean :12.313 Mean :43.60 Mean :25.97 Mean :13.91
## 3rd Qu.:12.626 3rd Qu.:44.63 3rd Qu.:26.73 3rd Qu.:14.86
## Max. :15.145 Max. :49.31 Max. :31.91 Max. :16.95
## Tx_Crédito_PJ_País Saldo_Crédito_Total_País Saldo_Crédito_PF_País
## Min. :10.76 Min. :3064 Min. :1522
## 1st Qu.:11.19 1st Qu.:3105 1st Qu.:1586
## Median :11.61 Median :3174 Median :1710
## Mean :12.06 Mean :3278 Mean :1773
## 3rd Qu.:12.70 3rd Qu.:3371 3rd Qu.:1947
## Max. :14.95 Max. :3978 Max. :2238
## Saldo_Crédito_PJ_País Inadimplência_PF_País Inadimplência_PJ_País
## Min. :1396 Min. :4.500 Min. :1.500
## 1st Qu.:1426 1st Qu.:4.900 1st Qu.:2.538
## Median :1458 Median :5.115 Median :3.585
## Mean :1505 Mean :5.336 Mean :3.744
## 3rd Qu.:1573 3rd Qu.:5.888 3rd Qu.:5.170
## Max. :1740 Max. :6.320 Max. :5.940
## Produção_Industrial_País Ibovespa Clientes_PF Cliente_PJ
## Min. :60.30 Min. : 40406 Min. :3217153 Min. :196849
## 1st Qu.:79.83 1st Qu.: 64969 1st Qu.:3267789 1st Qu.:206949
## Median :86.50 Median : 79924 Median :3316736 Median :213081
## Mean :85.97 Mean : 80854 Mean :3372876 Mean :212562
## 3rd Qu.:91.28 3rd Qu.: 96523 3rd Qu.:3486982 3rd Qu.:216407
## Max. :98.20 Max. :115645 Max. :3578889 Max. :231943
## IBCBR Comprometimento_Renda
## Min. :118.4 Min. :18.83
## 1st Qu.:133.7 1st Qu.:19.27
## Median :136.0 Median :20.04
## Mean :135.6 Mean :20.09
## 3rd Qu.:138.8 3rd Qu.:20.87
## Max. :143.6 Max. :21.675.1 Decomposição Concessão_1
dec1 <- decompose(dados1TS[,2])
autoplot(dec1) # Tendêcia de queda e Sazonalidade
autoplot(dec1$trend) # olhando a tendência
autoplot(dec1$seasonal) # Olhando a sazonalidade
ggseasonplot(dados1TS[,1]) # Sazonalidade anual: ano de 2020 muito atípico: PANDEMIA
ggseasonplot(window(dados1TS[,1], start = c(2016,1), end = c(2019,12))) # Mais organizados
Aqui eu já notei uma coisa: Se tu queres organizar um algorítimo para ser colocado em prática no banco Tu vais ter problemas ao incluir o ano de 2020: O ano foi muito atípico, o que reflete nos teus dados Logo tu vais ter um padrão de dados até o ano de 2019 e outro padrão para 2020 Se tu quiser generalizar os dados para depois da pandemia, talvez tenhas que rodar sem os dados de 2020 Se tu quer generalizar para a pandemia, dai inclui os dados de 2020, a pandemia não vai acabar e seus efeitos continurão Logo faz sentido manter os dados para a pandemia, mas importante destacar que talvez teu modelo não funcione para depois da pandemia quando As coisas voltarem ao normal
5.2 Estacionaridade dos dados (media e variância são constantes ao longo do tempo)
ts.plot(dados1TS[,1])
ur.kpss(dados1TS[,1]) %>% summary() # Os dados são estacionários, Otimo##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 0.6029
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739ur.kpss(diff(dados1TS[,1])) %>% summary() # Continuam sendo estacionários, Otimo##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 0.1136
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739ndiffs(dados1TS[,1], alpha = 0.01, test = 'kpss') # O teste de KPSS nos diz que não precisamos criar diferenciação, pois os dados são estacionários## [1] 0tsdisplay(dados1TS[,1]) # As bandas em azul tracejado mostram que com 0 LAG's (ACF e PACF) já temos autocorrelação (requisito para modelos temporais)
5.3 Aucorrelação
acfRes <- Acf(dados1TS[,1]) #autocorrelação
pacfRes <- Pacf(dados1TS[,1])
6 Modelo ARIMAX
p = parte autoregressiva d = grau de diferenciação q = parte de média móvel
## Modelo Nulo, sem regressores
CP1 <- window(dados1TS[,c("Concessão_P1")], start = c(2016,1), end = c(2020,12))
modelo_nulo_1 <- auto.arima(CP1)
summary(modelo_nulo_1) # AIC = 2274.91 AICc=2275.65 BIC=2283.22## Series: CP1
## ARIMA(0,1,2)(1,0,0)[12]
##
## Coefficients:
## ma1 ma2 sar1
## -0.7982 0.2938 0.475
## s.e. 0.1496 0.1704 0.126
##
## sigma^2 estimated as 2.814e+15: log likelihood=-1133.46
## AIC=2274.91 AICc=2275.65 BIC=2283.22
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -2832759 51246775 37419283 -0.7226285 4.862463 0.5344208
## ACF1
## Training set 0.07303587prev1 <- forecast(modelo_nulo_1, h = 12)
autoplot(prev1) # Previsão 2022
6.1 Modelo com regressores (Usando as variáveis elencadas pela Regressão de Lasso)
dados_ProjeçãoTS_1 <- ts(dados_Projeção[,c(3:26)], start = c(2020, 1), end = c(2022,12), frequency = 12)
Reg1 <- window(dados1TS[,c("Selic_Mes", "Endividamento", "Desemprego", "Comprometimento_Renda",
"Inadimplência_PF_País", "Dólar", "Inadimplência_PJ_País",
"Tx_Crédito_PJ_País", "IPCA", "Selic_Ano", "DU")], start = c(2016,1), end = c(2020,12))
Modelo_Reg1 <- auto.arima(CP1, xreg = Reg1, stepwise = T)
summary(Modelo_Reg1)## Series: CP1
## Regression with ARIMA(0,0,0) errors
##
## Coefficients:
## intercept Selic_Mes Endividamento Desemprego Comprometimento_Renda
## 2453285092 272355981 -56549453 -29184464 55827640
## s.e. 261945388 162359031 7817473 8314497 21420615
## Inadimplência_PF_País Dólar Inadimplência_PJ_País
## -119550145 -2022755 1280516
## s.e. 47503149 34547374 19780374
## Tx_Crédito_PJ_País IPCA Selic_Ano DU
## 25595989 31486886 -21503631 17577587
## s.e. 20252325 19110711 13178148 5055830
##
## sigma^2 estimated as 1.297e+15: log likelihood=-1122.42
## AIC=2270.84 AICc=2278.75 BIC=2298.06
##
## Training set error measures:
## ME RMSE MAE MPE MAPE MASE
## Training set -6.97374e-07 32217875 26410338 -0.166755 3.344874 0.3771914
## ACF1
## Training set 0.1065874prev1 <- forecast(Modelo_Reg1, xreg = Reg1)
autoplot(prev1) + xlim(2016,2022) + theme_bw()## Scale for 'x' is already present. Adding another scale for 'x', which will
## replace the existing scale.
6.1.1 Adicionar os dados da projeção de 2021 a 2022 para fazer a previsão
Projecao1 <- window(dados_ProjeçãoTS_1[,c("Selic_Mes", "Endividamento", "Desemprego", "Comprometimento_Renda",
"Inadimplência_PF_País", "Dólar", "Inadimplência_PJ_País",
"Tx_Crédito_PJ_País", "IPCA", "Selic_Ano", "DU")], start = c(2021,1), end = c(2022,12))
prev2 <- forecast(Modelo_Reg1, xreg = Projecao1)
autoplot(prev2)
prev2 <- forecast(Modelo_Reg1, xreg = Projecao1)
autoplot(prev2)
plot(prev1, xlim = c(2016, 2022))
lines(prev2$mean, col = "red") # O primeiro modelo é melhor
6.1.2 Regressão Temporal - Para inferência
Essa regressão é adequada para dados ao longo do tempo
timeSeries1 <- tslm(Concessão_P1 ~ dados1TS[,-1], data = dados1TS)
summary(timeSeries1)##
## Call:
## tslm(formula = Concessão_P1 ~ dados1TS[, -1], data = dados1TS)
##
## Residuals:
## Min 1Q Median 3Q Max
## -55898490 -18565414 3692842 18340737 39205032
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.047e+08 1.150e+09 0.439 0.66333
## dados1TS[, -1]DU 1.153e+07 5.915e+06 1.949 0.05875
## dados1TS[, -1]PIB 5.488e+02 4.375e+02 1.254 0.21737
## dados1TS[, -1]Selic_Ano -2.381e+07 1.764e+07 -1.350 0.18498
## dados1TS[, -1]Selic_Mes 1.539e+08 1.863e+08 0.826 0.41372
## dados1TS[, -1]IGPM -1.544e+06 7.373e+06 -0.209 0.83526
## dados1TS[, -1]IPCA 2.165e+07 1.789e+07 1.210 0.23368
## dados1TS[, -1]Dólar 5.021e+07 4.329e+07 1.160 0.25326
## dados1TS[, -1]Desemprego -6.018e+07 2.082e+07 -2.891 0.00632
## dados1TS[, -1]Endividamento -1.138e+08 3.245e+07 -3.506 0.00118
## dados1TS[, -1]Tx_Crédito_Total_País -4.465e+07 6.977e+07 -0.640 0.52597
## dados1TS[, -1]Tx_Crédito_PF_País 6.705e+07 1.396e+08 0.480 0.63383
## dados1TS[, -1]Tx_Crédito_PJ_País NA NA NA NA
## dados1TS[, -1]Saldo_Crédito_Total_País 1.257e+06 7.443e+05 1.689 0.09936
## dados1TS[, -1]Saldo_Crédito_PF_País -1.048e+06 1.010e+06 -1.037 0.30629
## dados1TS[, -1]Saldo_Crédito_PJ_País NA NA NA NA
## dados1TS[, -1]Inadimplência_PF_País -4.831e+07 5.896e+07 -0.819 0.41767
## dados1TS[, -1]Inadimplência_PJ_País 3.379e+07 3.494e+07 0.967 0.33963
## dados1TS[, -1]Produção_Industrial_País -9.072e+04 1.426e+06 -0.064 0.94961
## dados1TS[, -1]Ibovespa 5.953e+02 1.255e+03 0.474 0.63806
## dados1TS[, -1]Clientes_PF 3.959e+02 4.125e+02 0.960 0.34327
## dados1TS[, -1]Cliente_PJ 1.338e+03 1.357e+03 0.986 0.33030
## dados1TS[, -1]IBCBR 3.800e+06 2.168e+06 1.753 0.08762
## dados1TS[, -1]Comprometimento_Renda 6.209e+07 2.758e+07 2.251 0.03026
##
## (Intercept)
## dados1TS[, -1]DU .
## dados1TS[, -1]PIB
## dados1TS[, -1]Selic_Ano
## dados1TS[, -1]Selic_Mes
## dados1TS[, -1]IGPM
## dados1TS[, -1]IPCA
## dados1TS[, -1]Dólar
## dados1TS[, -1]Desemprego **
## dados1TS[, -1]Endividamento **
## dados1TS[, -1]Tx_Crédito_Total_País
## dados1TS[, -1]Tx_Crédito_PF_País
## dados1TS[, -1]Tx_Crédito_PJ_País
## dados1TS[, -1]Saldo_Crédito_Total_País .
## dados1TS[, -1]Saldo_Crédito_PF_País
## dados1TS[, -1]Saldo_Crédito_PJ_País
## dados1TS[, -1]Inadimplência_PF_País
## dados1TS[, -1]Inadimplência_PJ_País
## dados1TS[, -1]Produção_Industrial_País
## dados1TS[, -1]Ibovespa
## dados1TS[, -1]Clientes_PF
## dados1TS[, -1]Cliente_PJ
## dados1TS[, -1]IBCBR .
## dados1TS[, -1]Comprometimento_Renda *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 28670000 on 38 degrees of freedom
## Multiple R-squared: 0.9092, Adjusted R-squared: 0.8591
## F-statistic: 18.13 on 21 and 38 DF, p-value: 7.987e-146.1.3 Somente com o que foi significativo
timeSeries2 <- tslm(Concessão_P1 ~ DU + Desemprego + Endividamento +
Saldo_Crédito_Total_País + IBCBR + Comprometimento_Renda, data = dados1TS)
summary(timeSeries2)##
## Call:
## tslm(formula = Concessão_P1 ~ DU + Desemprego + Endividamento +
## Saldo_Crédito_Total_País + IBCBR + Comprometimento_Renda,
## data = dados1TS)
##
## Residuals:
## Min 1Q Median 3Q Max
## -79999344 -22068131 536808 23650252 47682090
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1432092727 203033104 7.053 3.70e-09 ***
## DU 14587816 3219660 4.531 3.38e-05 ***
## Desemprego -41260147 5711562 -7.224 1.97e-09 ***
## Endividamento -101074666 13944234 -7.248 1.80e-09 ***
## Saldo_Crédito_Total_País 741255 123451 6.004 1.78e-07 ***
## IBCBR 5931965 1063115 5.580 8.37e-07 ***
## Comprometimento_Renda 36854621 9653590 3.818 0.000355 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 30260000 on 53 degrees of freedom
## Multiple R-squared: 0.8589, Adjusted R-squared: 0.843
## F-statistic: 53.79 on 6 and 53 DF, p-value: < 2.2e-167 Modelo Prophet
7.1 Prophet: Modelo Nulo (sem previsores)
names(dados1)## [1] "Data" "Concessão_P1"
## [3] "DU" "PIB"
## [5] "Selic_Ano" "Selic_Mes"
## [7] "IGPM" "IPCA"
## [9] "Dólar" "Desemprego"
## [11] "Endividamento" "Tx_Crédito_Total_País"
## [13] "Tx_Crédito_PF_País" "Tx_Crédito_PJ_País"
## [15] "Saldo_Crédito_Total_País" "Saldo_Crédito_PF_País"
## [17] "Saldo_Crédito_PJ_País" "Inadimplência_PF_País"
## [19] "Inadimplência_PJ_País" "Produção_Industrial_País"
## [21] "Ibovespa" "Clientes_PF"
## [23] "Cliente_PJ" "IBCBR"
## [25] "Comprometimento_Renda"qplot(Data, Concessão_P1, data = dados1)
ds <- dados1$Data
y <- dados1$Concessão_P1
df <- data.frame(ds, y)
m <- prophet()
m <- fit.prophet(m ,df)## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.future <- make_future_dataframe(m, freq = "months", periods = 12)
future## ds
## 1 2016-01-01
## 2 2016-02-01
## 3 2016-03-01
## 4 2016-04-01
## 5 2016-05-01
## 6 2016-06-01
## 7 2016-07-01
## 8 2016-08-01
## 9 2016-09-01
## 10 2016-10-01
## 11 2016-11-01
## 12 2016-12-01
## 13 2017-01-01
## 14 2017-02-01
## 15 2017-03-01
## 16 2017-04-01
## 17 2017-05-01
## 18 2017-06-01
## 19 2017-07-01
## 20 2017-08-01
## 21 2017-09-01
## 22 2017-10-01
## 23 2017-11-01
## 24 2017-12-01
## 25 2018-01-01
## 26 2018-02-01
## 27 2018-03-01
## 28 2018-04-01
## 29 2018-05-01
## 30 2018-06-01
## 31 2018-07-01
## 32 2018-08-01
## 33 2018-09-01
## 34 2018-10-01
## 35 2018-11-01
## 36 2018-12-01
## 37 2019-01-01
## 38 2019-02-01
## 39 2019-03-01
## 40 2019-04-01
## 41 2019-05-01
## 42 2019-06-01
## 43 2019-07-01
## 44 2019-08-01
## 45 2019-09-01
## 46 2019-10-01
## 47 2019-11-01
## 48 2019-12-01
## 49 2020-01-01
## 50 2020-02-01
## 51 2020-03-01
## 52 2020-04-01
## 53 2020-05-01
## 54 2020-06-01
## 55 2020-07-01
## 56 2020-08-01
## 57 2020-09-01
## 58 2020-10-01
## 59 2020-11-01
## 60 2020-12-01
## 61 2021-01-01
## 62 2021-02-01
## 63 2021-03-01
## 64 2021-04-01
## 65 2021-05-01
## 66 2021-06-01
## 67 2021-07-01
## 68 2021-08-01
## 69 2021-09-01
## 70 2021-10-01
## 71 2021-11-01
## 72 2021-12-01forecast <- predict(m, future)
plot(m, forecast)
dyplot.prophet(m, forecast)## Warning: `select_()` is deprecated as of dplyr 0.7.0.
## Please use `select()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.prophet_plot_components(m, forecast)
pred <- forecast$yhat[1:60]
actual <- df[,2]
plot(actual, pred)
abline(lm(pred~actual), col = "red")
RegNulo <- lm(pred~actual) # Regressão entre os valores previstos e os valores encontrados, demonstra a previsão do modelo para os valores passados
summary(RegNulo)##
## Call:
## lm(formula = pred ~ actual)
##
## Residuals:
## Min 1Q Median 3Q Max
## -58210369 -19178905 497438 13147441 67720630
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.696e+08 3.706e+07 4.577 2.54e-05 ***
## actual 7.869e-01 4.634e-02 16.981 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 27180000 on 58 degrees of freedom
## Multiple R-squared: 0.8325, Adjusted R-squared: 0.8297
## F-statistic: 288.4 on 1 and 58 DF, p-value: < 2.2e-167.2 Adicionar regressores (2016-2020 / 2021-2022)
dados <- read_excel('C:/Users/user/Desktop/Vida acadêmica/Projetos outros/Caroline/Dados_Importacao.xlsx')
dados$Data <- ymd(dados$Data)
dados_Projeção <- read_excel('C:/Users/user/Desktop/Vida acadêmica/Projetos outros/Caroline/Dados_Importacao_Projeção.xlsx')
dados_Projeção$Data <- ymd(dados_Projeção$Data)
dados1 <- dados[,c(1,2, 31:53)]
ds <- dados1$Data
y <- dados1$Concessão_P1
df2 <- data.frame(ds, y)
m2 <- prophet()
m2 <- fit.prophet(m2 ,df2)## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.df2$Selic_Mes <- dados1$Selic_Mes
df2$Endividamento <- dados1$Endividamento
df2$Desemprego <- dados1$Desemprego
df2$Comprometimento_Renda <- dados1$Comprometimento_Renda
df2$Inadimplência_PF_País <- dados1$Inadimplência_PF_País
df2$Dólar <- dados1$Dólar
df2$Inadimplência_PJ_País <- dados1$Inadimplência_PJ_País
df2$Tx_Crédito_PJ_País <- dados1$Tx_Crédito_PJ_País
df2$IPCA <- dados1$IPCA
df2$Selic_Ano <- dados1$Selic_Ano
df2$DU <- dados1$DU
m2 <- prophet()
m2 <- add_regressor(m2, "Selic_Mes")
m2 <- add_regressor(m2, "Endividamento")
m2 <- add_regressor(m2, "Desemprego")
m2 <- add_regressor(m2, "Comprometimento_Renda")
m2 <- add_regressor(m2, "Inadimplência_PF_País")
m2 <- add_regressor(m2, "Dólar")
m2 <- add_regressor(m2, "Inadimplência_PJ_País")
m2 <- add_regressor(m2, "Tx_Crédito_PJ_País")
m2 <- add_regressor(m2, "IPCA")
m2 <- add_regressor(m2, "Selic_Ano")
m2 <- add_regressor(m2, "DU")
m2 <- fit.prophet(m2, df2)## Disabling weekly seasonality. Run prophet with weekly.seasonality=TRUE to override this.
## Disabling daily seasonality. Run prophet with daily.seasonality=TRUE to override this.future <- make_future_dataframe(m2, freq = "months", periods = 24)
dados_Projeção_Prophet <- dados_Projeção[, c("Selic_Mes", "Endividamento", "Desemprego", "Comprometimento_Renda",
"Inadimplência_PF_País", "Dólar", "Inadimplência_PJ_País",
"Tx_Crédito_PJ_País", "IPCA", "Selic_Ano", "DU")]
# Selic
X_Selic_Mes <- data.frame(df2$Selic_Mes)
colnames(X_Selic_Mes) <- "Selic_Mes"
Y_Selic_Mes <- data.frame(dados_Projeção_Prophet$Selic_Mes)
colnames(Y_Selic_Mes) <- "Selic_Mes"
future$Selic_Mes <- rbind(X_Selic_Mes, Y_Selic_Mes)
# Endividamento
X_Endividamento <- data.frame(df2$Endividamento)
colnames(X_Endividamento) <- "Endividamento"
Y_Endividamento <- data.frame(dados_Projeção_Prophet$Endividamento)
colnames(Y_Endividamento) <- "Endividamento"
future$Endividamento <- rbind(X_Endividamento, Y_Endividamento)
# Desemprego
X_Desemprego <- data.frame(df2$Desemprego)
colnames(X_Desemprego) <- "Desemprego"
Y_Desemprego <- data.frame(dados_Projeção_Prophet$Desemprego)
colnames(Y_Desemprego) <- "Desemprego"
future$Desemprego <- rbind(X_Desemprego, Y_Desemprego)
# Comprometimento_Renda
X_Comprometimento_Renda <- data.frame(df2$Comprometimento_Renda)
colnames(X_Comprometimento_Renda) <- "Comprometimento_Renda"
Y_Comprometimento_Renda <- data.frame(dados_Projeção_Prophet$Comprometimento_Renda)
colnames(Y_Comprometimento_Renda) <- "Comprometimento_Renda"
future$Comprometimento_Renda <- rbind(X_Comprometimento_Renda, Y_Comprometimento_Renda)
# Inadimplência_PF_País
X_Inadimplência_PF_País <- data.frame(df2$Inadimplência_PF_País)
colnames(X_Inadimplência_PF_País) <- "Inadimplência_PF_País"
Y_Inadimplência_PF_País <- data.frame(dados_Projeção_Prophet$Inadimplência_PF_País)
colnames(Y_Inadimplência_PF_País) <- "Inadimplência_PF_País"
future$Inadimplência_PF_País <- rbind(X_Inadimplência_PF_País, Y_Inadimplência_PF_País)
# Dólar
X_Dólar <- data.frame(df2$Dólar)
colnames(X_Dólar) <- "Dólar"
Y_Dólar <- data.frame(dados_Projeção_Prophet$Dólar)
colnames(Y_Dólar) <- "Dólar"
future$Dólar <- rbind(X_Dólar, Y_Dólar)
# Inadimplência_PJ_País
X_Inadimplência_PJ_País <- data.frame(df2$Inadimplência_PJ_País)
colnames(X_Inadimplência_PJ_País) <- "Inadimplência_PJ_País"
Y_Inadimplência_PJ_País <- data.frame(dados_Projeção_Prophet$Inadimplência_PJ_País)
colnames(Y_Inadimplência_PJ_País) <- "Inadimplência_PJ_País"
future$Inadimplência_PJ_País <- rbind(X_Inadimplência_PJ_País, Y_Inadimplência_PJ_País)
# Tx_Crédito_PJ_País
X_Tx_Crédito_PJ_País <- data.frame(df2$Tx_Crédito_PJ_País)
colnames(X_Tx_Crédito_PJ_País) <- "Tx_Crédito_PJ_País"
Y_Tx_Crédito_PJ_País <- data.frame(dados_Projeção_Prophet$Tx_Crédito_PJ_País)
colnames(Y_Tx_Crédito_PJ_País) <- "Tx_Crédito_PJ_País"
future$Tx_Crédito_PJ_País <- rbind(X_Tx_Crédito_PJ_País, Y_Tx_Crédito_PJ_País)
# IPCA
X_IPCA <- data.frame(df2$IPCA)
colnames(X_IPCA) <- "IPCA"
Y_IPCA <- data.frame(dados_Projeção_Prophet$IPCA)
colnames(Y_IPCA) <- "IPCA"
future$IPCA <- rbind(X_IPCA, Y_IPCA)
# Selic_Ano
X_Selic_Ano <- data.frame(df2$Selic_Ano)
colnames(X_Selic_Ano) <- "Selic_Ano"
Y_Selic_Ano <- data.frame(dados_Projeção_Prophet$Selic_Ano)
colnames(Y_Selic_Ano) <- "Selic_Ano"
future$Selic_Ano <- rbind(X_Selic_Ano, Y_Selic_Ano)
# DU
X_DU <- data.frame(df2$DU)
colnames(X_DU) <- "DU"
Y_DU <- data.frame(dados_Projeção_Prophet$DU)
colnames(Y_DU) <- "DU"
future$DU <- rbind(X_DU, Y_DU)
future <- as.matrix(future) # Juntar
colnames(future) <- NULL
colnames(future) <- c("ds", "Selic_Mes", "Endividamento", "Desemprego", "Comprometimento_Renda",
"Inadimplência_PF_País", "Dólar", "Inadimplência_PJ_País", "Tx_Crédito_PJ_País",
"IPCA", "Selic_Ano", "DU")
future <- data.frame(future)
future$Selic <- as.numeric(future$Selic_Mes)
future$Endividamento <- as.numeric(future$Endividamento)
future$Desemprego <- as.numeric(future$Desemprego)
future$Comprometimento_Renda <- as.numeric(future$Comprometimento_Renda)
future$ds <- ymd(future$ds)
forecast <- predict(m2, future)
plot(m2, forecast)
dyplot.prophet(m2, forecast)prophet_plot_components(m2, forecast)
pred <- forecast$yhat[1:60]
actual <- df2[,2]
plot(actual, pred)
abline(lm(actual~pred), col = "red")
RegModel1 <- lm(actual~pred)
summary(RegModel1)##
## Call:
## lm(formula = actual ~ pred)
##
## Residuals:
## Min 1Q Median 3Q Max
## -61013848 -11173275 805254 11528362 53778690
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.535e+04 2.715e+07 -0.001 0.999
## pred 1.000e+00 3.396e-02 29.451 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 19280000 on 58 degrees of freedom
## Multiple R-squared: 0.9373, Adjusted R-squared: 0.9362
## F-statistic: 867.3 on 1 and 58 DF, p-value: < 2.2e-167.2.1 ANOVA entre os modelos
anova(RegNulo, RegModel1) # Melhoramos## Warning in anova.lmlist(object, ...): models with response '"actual"' removed
## because response differs from model 1## Analysis of Variance Table
##
## Response: pred
## Df Sum Sq Mean Sq F value Pr(>F)
## actual 1 2.1309e+17 2.1309e+17 288.36 < 2.2e-16 ***
## Residuals 58 4.2861e+16 7.3899e+14
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1