Biblioteca Usada

library(quantmod)
library(tidyverse)
library(readxl)
library(fBasics)
library(dynlm)
library(quantreg)
library(AER)

Banco de Dados

dataInicial = as.Date("2010-01-01") 
dataFinal = as.Date("2021-10-31") 
dataInicial = as.Date("2010-01-01") 
dataFinal = as.Date("2021-10-31") 
tickers <- c("BBAS3.SA")
getSymbols(tickers, src = "yahoo", from = dataInicial, to = dataFinal)
## [1] "BBAS3.SA"

Dados diários obtidos em (http://nefin.com.br/risk_factors.html), foram devidamente ajustados para obter as taxas acumuladas mensais

Fama_French<-read_xlsx("Fama-French.xlsx")
attach(Fama_French)
head(Fama_French)
## # A tibble: 6 x 4
##   Rm_minus_Rf_M   SMB_M    HML_M Risk_free_M
##           <dbl>   <dbl>    <dbl>       <dbl>
## 1      -0.0438   0.0517  0.0269      0.00628
## 2       0.00384  0.0254  0.0117      0.00597
## 3       0.0382  -0.0684 -0.0117      0.00768
## 4      -0.0364   0.0225 -0.0321      0.00687
## 5      -0.0654  -0.0120 -0.0271      0.00770
## 6      -0.0456   0.0406 -0.00135     0.00813
head(BBAS3.SA)
##            BBAS3.SA.Open BBAS3.SA.High BBAS3.SA.Low BBAS3.SA.Close
## 2010-01-04         29.80         30.00        29.70          29.90
## 2010-01-05         30.10         30.10        29.19          29.60
## 2010-01-06         29.49         30.00        29.42          29.64
## 2010-01-07         29.44         29.71        29.41          29.65
## 2010-01-08         29.70         29.82        29.47          29.82
## 2010-01-11         29.98         30.07        29.62          30.05
##            BBAS3.SA.Volume BBAS3.SA.Adjusted
## 2010-01-04         3624700          13.93332
## 2010-01-05         3064900          13.79351
## 2010-01-06         2733100          13.81215
## 2010-01-07         1542200          13.81681
## 2010-01-08         2038900          13.89603
## 2010-01-11         2412800          14.00321

Encaixando as variáveis para o modelo

names(BBAS3.SA)
## [1] "BBAS3.SA.Open"     "BBAS3.SA.High"     "BBAS3.SA.Low"     
## [4] "BBAS3.SA.Close"    "BBAS3.SA.Volume"   "BBAS3.SA.Adjusted"
chartSeries(to.monthly(BBAS3.SA),name = "BBAS3", type ="candlesticks",up.col='green', dn.col='red',theme='black')

Selecionando só os preços de fechamento ajustados pelos proventos

bbsa3<- Ad(BBAS3.SA)
head(bbsa3)
##            BBAS3.SA.Adjusted
## 2010-01-04          13.93332
## 2010-01-05          13.79351
## 2010-01-06          13.81215
## 2010-01-07          13.81681
## 2010-01-08          13.89603
## 2010-01-11          14.00321
tail(bbsa3)
##            BBAS3.SA.Adjusted
## 2021-10-22          28.36336
## 2021-10-25          28.95201
## 2021-10-26          28.64787
## 2021-10-27          28.61844
## 2021-10-28          28.36336
## 2021-10-29          27.96111
retornomesBBSA3<-as.ts(monthlyReturn(bbsa3))
tail(retornomesBBSA3)
## [1]  0.14422760 -0.03602018 -0.01556175 -0.02663071 -0.04432085 -0.01384077
lineChart(retornomesBBSA3, name = "Retornos mensais",theme = "black", up.col="blue")

CAPM1

Modelo restrito

names(Fama_French)
## [1] "Rm_minus_Rf_M" "SMB_M"         "HML_M"         "Risk_free_M"
pr<-(Rm_minus_Rf_M)
ri<-(retornomesBBSA3-Risk_free_M)
tail(pr)
## [1]  0.05696287  0.00156415 -0.03852380 -0.02654470 -0.06892806 -0.06375572
tail(ri)
## [1]  0.14130063 -0.03933633 -0.01927289 -0.03113651 -0.04916106 -0.01915802
capm<-ri~pr
capm1<-lm(capm)
summary(capm1)
## 
## Call:
## lm(formula = capm)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.139410 -0.045759 -0.003796  0.037984  0.268389 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.004511   0.005421   0.832    0.407    
## pr          1.731447   0.094801  18.264   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0646 on 140 degrees of freedom
## Multiple R-squared:  0.7044, Adjusted R-squared:  0.7023 
## F-statistic: 333.6 on 1 and 140 DF,  p-value: < 2.2e-16

Fama-French

Modelo irrestrito

names(Fama_French)
## [1] "Rm_minus_Rf_M" "SMB_M"         "HML_M"         "Risk_free_M"
hml<-(HML_M)
smb<-(SMB_M)
tail(ri)
## [1]  0.14130063 -0.03933633 -0.01927289 -0.03113651 -0.04916106 -0.01915802
tail(pr)
## [1]  0.05696287  0.00156415 -0.03852380 -0.02654470 -0.06892806 -0.06375572
tail(hml)
## [1] -0.00155541 -0.01154161 -0.01536266  0.00945124  0.00780595  0.02010171
tail(smb)
## [1]  0.01606525  0.06624945 -0.03216930 -0.05023366 -0.04015110 -0.05633318
ffrench<-ri~pr+hml+smb
ffrench1<-lm(ffrench)
summary(ffrench1)
## 
## Call:
## lm(formula = ffrench)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.119418 -0.043432 -0.003974  0.041127  0.264901 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.004238   0.005442   0.779    0.437    
## pr           1.685066   0.111293  15.141   <2e-16 ***
## hml          0.202186   0.158346   1.277    0.204    
## smb         -0.083109   0.141805  -0.586    0.559    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.06468 on 138 degrees of freedom
## Multiple R-squared:  0.7078, Adjusted R-squared:  0.7015 
## F-statistic: 111.4 on 3 and 138 DF,  p-value: < 2.2e-16

Questão 1

Teste Jarque-Bera

ecapm <- resid(capm1)
jarqueberaTest(ecapm)
## 
## Title:
##  Jarque - Bera Normalality Test
## 
## Test Results:
##   STATISTIC:
##     X-squared: 21.38
##   P VALUE:
##     Asymptotic p Value: 2.277e-05 
## 
## Description:
##  Tue Jan 04 11:30:10 2022 by user: ddlag
effrench <- resid(ffrench1)
jarqueberaTest(effrench)
## 
## Title:
##  Jarque - Bera Normalality Test
## 
## Test Results:
##   STATISTIC:
##     X-squared: 18.4678
##   P VALUE:
##     Asymptotic p Value: 9.767e-05 
## 
## Description:
##  Tue Jan 04 11:30:10 2022 by user: ddlag

Ambos modelos são rejeitados como tendo distribuição normal

Outliers

summary(influence.measures(capm1))
## Potentially influential observations of
##   lm(formula = capm) :
## 
##     dfb.1_ dfb.pr dffit   cov.r   cook.d hat    
## 75   0.29   0.75   0.80_*  0.92_*  0.30   0.05_*
## 101  0.04  -0.08   0.09    1.05_*  0.00   0.04  
## 106  0.38   0.67   0.77_*  0.80_*  0.26   0.03  
## 123  0.15  -0.72   0.74_*  1.20_*  0.27   0.19_*
## 131 -0.15  -0.36  -0.39_*  1.02    0.08   0.05_*
summary(influence.measures(ffrench1))
## Potentially influential observations of
##   lm(formula = ffrench) :
## 
##     dfb.1_ dfb.pr dfb.hml dfb.smb dffit   cov.r   cook.d hat    
## 56   0.17   0.45  -0.31   -0.17    0.54_*  0.97    0.07   0.06  
## 62  -0.02  -0.02  -0.03    0.04   -0.06    1.10_*  0.00   0.06  
## 74  -0.15   0.20  -0.38   -0.15   -0.53_*  1.05    0.07   0.09_*
## 75   0.26   0.52   0.36   -0.23    0.86_*  0.83_*  0.17   0.07  
## 79   0.04  -0.02   0.09    0.05    0.15    1.16_*  0.01   0.12_*
## 85  -0.06   0.06  -0.21   -0.01   -0.25    1.17_*  0.02   0.13_*
## 106  0.42   0.24   0.24    0.50    1.04_*  0.63_*  0.24   0.05  
## 123  0.11  -0.56   0.23   -0.25    0.71_*  1.25_*  0.13   0.22_*
## 124 -0.19  -0.38   0.49   -0.24   -0.58_*  1.01    0.08   0.08
plot(capm1)

par(mfrow=c(2,3))
plot(capm1, which=1:6)

plot(ffrench1)
plot(ffrench1, which=1:6)

## Teste Breusch-Pagan

bptest(capm1)
## 
##  studentized Breusch-Pagan test
## 
## data:  capm1
## BP = 8.9176, df = 1, p-value = 0.002824
bptest(ffrench1)
## 
##  studentized Breusch-Pagan test
## 
## data:  ffrench1
## BP = 11.316, df = 3, p-value = 0.01013

Teste Durbin-Watson

dwtest(capm1)
## 
##  Durbin-Watson test
## 
## data:  capm1
## DW = 2.0116, p-value = 0.5234
## alternative hypothesis: true autocorrelation is greater than 0
dwtest(ffrench1)
## 
##  Durbin-Watson test
## 
## data:  ffrench1
## DW = 2.0493, p-value = 0.6046
## alternative hypothesis: true autocorrelation is greater than 0

Teste BreuschGodfrey

bgtest(capm1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  capm1
## LM test = 0.021968, df = 1, p-value = 0.8822
bgtest(ffrench1)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  ffrench1
## LM test = 0.12799, df = 1, p-value = 0.7205

Questão 2

Corrigindo para a presença de outliers

par(mfrow=c(1,1))
capm_hat <- hatvalues(capm1)
plot(capm_hat)
abline(h= c(1,3)*mean(capm_hat), col=2)

id <- which(capm_hat>3 * mean(capm_hat))


ffrench_hat <- hatvalues(ffrench1)
plot(ffrench_hat)
abline(h= c(1,3)*mean(ffrench_hat), col=2)

id <- which(capm_hat>3 * mean(ffrench_hat))


# Regressão Quantilica (LAD - Least Absolute Deviations - Desvios Absolutos Médios)
capm_corrigido <- rq(capm)
summary(capm_corrigido)
## Warning in rq.fit.br(x, y, tau = tau, ci = TRUE, ...): Solution may be nonunique
## 
## Call: rq(formula = capm)
## 
## tau: [1] 0.5
## 
## Coefficients:
##             coefficients lower bd upper bd
## (Intercept)  0.00545     -0.00859  0.00980
## pr           1.63337      1.40918  1.91427
summary(capm1)
## 
## Call:
## lm(formula = capm)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.139410 -0.045759 -0.003796  0.037984  0.268389 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 0.004511   0.005421   0.832    0.407    
## pr          1.731447   0.094801  18.264   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.0646 on 140 degrees of freedom
## Multiple R-squared:  0.7044, Adjusted R-squared:  0.7023 
## F-statistic: 333.6 on 1 and 140 DF,  p-value: < 2.2e-16
ffrench_corrigido <- rq(ffrench)
summary(ffrench_corrigido)
## 
## Call: rq(formula = ffrench)
## 
## tau: [1] 0.5
## 
## Coefficients:
##             coefficients lower bd upper bd
## (Intercept)  0.00340     -0.00803  0.01144
## pr           1.59560      1.44089  1.83174
## hml          0.06136     -0.23902  0.41313
## smb         -0.16752     -0.53740  0.21190
summary(ffrench1)
## 
## Call:
## lm(formula = ffrench)
## 
## Residuals:
##       Min        1Q    Median        3Q       Max 
## -0.119418 -0.043432 -0.003974  0.041127  0.264901 
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  0.004238   0.005442   0.779    0.437    
## pr           1.685066   0.111293  15.141   <2e-16 ***
## hml          0.202186   0.158346   1.277    0.204    
## smb         -0.083109   0.141805  -0.586    0.559    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.06468 on 138 degrees of freedom
## Multiple R-squared:  0.7078, Adjusted R-squared:  0.7015 
## F-statistic: 111.4 on 3 and 138 DF,  p-value: < 2.2e-16

Foi feita uma regresão quantilica para diminuir o peso dos outliers atraves de uma estimação robusta.

Teste Jarque-Bera

ecapm_corrigido <- resid(capm_corrigido)
jarqueberaTest(ecapm_corrigido)
## 
## Title:
##  Jarque - Bera Normalality Test
## 
## Test Results:
##   STATISTIC:
##     X-squared: 33.7929
##   P VALUE:
##     Asymptotic p Value: 4.592e-08 
## 
## Description:
##  Tue Jan 04 11:30:11 2022 by user: ddlag
effrench_corrigido <- resid(ffrench_corrigido)
jarqueberaTest(effrench_corrigido)
## 
## Title:
##  Jarque - Bera Normalality Test
## 
## Test Results:
##   STATISTIC:
##     X-squared: 52.4634
##   P VALUE:
##     Asymptotic p Value: 4.052e-12 
## 
## Description:
##  Tue Jan 04 11:30:11 2022 by user: ddlag

Teste Breusch-Pagan

bptest(capm_corrigido)
## 
##  studentized Breusch-Pagan test
## 
## data:  capm_corrigido
## BP = 8.9176, df = 1, p-value = 0.002824
bptest(ffrench_corrigido)
## 
##  studentized Breusch-Pagan test
## 
## data:  ffrench_corrigido
## BP = 11.316, df = 3, p-value = 0.01013

Teste Durbin-Watson

dwtest(capm_corrigido)
## 
##  Durbin-Watson test
## 
## data:  capm_corrigido
## DW = 2.0116, p-value = 0.5234
## alternative hypothesis: true autocorrelation is greater than 0
dwtest(ffrench_corrigido)
## 
##  Durbin-Watson test
## 
## data:  ffrench_corrigido
## DW = 2.0493, p-value = 0.6046
## alternative hypothesis: true autocorrelation is greater than 0

Teste BreuschGodfrey

bgtest(capm_corrigido)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  capm_corrigido
## LM test = 0.021968, df = 1, p-value = 0.8822
bgtest(ffrench_corrigido)
## 
##  Breusch-Godfrey test for serial correlation of order up to 1
## 
## data:  ffrench_corrigido
## LM test = 0.12799, df = 1, p-value = 0.7205

Os testes indicam que todos os modelos são rejeitados como tendo distribuição normal. Não há indicios de heterocedasticidade pelo teste de Breush Pagan e pela distribuição gráfica. Os testes de Durbin Watson e Breusch Godfrey mostram que não existe correlação serial devido ao p-value. Além disso, não houve diferenças nos resultados com correções para presença de outliers.