“An old science joke says: “Theory is when you know everything but nothing works.Practice is when everything works but no one knows why. In our lab, theory and practice are combined: Nothing works and no one knows why.” Finance is better. The consumption CAPM theory is well developed, but it doesn’t work. Anomaly strategies work, but no one knows why. […]." - Lu Zhang; q-factors and Investment CAPM

Primeiro, importamos os dados com os quais iremos realizar a análise. A base contém o retorno diário de 10 ativos de 01/01/2018 a 31/12/2020. Os dados foram extraídos da Economática.

retornos <- read_excel("Retornos_ativos.xlsx")
## tibble[,11] [742 x 11] (S3: tbl_df/tbl/data.frame)
##  $ Data : POSIXct[1:742], format: "2018-01-02" "2018-01-03" ...
##  $ ABCB4: num [1:742] 0.00475 0.00422 -0.003 0.01446 0.0095 ...
##  $ ALSO3: num [1:742] -0.01223 0.00759 -0.00238 0.00119 -0.02778 ...
##  $ ABEV3: num [1:742] 0.01927 0.00231 -0.00552 0.0037 -0.00184 ...
##  $ ANIM3: num [1:742] 0.00707 0.00702 0.01045 0.01034 0.00683 ...
##  $ ARZZ3: num [1:742] 0.0293 0.0302 0.0316 -0.0336 -0.0123 ...
##  $ AZUL4: num [1:742] 0.00929 -0.00331 0.00628 -0.0011 -0.01066 ...
##  $ BTOW3: num [1:742] -0.0244 -0.008 0.0272 -0.0186 -0.008 ...
##  $ B3SA3: num [1:742] 0.00571 0.01702 0.00644 0.0145 0.00462 ...
##  $ BKBR3: num [1:742] 0.01257 0.01016 0 -0.00559 0 ...
##  $ BRFS3: num [1:742] 0.01831 -0.00724 0.01081 0.0492 0.01172 ...

Questão 1

Iremos considerar dois portfólios, cada um contendo 7 ativos, de forma que 4 ativos sejam comuns aos dois portfólios. Para essa análise inicial iremos considerar o ano de 2018. Além disso, definimos a taxa livre de risco como sendo o CDI acumulado em 2018.

rf_2019 <- 0.0596
port1 <- retornos %>% select(Data, ABCB4, ALSO3, ABEV3, ANIM3, ARZZ3, AZUL4, BTOW3) %>% dplyr::filter(Data >= "2019-01-01" & Data <= "2019-12-31")

port2 <- retornos %>% select(Data, ABCB4, ALSO3, ABEV3, ANIM3, B3SA3, BKBR3, BRFS3) %>% dplyr::filter(Data >= "2019-01-01" & Data <= "2019-12-31")

Com base nessa data frame contendo os retornos de cada ativo, somos capazes de otimizar esses portfólios com base na matriz de covariâncias e no retorno esperado. Consideraremos o retorno esperado como a média dos retornos.

Desse modo, os retornos esperados de cada ativo pertecentes ao portfólio 1 são:

er_port1 <- unlist(lapply(port1[,2:8], function(x) prod(1 + x) ^ (252/length(x)) - 1))
##     ABCB4     ALSO3     ABEV3     ANIM3     ARZZ3     AZUL4     BTOW3 
## 0.2855833 0.9981676 0.2502206 0.7689115 0.2007588 0.6315167 0.5236398

E do portfólio 2:

er_port2 <- unlist(lapply(port2[,2:8], function(x) prod(1 + x) ^ (252/length(x)) - 1))
##      ABCB4      ALSO3      ABEV3      ANIM3      B3SA3      BKBR3      BRFS3 
##  0.2855833  0.9981676  0.2502206  0.7689115  0.6492927 -0.1390478  0.6174044

Além disso, a matriz de covariância para o portfólio 1 é:

cov_port1 <- cov(port1[,2:8])
##              ABCB4        ALSO3        ABEV3        ANIM3        ARZZ3
## ABCB4 2.120800e-04 5.217316e-05 2.788258e-05 9.127724e-05 6.076605e-05
## ALSO3 5.217316e-05 2.474992e-04 4.238822e-05 4.432679e-05 5.905847e-05
## ABEV3 2.788258e-05 4.238822e-05 2.855376e-04 6.009243e-05 3.878482e-05
## ANIM3 9.127724e-05 4.432679e-05 6.009243e-05 4.572732e-04 6.799974e-05
## ARZZ3 6.076605e-05 5.905847e-05 3.878482e-05 6.799974e-05 2.820862e-04
## AZUL4 8.921347e-05 9.379348e-05 1.197980e-04 1.133553e-04 1.517287e-04
## BTOW3 1.458537e-04 1.074690e-04 8.675609e-05 1.761309e-04 1.714225e-04
##              AZUL4        BTOW3
## ABCB4 8.921347e-05 1.458537e-04
## ALSO3 9.379348e-05 1.074690e-04
## ABEV3 1.197980e-04 8.675609e-05
## ANIM3 1.133553e-04 1.761309e-04
## ARZZ3 1.517287e-04 1.714225e-04
## AZUL4 5.194953e-04 2.303668e-04
## BTOW3 2.303668e-04 1.002269e-03

E, para o portfólio 2:

cov_port2 <- cov(port2[,2:8])
##              ABCB4        ALSO3        ABEV3        ANIM3        B3SA3
## ABCB4 2.120800e-04 5.217316e-05 2.788258e-05 9.127724e-05 1.284501e-04
## ALSO3 5.217316e-05 2.474992e-04 4.238822e-05 4.432679e-05 9.305749e-05
## ABEV3 2.788258e-05 4.238822e-05 2.855376e-04 6.009243e-05 1.263991e-04
## ANIM3 9.127724e-05 4.432679e-05 6.009243e-05 4.572732e-04 1.398549e-04
## B3SA3 1.284501e-04 9.305749e-05 1.263991e-04 1.398549e-04 4.579899e-04
## BKBR3 6.110585e-05 7.988944e-05 5.432436e-05 8.534672e-05 8.870782e-05
## BRFS3 3.925399e-05 3.586128e-05 6.138743e-05 2.965365e-05 1.044257e-04
##               BKBR3         BRFS3
## ABCB4  6.110585e-05  3.925399e-05
## ALSO3  7.988944e-05  3.586128e-05
## ABEV3  5.432436e-05  6.138743e-05
## ANIM3  8.534672e-05  2.965365e-05
## B3SA3  8.870782e-05  1.044257e-04
## BKBR3  3.958743e-04 -3.151230e-06
## BRFS3 -3.151230e-06  5.442130e-04

