5.1. CAPM model visualization

library(quantmod)

## Загрузка требуемого пакета: xts

## Загрузка требуемого пакета: zoo

## 
## Присоединяю пакет: 'zoo'

## Следующие объекты скрыты от 'package:base':
## 
##     as.Date, as.Date.numeric

## 
## ################################### WARNING ###################################
## # We noticed you have dplyr installed. The dplyr lag() function breaks how    #
## # base R's lag() function is supposed to work, which breaks lag(my_xts).      #
## #                                                                             #
## # If you call library(dplyr) later in this session, then calls to lag(my_xts) #
## # that you enter or source() into this session won't work correctly.          #
## #                                                                             #
## # All package code is unaffected because it is protected by the R namespace   #
## # mechanism.                                                                  #
## #                                                                             #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## # You can 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.                                #
## ################################### WARNING ###################################

## Загрузка требуемого пакета: TTR

## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo

library(ggplot2)
library(PerformanceAnalytics)

## 
## Присоединяю пакет: 'PerformanceAnalytics'

## Следующий объект скрыт от 'package:graphics':
## 
##     legend

library(PortfolioAnalytics)

## Загрузка требуемого пакета: foreach

library(ggrepel)
library(dplyr)

## 
## Присоединяю пакет: 'dplyr'

## Следующие объекты скрыты от 'package:xts':
## 
##     first, last

## Следующие объекты скрыты от 'package:stats':
## 
##     filter, lag

## Следующие объекты скрыты от 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)

GAZP <- getSymbols("GAZP.ME", from = "2021-01-01", to = "2021-12-31", auto.assign = FALSE)
LKOH <- getSymbols("LKOH.ME", from = "2021-01-01", to = "2021-12-31", auto.assign = FALSE)
NLMK <- getSymbols("NLMK.ME", from = "2021-01-01", to = "2021-12-31", auto.assign = FALSE)
MAGN <- getSymbols("MAGN.ME", from = "2021-01-01", to = "2021-12-31", auto.assign = FALSE)
IMOEX <- getSymbols("IMOEX.ME", from = "2021-01-01", to = "2021-12-31", auto.assign = FALSE)

data_shares <- merge(GAZP$GAZP.ME.Close, LKOH$LKOH.ME.Close, 
                     NLMK$NLMK.ME.Close, MAGN$MAGN.ME.Close, 
                     IMOEX$IMOEX.ME.Close)
shares_return <- na.omit(Return.calculate(data_shares))
colnames(shares_return) <- c("GAZP", "LKOH", "NLMK", "MAGN", "IMOEX")
risk_free_rate <- 7.5/100/365

return_CAPM_GAZP <- CAPM.beta(shares_return$GAZP, shares_return$IMOEX)*(shares_return$IMOEX-risk_free_rate)+risk_free_rate
return_CAPM_LKOH <- CAPM.beta(shares_return$LKOH, shares_return$IMOEX)*(shares_return$IMOEX-risk_free_rate)+risk_free_rate
return_CAPM_NLMK <- CAPM.beta(shares_return$NLMK, shares_return$IMOEX)*(shares_return$IMOEX-risk_free_rate)+risk_free_rate
return_CAPM_MAGN <- CAPM.beta(shares_return$MAGN, shares_return$IMOEX)*(shares_return$IMOEX-risk_free_rate)+risk_free_rate

colnames(return_CAPM_GAZP) <- "GAZP"
colnames(return_CAPM_LKOH) <- "LKOH"
colnames(return_CAPM_NLMK) <- "NLMK"
colnames(return_CAPM_MAGN) <- "MAGN"

return_CAPM <- merge(return_CAPM_GAZP, return_CAPM_LKOH, return_CAPM_NLMK, return_CAPM_MAGN)
return_CAPM1 <- as.data.frame(Return.annualized(return_CAPM)) %>% pivot_longer(cols = "GAZP":"MAGN", names_to = "Ticker", values_to = "return_CAPM")

shares_return1 <- as.data.frame(Return.annualized(shares_return[,-5])) %>% pivot_longer(cols = "GAZP":"MAGN", names_to = "Ticker", values_to = "return_current")
return_total <- merge(return_CAPM1, shares_return1)
return_total$alpha <- return_total$return_current - return_total$return_CAPM
return_total$industry <- c("Oil & Gas", "Oil & Gas", "Metals & Mining", "Metals & Mining")

ggplot(data = return_total, aes(x = return_current, y = alpha, color = industry, label = Ticker)) + geom_rect(data=return_total, inherit.aes=FALSE, aes(xmin=min(return_total$return_current), xmax=max(return_total$return_current), ymin=0,ymax=max(return_total$alpha)), fill = "lightblue") +  geom_point() + theme_classic() + theme(legend.position = "bottom") + scale_color_manual(values = c("#fa5c18", "#7189bf")) + ylab("Недооцененность / Переоцененность") + xlab("Годовая доходность в долях") + ggtitle("Карта текущей доходности и характеристик оценки по российским компаниям") + labs(subtitle="Посчитано по 2021 гг.; недооцененость / переоцененость по модели CAPM") + annotate("text", x = 0.15, y=0.45, label = "Недооцененные компании по CAPM") + annotate("text", x = 0.15, y=-0.02, label = "Переоцененные компании по CAPM") + geom_label_repel(aes(label = Ticker))