Da mesma forma, segue a matriz de correlação para os portfólios 1 e 2:

cor(port1[,2:8])
##           ABCB4     ALSO3     ABEV3     ANIM3     ARZZ3     AZUL4     BTOW3
## ABCB4 1.0000000 0.2277248 0.1133056 0.2931060 0.2484393 0.2687755 0.3163554
## ALSO3 0.2277248 1.0000000 0.1594508 0.1317624 0.2235138 0.2615742 0.2157764
## ABEV3 0.1133056 0.1594508 1.0000000 0.1663030 0.1366593 0.3110476 0.1621721
## ANIM3 0.2931060 0.1317624 0.1663030 1.0000000 0.1893339 0.2325751 0.2601689
## ARZZ3 0.2484393 0.2235138 0.1366593 0.1893339 1.0000000 0.3963566 0.3223924
## AZUL4 0.2687755 0.2615742 0.3110476 0.2325751 0.3963566 1.0000000 0.3192544
## BTOW3 0.3163554 0.2157764 0.1621721 0.2601689 0.3223924 0.3192544 1.0000000
cor(port2[,2:8])
##           ABCB4      ALSO3     ABEV3      ANIM3     B3SA3        BKBR3
## ABCB4 1.0000000 0.22772482 0.1133056 0.29310601 0.4121514  0.210889156
## ALSO3 0.2277248 1.00000000 0.1594508 0.13176239 0.2763990  0.255225378
## ABEV3 0.1133056 0.15945077 1.0000000 0.16630303 0.3495300  0.161578782
## ANIM3 0.2931060 0.13176239 0.1663030 1.00000000 0.3056059  0.200595107
## B3SA3 0.4121514 0.27639900 0.3495300 0.30560594 1.0000000  0.208331663
## BKBR3 0.2108892 0.25522538 0.1615788 0.20059511 0.2083317  1.000000000
## BRFS3 0.1155445 0.09771347 0.1557268 0.05944369 0.2091679 -0.006789174
##              BRFS3
## ABCB4  0.115544541
## ALSO3  0.097713471
## ABEV3  0.155726780
## ANIM3  0.059443690
## B3SA3  0.209167948
## BKBR3 -0.006789174
## BRFS3  1.000000000

Como podemos observar, temos ativos com uma correlaçao não tão forte, de modo que a maior correlação no portfólio 1 é de 0.45 e no portfólio 2 é de 0.52. Em relaçao aos retornos esperados, possuímos tanto ativos com um alto retorno esperado (BTOW3, por exemplo), como baixo retorno esperado (ABEV3, por exemplo)

Questão 2

Definiremos, agora, o portfólio tangente e o de variância mínima para o portfólio 1 e 2.

Portfólio 1

port1_vm <- solve(cov_port1) %*% rep(1,7)

port1_vm <- port1_vm/sum(port1_vm)

port1_tg <- solve(cov_port1) %*% (er_port1 - rf_2019)

port1_tg <- port1_tg/sum(port1_tg)

Retorno Esperado e Desvio Padrão

port1_vm_er <- t(port1_vm) %*% er_port1

port1_tg_er <- t(port1_tg) %*% er_port1
port1_vm_dp <- ((t(port1_vm) %*% cov_port1 %*% port1_vm)^(0.5))*sqrt(252)

port1_tg_dp <- ((t(port1_tg) %*% cov_port1 %*% port1_tg)^(0.5))*sqrt(252)
##                  Variância Mínima  Tangente
## Retorno Esperado        0.4507909 1.1190451
## Desvio Padrão           0.1539084 0.2532837

Portfólio 2

port2_vm <- solve(cov_port2) %*% rep(1,7)

port2_vm <- port2_vm/sum(port2_vm)

port2_tg <- solve(cov_port2) %*% (er_port2 - rf_2019)

port2_tg <- port2_tg/sum(port2_tg)

Retorno Esperado e Desvio Padrão

port2_vm_er <- t(port2_vm) %*% er_port2

port2_tg_er <- t(port2_tg) %*% er_port2
port2_vm_dp <- ((t(port2_vm) %*% cov_port2 %*% port2_vm)^(0.5))*sqrt(252)

port2_tg_dp <- ((t(port2_tg) %*% cov_port2 %*% port2_tg)^(0.5))*sqrt(252)
##                  Variância Mínima  Tangente
## Retorno Esperado        0.4507923 1.3555715
## Desvio Padrão           0.1528171 0.2781471

Questão 3

Fronteira Eficiente

Sabemos que a fronteira eficiente é a combinação lienar do portfólio tangente com o portfólio de variância mínima.Ou seja,

\(Fronteira\:Eficiente_i = (1 - peso_{vm_i}) \times \mbox{Portfólio Tangente} + peso_{vm_i} \times \mbox{Portfólio Mínima Variância}\)

Portfólio 1

npf <- 60
wm <- -2

w <- sort(unique(c(0, 1, seq(wm,abs(wm), length.out=(npf-2))))) #para FE wm=-2
fe <- matrix(rep(0, 7*length(w)), nrow = length(w), ncol=7, byrow=TRUE)
colnames(fe) <- colnames(port1[,2:8])

for (i in 1:7) fe[,i]=w*port1_vm[i]+(1-w)*port1_tg[i] # carteiras da FE

RetEsp=rep(0,length(w)) #retorno de FE
DesPad=RetEsp #risco na FE
for (j in 1:length(w)){ RetEsp[j]=fe[j,]%*%er_port1 # retorno esperado
DesPad[j]=((t(fe[j,])%*%cov_port1%*%fe[j,])^.5)*sqrt(252) } # risco

ISharpe=(RetEsp-rf_2019)/DesPad #Ind. Sharpe

dcef=c(which(w==1),which(w==0)) #PVM e PT
pvmpt=cbind(DesPad[dcef],RetEsp[dcef])
cef=RetEsp>=RetEsp[which(DesPad==min(DesPad))]
fem=data.frame(round(cbind(w,fe,DesPad,RetEsp,ISharpe),3)[cef,]) #FE
slim=c(.95*min(DesPad,na.rm=T),max(diag(cov_port1)^.5,DesPad,na.rm=T)*1.1)
rlim=c(.95*min(RetEsp,er_port1),max(RetEsp,er_port1)*1.1)

riscoretorig=data.frame(Risco=((diag(cov_port1)^.5)*sqrt(252)),Retorno=er_port1)
riscoretorig*100

Portfólio 2

npf <- 60
wm <- -2

w <- sort(unique(c(0, 1, seq(wm,abs(wm), length.out=(npf-2))))) #para FE wm=-2
fe <- matrix(rep(0, 7*length(w)), nrow = length(w), ncol=7, byrow=TRUE)
colnames(fe) <- colnames(port2[,2:8])

for (i in 1:7) fe[,i]=w*port2_vm[i]+(1-w)*port2_tg[i] # carteiras da FE

RetEsp=rep(0,length(w)) #retorno de FE
DesPad=RetEsp #risco na FE
for (j in 1:length(w)){ RetEsp[j]=fe[j,]%*%er_port2 # retorno esperado
DesPad[j]=((t(fe[j,])%*%cov_port2%*%fe[j,])^.5)*sqrt(252) } # risco

ISharpe=(RetEsp-rf_2019)/DesPad #Ind. Sharpe

dcef=c(which(w==1),which(w==0)) #PVM e PT
pvmpt=cbind(DesPad[dcef],RetEsp[dcef])
cef=RetEsp>=RetEsp[which(DesPad==min(DesPad))]
fem=data.frame(round(cbind(w,fe,DesPad,RetEsp,ISharpe),3)[cef,]) #FE
slim=c(.95*min(DesPad,na.rm=T),max(diag(cov_port2)^.5,DesPad,na.rm=T)*1.1)
rlim=c(.95*min(RetEsp,er_port2),max(RetEsp,er_port2)*1.1)

riscoretorig=data.frame(Risco=((diag(cov_port2)^.5)*sqrt(252)),Retorno=er_port2)
riscoretorig*100

Questão 4

Portfólio 1

Portfólio de Variância Mínima

opt.restrics <- matrix (c(rep(1,7), # soma de pesos = 1
                          diag(1,7)), # restric¸ao w_i >= 0 ˜
                        nrow=7+1, byrow=TRUE)

opt.lad <- matrix(c(1,rep(0.0000000,7)))

opt.igu <- 1 

zeros <- array(0, dim = c(7,1))

solu.minvol <- solve.QP(cov_port1, zeros, t(opt.restrics), opt.lad, meq = opt.igu)

ws.minvol = round(solu.minvol$solution,6)

names(ws.minvol)=colnames(port1[,2:8])
##    ABCB4    ALSO3    ABEV3    ANIM3    ARZZ3    AZUL4    BTOW3 
## 0.280545 0.231549 0.233667 0.073425 0.180814 0.000000 0.000000
var.minvol = solu.minvol$value * 2
ret.minvol = er_port1 %*% ws.minvol
vol.minvol = sqrt(var.minvol)
c(vol.minvol,ret.minvol) 
## [1] 0.00978689 0.46246930

Portfólio Tangente

Data <- timeSeries(ts(port1[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = "LongOnly" 

PT=tangencyPortfolio(Data, Spec, Constraints)

# Retorno
getWeights(PT) %*% er_port1
##           [,1]
## [1,] 0.9042946
# Risco
sqrt(t(getWeights(PT)) %*% cov_port1 %*% getWeights(PT)) * sqrt(252)
##           [,1]
## [1,] 0.2071105

Portfólio 2

Portfólio de Variância Mínima

opt.restrics <- matrix (c(rep(1,7), # soma de pesos = 1
                          diag(1,7)), # restric¸ao w_i >= 0 ˜
                        nrow=7+1, byrow=TRUE)

opt.lad <- matrix(c(1,rep(0.0000000,7)))

opt.igu <- 1 

zeros <- array(0, dim = c(7,1))

solu.minvol <- solve.QP(cov_port2, zeros, t(opt.restrics), opt.lad, meq = opt.igu)

ws.minvol1 = round(solu.minvol$solution,6)

names(ws.minvol1)=colnames(port2[,2:8])
##    ABCB4    ALSO3    ABEV3    ANIM3    B3SA3    BKBR3    BRFS3 
## 0.278088 0.221641 0.209435 0.074005 0.000000 0.105885 0.110946
var.minvol = solu.minvol$value * 2
ret.minvol = er_port2 %*% ws.minvol1
vol.minvol = sqrt(var.minvol)
c(vol.minvol,ret.minvol) 
## [1] 0.009693318 0.463735879

Portfólio Tangente

Data1 <- timeSeries(ts(port2[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data1)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = "LongOnly" 

PT1=tangencyPortfolio(Data1, Spec, Constraints)

# Retorno
getWeights(PT1) %*% er_port2
##           [,1]
## [1,] 0.8706522
# Risco
sqrt(t(getWeights(PT1)) %*% cov_port2 %*% getWeights(PT1)) * sqrt(252)
##           [,1]
## [1,] 0.1929389

Questão 5

Portfólio 1

npf <- 60
wm <- -2

w <- sort(unique(c(0, 1, seq(wm,abs(wm), length.out=(npf-2))))) #para FE wm=-2
fe <- matrix(rep(0, 7*length(w)), nrow = length(w), ncol=7, byrow=TRUE)
colnames(fe) <- colnames(port1[,2:8])

for (i in 1:7) fe[,i]=w*ws.minvol[i]+(1-w)*getWeights(PT)[i] # carteiras da FE

RetEsp=rep(0,length(w)) #retorno de FE
DesPad=RetEsp #risco na FE
for (j in 1:length(w)){ RetEsp[j]=fe[j,]%*%er_port1 # retorno esperado
DesPad[j]=((t(fe[j,])%*%cov_port1%*%fe[j,])^.5)*sqrt(252) } # risco

ISharpe=(RetEsp-rf_2019)/DesPad #Ind. Sharpe

dcef=c(which(w==1),which(w==0)) #PVM e PT
pvmpt=cbind(DesPad[dcef],RetEsp[dcef])
cef=RetEsp>=RetEsp[which(DesPad==min(DesPad))]
fem=data.frame(round(cbind(w,fe,DesPad,RetEsp,ISharpe),3)[cef,]) #FE
slim=c(.95*min(DesPad,na.rm=T),max(diag(cov_port1)^.5,DesPad,na.rm=T)*1.1)
rlim=c(.95*min(RetEsp,er_port1),max(RetEsp,er_port1)*1.1)

riscoretorig=data.frame(Risco=((diag(cov_port1)^.5)*sqrt(252)),Retorno=er_port1)
riscoretorig*100

Portfólio 2

npf <- 60
wm <- -2

w <- sort(unique(c(0, 1, seq(wm,abs(wm), length.out=(npf-2))))) #para FE wm=-2
fe <- matrix(rep(0, 7*length(w)), nrow = length(w), ncol=7, byrow=TRUE)
colnames(fe) <- colnames(port2[,2:8])

for (i in 1:7) fe[,i]=w*ws.minvol1[i]+(1-w)*getWeights(PT1)[i] # carteiras da FE

RetEsp=rep(0,length(w)) #retorno de FE
DesPad=RetEsp #risco na FE
for (j in 1:length(w)){ RetEsp[j]=fe[j,]%*%er_port2 # retorno esperado
DesPad[j]=((t(fe[j,])%*%cov_port2%*%fe[j,])^.5)*sqrt(252) } # risco

ISharpe=(RetEsp-rf_2019)/DesPad #Ind. Sharpe

dcef=c(which(w==1),which(w==0)) #PVM e PT
pvmpt=cbind(DesPad[dcef],RetEsp[dcef])
cef=RetEsp>=RetEsp[which(DesPad==min(DesPad))]
fem=data.frame(round(cbind(w,fe,DesPad,RetEsp,ISharpe),3)[cef,]) #FE
slim=c(.95*min(DesPad,na.rm=T),max(diag(cov_port2)^.5,DesPad,na.rm=T)*1.1)
rlim=c(.95*min(RetEsp,er_port2),max(RetEsp,er_port2)*1.1)

riscoretorig=data.frame(Risco=((diag(cov_port2)^.5)*sqrt(252)),Retorno=er_port2)
riscoretorig*100

Questão 6

mercado <- read_excel("Retorno_mercado.xlsx")
## tibble[,4] [497 x 4] (S3: tbl_df/tbl/data.frame)
##  $ data         : POSIXct[1:497], format: "2019-01-02" "2019-01-03" ...
##  $ IBRX         : num [1:497] 0.03433 0.00613 0.00224 -0.00197 0.00319 ...
##  $ Ibovespa     : num [1:497] 0.03556 0.00606 0.00302 -0.00154 0.00363 ...
##  $ Mercado_Nefin: num [1:497] 0.03561 0.00637 0.00265 -0.00266 0.00161 ...
mercado <- mercado %>% dplyr::filter(data >= "2019-01-01" & data <= "2019-12-31")
retornos_periodo <- retornos %>% dplyr::filter(Data >= "2019-01-01" & Data <= "2019-12-31")

Betas

betas <- vector(length = 10)
for(i in 2:11){
  regressao <- lm(retornos_periodo[[i]] ~ mercado$Mercado_Nefin)
  betas[i - 1] <- coef(regressao)[2]
}
##     ABCB4     ALSO3     ABEV3     ANIM3     ARZZ3     AZUL4     BTOW3     B3SA3 
## 0.7329372 0.4723828 0.7672560 0.8321855 0.6373664 1.2460261 1.4530252 1.4327061 
##     BKBR3     BRFS3 
## 0.6093309 0.5109310
dp_6 <- apply(retornos_periodo[,2:11], 2, sd) * sqrt(252)

cv_6 <- apply(retornos_periodo[,2:11], 2, function(x) sd(x)/(prod(1 + x) - 1))

dwnside_risk <- vector(length = 10)
for(i in 2:11){
  ativo <- retornos_periodo[[i]]
  ativo <- ativo[mercado$Mercado_Nefin > 0]
  dwnside_risk[i - 1] <- mean(ativo)*100
}

cvar_6 <- vector(length = 10)
for(i in 2:11){
  cvar_6[i - 1] <- CVaR(retornos_periodo[[i]])*100
}
##            Beta Desvio Padrão Coef. de Variação Downside Risk (média - %)
## ABCB4 0.7329372     0.2311799        0.05192395                 0.7106829
## ALSO3 0.4723828     0.2497395        0.01611348                 0.6434440
## ABEV3 0.7672560     0.2682452        0.06874730                 0.6270370
## ANIM3 0.8321855     0.3394596        0.02839950                 0.8267723
## ARZZ3 0.6373664     0.2666190        0.08513633                 0.5927316
## AZUL4 1.2460261     0.3618188        0.03682800                 1.0263800
## BTOW3 1.4530252     0.5025653        0.06165391                 1.3124113
## B3SA3 1.4327061     0.3397256        0.03363589                 1.2864831
## BKBR3 0.6093309     0.3158486       -0.14523129                 0.4039445
## BRFS3 0.5109310     0.3703265        0.03855247                 0.6394025
##        CVar (%)
## ABCB4 -2.735950
## ALSO3 -2.278799
## ABEV3 -3.638511
## ANIM3 -3.819794
## ARZZ3 -3.023815
## AZUL4 -4.683224
## BTOW3 -4.866876
## B3SA3 -4.388459
## BKBR3 -4.422919
## BRFS3 -4.112871

Questão 7

Portfólios - Q2

beta_q2_vm <- betas[names(betas) %in% rownames(port1_vm)] %*% port1_vm
##           [,1]
## [1,] 0.6236226
beta_q2_tg <- betas[names(betas) %in% rownames(port1_tg)] %*% port1_tg
##           [,1]
## [1,] 0.5939483

Portfólios - Q4

beta_q4_vm <- betas[names(betas) %in% names(ws.minvol)] %*% ws.minvol
##          [,1]
## [1,] 0.670632
beta_q4_tg <- betas[names(betas) %in% names(getWeights(PT))] %*% getWeights(PT)
##           [,1]
## [1,] 0.6319888

Questão 8

Consideraremos a expectativa de prêmio de risco como sendo 8%. Esse número é o prêmio de risco histórico americano (6%) adicionado de um prêmio de risco de 2% para o risco Brasil. Para a taxa livre de risco consideraremos 5%.

0.05 + beta_q2_vm*0.08
##            [,1]
## [1,] 0.09988981
0.05 + beta_q2_tg*0.08
##            [,1]
## [1,] 0.09751587
0.05 + beta_q4_vm*0.08
##           [,1]
## [1,] 0.1036506
0.05 + beta_q4_tg*0.08
##           [,1]
## [1,] 0.1005591

Questão 9

Portfólio 1

Mínima Variância

Data_9_mv_port1 <- timeSeries(ts(port1[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data_9_mv_port1)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = c("maxsumW[1:7] = 1.1", "maxW = c(0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4)")  

mv_9_port1 =minvariancePortfolio(Data_9_mv_port1, Spec, Constraints)
barplot(getWeights(mv_9_port1),col=rainbow(7),cex.axis=1,cex.names=0.8)

# Retorno Esperado
getWeights(mv_9_port1) %*% er_port1
##           [,1]
## [1,] 0.4624694
# Risco
sqrt(t(getWeights(mv_9_port1)) %*% cov_port1 %*% getWeights(mv_9_port1)) * sqrt(252)
##           [,1]
## [1,] 0.1553621

Tangente

Data_9_pt_port1 <- timeSeries(ts(port1[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data_9_pt_port1)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = c("maxsumW[1:7] = 1.1", "maxW = c(0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4)")  

pt_9_port1 =tangencyPortfolio(Data_9_pt_port1, Spec, Constraints)
barplot(getWeights(pt_9_port1),col=rainbow(7),cex.axis=1,cex.names=0.8)

# Retorno Esperado
getWeights(pt_9_port1) %*% er_port1
##          [,1]
## [1,] 0.743623
# Risco
sqrt(t(getWeights(pt_9_port1)) %*% cov_port1 %*% getWeights(pt_9_port1)) * sqrt(252)
##           [,1]
## [1,] 0.1853345

Portfólio 2

Mínima Variância

Data_9_mv_port2 <- timeSeries(ts(port2[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data_9_mv_port2)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = c("maxsumW[1:7] = 1.1", "maxW = c(0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4)")  

mv_9_port2 =minvariancePortfolio(Data_9_mv_port2, Spec, Constraints)
barplot(getWeights(mv_9_port2),col=rainbow(7),cex.axis=1,cex.names=0.8)

# Retorno Esperado
getWeights(mv_9_port2) %*% er_port1
##          [,1]
## [1,] 0.534924
# Risco
sqrt(t(getWeights(mv_9_port2)) %*% cov_port1 %*% getWeights(mv_9_port2)) * sqrt(252)
##           [,1]
## [1,] 0.1780534

Tangente

Data_9_pt_port2 <- timeSeries(ts(port2[,2:8], frequency=12, start=c(2019,1)))

ndm=dim(Data_9_pt_port2)

Spec = portfolioSpec() 
setTargetReturn(Spec) = mean(colMeans(Data,na.rm=T)) # pode usar outro valor
setRiskFreeRate(Spec) = (rf_2019 + 1) ^ (1/252) - 1 
setNFrontierPoints(Spec) = 80 
Constraints = c("maxsumW[1:7] = 1.1", "maxW = c(0.4, 0.4, 0.4, 0.4, 0.4, 0.4, 0.4)")  

pt_9_port2 =tangencyPortfolio(Data_9_pt_port2, Spec, Constraints)
barplot(getWeights(pt_9_port2),col=rainbow(7),cex.axis=1,cex.names=0.8)

# Retorno Esperado
getWeights(pt_9_port2) %*% er_port1
##           [,1]
## [1,] 0.7266677
# Risco
sqrt(t(getWeights(pt_9_port2)) %*% cov_port1 %*% getWeights(pt_9_port2)) * sqrt(252)
##           [,1]
## [1,] 0.2060744

Questão 10

Fronteira Eficiente

Para evitar a repitição desnecessária de código, iremos omitir o código para a geração do gráfico com a fronteira eficiente.

Portfólio 1

Portfólio 2

Questão 11

Como sabemos que os pesos do portfólio tangente e de miníma variância são bastante sensíveis a variações nos retornos dos ativos, por causa da inversão da matriz de covariância, iremos trabalhar com matrizes robustas. Estimaremos os parâmetros dos portfólios tangente e de variância miníma sem restrições.

Portfólio 1

mvtportf = function(cov,eresp){
icov=solve(cov)
uns=rep(1,ncol(cov))
mv = icov%*%uns
mv = mv/sum(mv)
tp = icov%*%as.vector(eresp)
tp = tp/sum(tp)
data.frame(VM=mv,PT=tp)
}

Data_11 <- timeSeries(ts(port1[,2:8], frequency=12, start=c(2019,1)))

rf_2019_dia <- (1 + rf_2019) ^ (1/252) - 1
excret = colMeans(Data_11,na.rm=T)-rf_2019_dia
CEncolhida = mvtportf(CovEst.2010RBLW(Data_11)$S,excret)

Portfólio 2

mvtportf = function(cov,eresp){
icov=solve(cov)
uns=rep(1,ncol(cov))
mv = icov%*%uns
mv = mv/sum(mv)
tp = icov%*%as.vector(eresp)
tp = tp/sum(tp)
data.frame(VM=mv,PT=tp)
}

Data_11_port2 <- timeSeries(ts(port2[,2:8], frequency=12, start=c(2019,1)))

rf_2019_dia <- (1 + rf_2019) ^ (1/252) - 1
excret = colMeans(Data_11_port2,na.rm=T)-rf_2019_dia
CEncolhida2 = mvtportf(CovEst.2010RBLW(Data_11_port2)$S,excret)

Questão 12

Momentum

Começamos importando novas bases de dados que serão necessárias para realização dos backtests.

retornos <- read_excel("Retornos_ativos_ibrx_100.xlsx", col_types = c("date", rep("numeric", 1014)))
retornos <- retornos %>% dplyr::filter(Data >= "2014-05-30" & Data <= "2020-12-31")
retorno_IBRX <- read_excel("Retornos_ibrx100.xlsx", col_types = c("date", "numeric"))
retorno_IBRX <- retorno_IBRX %>% dplyr::filter(Data >= "2014-05-30" & Data <= "2020-12-31")
matriz_indicadora <- read_excel("Matriz_indicadora_mes.xlsx")
matriz_indicadora <- matriz_indicadora[,c(1,148:ncol(matriz_indicadora))]
ativos_eliminados <- setdiff(matriz_indicadora$Ativos, colnames(retornos))
"%ni%" <- Negate("%in%")
matriz_indicadora <- matriz_indicadora %>% dplyr::filter(Ativos %ni% ativos_eliminados)
nefin <- read_excel("Retornos_nefin.xlsx", col_types = c("date", rep("numeric", 5)))
nefin <- nefin %>% dplyr::filter(Data >= "2014-05-30" & Data <= "2020-12-31")

Como pode ser visto pela função “filter”, nossos backtests irão utilizar dados de 30/05/2014 a 31/12/2020.

Primeiro, iremos definir uma função que, com base nos ativos que pertecem ao IBRX em determinado trimestre, irá gerar uma carteira comprada nos ativos que geraram o maior retorno nos últimos n períodos.

#### Cria uma função que realiza o backtest da nossa estratégia #### ####
## Variável "a": coluna da composicao do índice em determinada data
## Variável "b" e "c": Data de início e fim do intervalo de estimação
## Variável "e" e "f": Data de início e fim do periodo de avaliação

backtest <- function(a,b,c,e,f){
  # Econtramos quais são os ativos presentes no IBRX em determinado trimestre 
  composicao_tri <- matriz_indicadora[, c(1, a)]
  names(composicao_tri) <- c("Codigos", "Trimestre")
  composicao_tri <- composicao_tri %>% dplyr::filter(Trimestre == 1)
  
  retornos <- retornos[,order(colnames(retornos))]
  
  # Selecionamos os retornos dos ativos presentes no IBRX em determinao trimestre    
  retornos_composicao_tri <- retornos %>% select(composicao_tri$Codigos) %>% mutate(Data = retornos$Data) %>% select(Data, everything())
  
  # Filtramos os nossos dados para trabalharmos com apenas um determinado período e excluímos a coluna de data    
  periodo_retornos <- retornos_composicao_tri %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data) 
  periodo_IBRX <- retorno_IBRX %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  periodo_nefin <- nefin %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  
  # Dropamos alguns ativos por não possuírem retorno para todo o período de estimação  
  periodo_retornos <- periodo_retornos[,colSums(is.na(periodo_retornos)) == 0]
  
  suporte1 <- periodo_retornos[1,] == 0 & 
    periodo_retornos[2,] == 0  & 
    periodo_retornos[3,] == 0  & 
    periodo_retornos[4,] == 0  & 
    periodo_retornos[5,] == 0
  suporte2 <- colnames(suporte1)[which(suporte1 == TRUE, arr.ind = TRUE)[,2]]
  periodo_retornos <- periodo_retornos[, !(names(periodo_retornos) %in% suporte2)]
  
  # Rodamos um for loop que calcula o retorno de cada ativo   
  coef1 <- numeric(length(periodo_retornos))
  for (i in 1:length(periodo_retornos)){
    coef1[i] <- prod(1 + periodo_retornos[[i]]) - 1
  }
  
  # Nomeamos os ativos  
  names(coef1) <- names(periodo_retornos)  
  
  # Transformamos o vetor em data frame    
  coef1 <- as.data.frame(coef1)
  
  # Ordenamos a data frame de modo que ativos com maior retorno fiquem nas primeiras linhas 
  coef1 <- coef1[order(-coef1$coef1),, drop = FALSE]
  
  # Definimos os ativos que serão comprados     
  ativos_comprado <- coef1[1:round(nrow(coef1)*0.3), , drop = FALSE]
  
  # Selecionamos os retornos desses ativos que serão comprados para o período de avaliação    
  retornos_ativos_comprado <- retornos %>% 
    select(Data, row.names(ativos_comprado)) %>% 
    dplyr::filter(Data > e & Data <= f)
  
  
  # Eliminamos ativos que tem NAs no período de avaliação
  retornos_ativos_comprado <- retornos_ativos_comprado[,colSums(is.na(retornos_ativos_comprado)) == 0]
  
  
  # Transformamos nossa df em time series para usarmos o PerformanceAnalytics   
  retornos_ativos_comprado <- xts(retornos_ativos_comprado[,2:ncol(retornos_ativos_comprado)], retornos_ativos_comprado$Data)
  
  # Reordenamos nossa df para que, agora, ativos com menor alfa fiquem nas primeiras linhas    
  coef1 <- coef1[order(coef1$coef1),, drop = FALSE]
  
  # Definimos os ativos que serão vendidos     
  ativos_vendido <- coef1[1:round(nrow(coef1)*0.3), , drop = FALSE]
  
  # Selecionamos os retornos desses ativos que serão comprados para o período de avaliação    
  retornos_ativos_vendido <-  retornos %>%  select(Data, row.names(ativos_vendido)) %>% dplyr::filter(Data > e & Data <= f)
  
  
  # Eliminamos ativos que tem NAs no período de avaliação
  retornos_ativos_vendido <- retornos_ativos_vendido[,colSums(is.na(retornos_ativos_vendido)) == 0]
  
  
  # Transformamos nossa df em time series para usarmos o PerformanceAnalytics    
  retornos_ativos_vendido <- xts(retornos_ativos_vendido[,2:ncol(retornos_ativos_vendido)], retornos_ativos_vendido$Data)
  
  # Para encontrar o retorno do portfólio equal weighted, 
  # primeiro dividimos os retornos pelo número de ativos e, em seguida, somamos esses retornos
  retornos_ativos_comprado <- retornos_ativos_comprado/ncol(retornos_ativos_comprado)
  retorno_comprado <- xts(rowSums(retornos_ativos_comprado), index(retornos_ativos_comprado))
  
  retornos_ativos_vendido <- retornos_ativos_vendido/ncol(retornos_ativos_vendido)
  retorno_vendido <- xts(rowSums(retornos_ativos_vendido), index(retornos_ativos_vendido))
  
  # Por fim, apresentamos os retornos dos portfólios L&S e Long Only
  retorno_portfolio_LS <- retorno_comprado - retorno_vendido 
  retorno_portfolio_Long <- retorno_comprado
  
  # "Imprime" retorno do portfólio L&S ou Long Only
  retorno_portfolio_LS
}

Agora, criamos uma outra função que fornece os parâmetros (argumentos) para nossa função inicial e nos retorna o retorno do portfólio comprado em empresas “winners”

argumentos <- function(periodo_estim, hold_period){
  vetor_composicao <- seq(from = 2, to = I(length(matriz_indicadora)))
  vetor_estim_inicial <- ymd(20140531) %m-% months(periodo_estim) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_estim_final <- ymd(20140531) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_aval_inicial <- ymd(20140531) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_aval_final <- ymd(20140531) %m+% months(hold_period + 0:I(length(matriz_indicadora) - 2))
  
  vetor_composicao <- vetor_composicao[seq(from = 1, to = length(vetor_composicao), by = hold_period)]
  vetor_estim_inicial <- vetor_estim_inicial[seq(from = 1, to = length(vetor_estim_inicial), by = hold_period)]
  vetor_estim_final <- vetor_estim_final[seq(from = 1, to = length(vetor_estim_final), by = hold_period)]
  vetor_aval_inicial <- vetor_aval_inicial[seq(from = 1, to = length(vetor_aval_inicial), by = hold_period)]
  vetor_aval_final <- vetor_aval_final[seq(from = 1, to = length(vetor_aval_final), by = hold_period)]
  
  vetor_composicao <- vetor_composicao[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_estim_inicial <- vetor_estim_inicial[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_estim_final <- vetor_estim_final[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_aval_inicial <- vetor_aval_inicial[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_aval_final <- vetor_aval_final[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  
  estrategia_retornos <- list()
  for(i in 1:length(vetor_aval_final)){
    estrategia_retornos[[i]] <- backtest(a = vetor_composicao[i], 
                                         b = vetor_estim_inicial[i],
                                         c = vetor_estim_final[i],
                                         e = vetor_aval_inicial[i],
                                         f = vetor_aval_final[i])
  }
  
  estrategia_retornos <- unlist(estrategia_retornos)
  
  tempo <-  retornos %>% dplyr::filter(Data > vetor_aval_inicial[1] & Data <= vetor_aval_final[length(vetor_aval_final)])
  
  estrategia_retornos <- xts(estrategia_retornos, tempo$Data)
  
  estrategia_retornos
  
}

Agora, apresentamos o gráfico da estratégia com rebalanceamento mensal e período de estimação de 6 meses:

E, para efeito de comparação, apresentamos o retorno da estratégia de momentum calculada pela Nefin:

Naive (IBRX Equal Weighted)

#### Cria uma função que realiza o backtest da nossa estratégia #### ####
## Variável "a": coluna da composicao do índice em determinada data
## Variável "e" e "f": Data de início e fim do periodo de avaliação

backtest <- function(a,e,f){
  # Econtramos quais são os ativos presentes no IBRX em determinado trimestre 
  composicao_tri <- matriz_indicadora[, c(1, a)]
  names(composicao_tri) <- c("Codigos", "Trimestre")
  composicao_tri <- composicao_tri %>% dplyr::filter(Trimestre == 1)
  
  retornos <- retornos[,order(colnames(retornos))]
  
  # Selecionamos os retornos dos ativos presentes no IBRX em determinao trimestre    
  retornos_composicao_tri <- retornos %>% select(composicao_tri$Codigos) %>% mutate(Data = retornos$Data) %>% select(Data, everything()) %>% dplyr::filter(Data > e & Data <= f)
  
  # Eliminamos os ativos que possuem apenas NAs
    retornos_composicao_tri <- retornos_composicao_tri[,colSums(is.na(retornos_composicao_tri)) == 0]
  
  # Transformamos nossa série de retornos em time series  
  retornos_tri <- xts(retornos_composicao_tri[,2:ncol(retornos_composicao_tri)], retornos_composicao_tri$Data)
  
  # Calculamos o retorno do portfólio
  retornos_ativos_comprado <- retornos_tri/ncol(retornos_tri)
  retorno_comprado <- xts(rowSums(retornos_ativos_comprado), index(retornos_ativos_comprado))

  # "Imprime" retorno do portfólio Long Only
  retorno_comprado
}

Volatility Timing

Os pesos do modelo de VT são definidos através da fórmula abaixo:

\[w_i = \frac{(\frac{1}{\sigma_i^2})^\rho}{\sum_{i=1}^N{(\frac{1}{\sigma_i^2})^\rho}}\]

Sendo que \(\rho\) indica a “medida de agressividade em que o investidor rebalanceia a carteira”. Para nossa análise consideraremos \(\rho\) igual a 4.

#### Cria uma função que realiza o backtest da nossa estratégia #### ####
## Variável "a": coluna da composicao do índice em determinada data
## Variável "b" e "c": Data de início e fim do intervalo de estimação
## Variável "e" e "f": Data de início e fim do periodo de avaliação

backtest <- function(a,b,c,e,f){
  # Econtramos quais são os ativos presentes no IBRX em determinado trimestre 
  composicao_tri <- matriz_indicadora[, c(1, a)]
  names(composicao_tri) <- c("Codigos", "Trimestre")
  composicao_tri <- composicao_tri %>% dplyr::filter(Trimestre == 1)
  
  retornos <- retornos[,order(colnames(retornos))]
  
  # Selecionamos os retornos dos ativos presentes no IBRX em determinao trimestre    
  retornos_composicao_tri <- retornos %>% select(composicao_tri$Codigos) %>% mutate(Data = retornos$Data) %>% select(Data, everything())
  
  # Filtramos os nossos dados para trabalharmos com apenas um determinado período e excluímos a coluna de data    
  periodo_retornos <- retornos_composicao_tri %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data) 
  periodo_IBRX <- retorno_IBRX %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  periodo_nefin <- nefin %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  
  # Dropamos alguns ativos por não possuírem retorno para todo o período de estimação  
  periodo_retornos <- periodo_retornos[,colSums(is.na(periodo_retornos)) == 0]
  
  suporte1 <- periodo_retornos[1,] == 0 & 
    periodo_retornos[2,] == 0  & 
    periodo_retornos[3,] == 0  & 
    periodo_retornos[4,] == 0  & 
    periodo_retornos[5,] == 0
  suporte2 <- colnames(suporte1)[which(suporte1 == TRUE, arr.ind = TRUE)[,2]]
  periodo_retornos <- periodo_retornos[, !(names(periodo_retornos) %in% suporte2)]
  
  # Rodamos um for loop que calcula o retorno de cada ativo   
  coef1 <- numeric(length(periodo_retornos))
  for (i in 1:length(periodo_retornos)){
    coef1[i] <- (1/var(periodo_retornos[[i]]))^4
  }
  
  # Calculamos os pesos
  coef1 <- coef1/sum(coef1)
  
  
  # Nomeamos os ativos  
  names(coef1) <- names(periodo_retornos)  
  
  # Selecionamos os retornos desses ativos que serão comprados para o período de avaliação    
  retornos_ativos_comprado <- retornos %>% 
    select(Data, names(coef1)) %>% 
    dplyr::filter(Data > e & Data <= f)
  
  
  # Eliminamos ativos que tem NAs no período de avaliação
  retornos_ativos_comprado <- retornos_ativos_comprado[,colSums(is.na(retornos_ativos_comprado)) == 0]
  
  coef1 <- coef1[names(coef1) %in% colnames(retornos_ativos_comprado)]
  
  # Calculamos o retorno dos portfólios como um produto matricial
  retorno_comprado <- as.matrix(retornos_ativos_comprado[,2:length(retornos_ativos_comprado)]) %*% coef1
  
  # "Imprime" retorno do portfólio L&S ou Long Only
  retorno_comprado
}

Agora, criamos uma outra função que fornece os parâmetros (argumentos) para nossa função inicial e nos retorna o retorno do portfólio comprado em empresas “winners”

argumentos <- function(periodo_estim, hold_period){
  vetor_composicao <- seq(from = 2, to = I(length(matriz_indicadora)))
  vetor_estim_inicial <- ymd(20140531) %m-% months(periodo_estim) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_estim_final <- ymd(20140531) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_aval_inicial <- ymd(20140531) %m+% months(0:I(length(matriz_indicadora) - 2))
  vetor_aval_final <- ymd(20140531) %m+% months(hold_period + 0:I(length(matriz_indicadora) - 2))
  
  vetor_composicao <- vetor_composicao[seq(from = 1, to = length(vetor_composicao), by = hold_period)]
  vetor_estim_inicial <- vetor_estim_inicial[seq(from = 1, to = length(vetor_estim_inicial), by = hold_period)]
  vetor_estim_final <- vetor_estim_final[seq(from = 1, to = length(vetor_estim_final), by = hold_period)]
  vetor_aval_inicial <- vetor_aval_inicial[seq(from = 1, to = length(vetor_aval_inicial), by = hold_period)]
  vetor_aval_final <- vetor_aval_final[seq(from = 1, to = length(vetor_aval_final), by = hold_period)]
  
  vetor_composicao <- vetor_composicao[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_estim_inicial <- vetor_estim_inicial[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_estim_final <- vetor_estim_final[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_aval_inicial <- vetor_aval_inicial[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  vetor_aval_final <- vetor_aval_final[1:(interval(ymd(20140531), ymd(20201231)) %/% months(hold_period))]
  
  estrategia_retornos <- list()
  for(i in 1:length(vetor_aval_final)){
    estrategia_retornos[[i]] <- backtest(a = vetor_composicao[i], 
                                         b = vetor_estim_inicial[i],
                                         c = vetor_estim_final[i],
                                         e = vetor_aval_inicial[i],
                                         f = vetor_aval_final[i])
  }
  
  estrategia_retornos <- unlist(estrategia_retornos)
  
  tempo <-  retornos %>% dplyr::filter(Data > vetor_aval_inicial[1] & Data <= vetor_aval_final[length(vetor_aval_final)])
  
  estrategia_retornos <- xts(estrategia_retornos, tempo$Data)
  
  estrategia_retornos
  
}

Miníma Variância

#### Cria uma função que realiza o backtest da nossa estratégia #### ####
## Variável "a": coluna da composicao do índice em determinada data
## Variável "b" e "c": Data de início e fim do intervalo de estimação
## Variável "e" e "f": Data de início e fim do periodo de avaliação

backtest <- function(a,b,c,e,f){
  # Econtramos quais são os ativos presentes no IBRX em determinado trimestre 
  composicao_tri <- matriz_indicadora[, c(1, a)]
  names(composicao_tri) <- c("Codigos", "Trimestre")
  composicao_tri <- composicao_tri %>% dplyr::filter(Trimestre == 1)
  
  retornos <- retornos[,order(colnames(retornos))]
  
  # Selecionamos os retornos dos ativos presentes no IBRX em determinao trimestre    
  retornos_composicao_tri <- retornos %>% select(composicao_tri$Codigos) %>% mutate(Data = retornos$Data) %>% select(Data, everything())
  
  # Filtramos os nossos dados para trabalharmos com apenas um determinado período e excluímos a coluna de data    
  periodo_retornos <- retornos_composicao_tri %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data) 
  periodo_IBRX <- retorno_IBRX %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  periodo_nefin <- nefin %>% dplyr::filter(Data > b & Data <= c) %>% select(!Data)
  
  # Dropamos alguns ativos por não possuírem retorno para todo o período de estimação  
  periodo_retornos <- periodo_retornos[,colSums(is.na(periodo_retornos)) == 0]
  
  suporte1 <- periodo_retornos[1,] == 0 & 
    periodo_retornos[2,] == 0  & 
    periodo_retornos[3,] == 0  & 
    periodo_retornos[4,] == 0  & 
    periodo_retornos[5,] == 0
  suporte2 <- colnames(suporte1)[which(suporte1 == TRUE, arr.ind = TRUE)[,2]]
  periodo_retornos <- periodo_retornos[, !(names(periodo_retornos) %in% suporte2)]
  
  matriz_cov <- cov(as.matrix(periodo_retornos))
  
  matriz_icov <- inv(matriz_cov)
  
  # Rodamos um for loop que calcula o retorno de cada ativo   
  as.matrix(periodo_retornos) %*% rep(1, length(ncol(periodo_retornos)))
  
  # Calculamos os pesos
  coef1 <- coef1/sum(coef1)
  
  
  # Nomeamos os ativos  
  names(coef1) <- names(periodo_retornos)  
  
  # Selecionamos os retornos desses ativos que serão comprados para o período de avaliação    
  retornos_ativos_comprado <- retornos %>% 
    select(Data, names(coef1)) %>% 
    dplyr::filter(Data > e & Data <= f)
  
  
  # Eliminamos ativos que tem NAs no período de avaliação
  retornos_ativos_comprado <- retornos_ativos_comprado[,colSums(is.na(retornos_ativos_comprado)) == 0]
  
  coef1 <- coef1[names(coef1) %in% colnames(retornos_ativos_comprado)]
  
  # Calculamos o retorno dos portfólios como um produto matricial
  retorno_comprado <- as.matrix(retornos_ativos_comprado[,2:length(retornos_ativos_comprado)]) %*% coef1
  
  # "Imprime" retorno do portfólio L&S ou Long Only
  retorno_comprado
}

Ao tentar rodar esse “chunck of code”, recebemos a seguinte a mensagem de erro:

Error in solve.default(x) : system is computationally singular: reciprocal condition number = 2.12036e-20

Pesquisando, encontramos que essa mensagem de erro é gerada quando tentamos inverter uma matriz que não é inversível. Por esse motivo, não poderemos fazer o backtest do portfólio de miníma variância.

Questão 13

Realizando a análise de todas as questões percebemos que os modelos utilizados de otimização de portfólios possuem vantagens e desvantagens. Os portfólios relacionados com a fronteira eficiente possuem problemas muito relevantes que inviabilizam sua utilização na prática sem uma boa dose de restrições, entretanto, o trabalho de Markowitz é tão importante porque foi o primeiro a utilizar metodologia científica em Finanças. Sem esse trabalho seminal, o campo, provavelmente, estaria anos atrasado.

Os desafios foram diversos incluindo a dificuldade em trabalhar com grandes volumes de dados e com características individuais. Por exemplo: para calcular o portfólio de momentum precisamos trabalhar com os retornos de um período anterior, ordenar os ativos com base no retorno acumulado, calcular o retorno dos portfólios levando em conta os ativos selecionados anteriormente e repetir esse processo para cada rebalanceamento.

Análises adicionais podem incorporar os avanços na literatura como o modelo de Black–Litterman, naive risk parity e hierarquical risk parity.