# Load packages

# Core
library(tidyverse)
## ── Attaching packages ─────────────────────────────────────── tidyverse 1.3.2 ──
## ✔ ggplot2 3.4.0     ✔ purrr   1.0.1
## ✔ tibble  3.1.8     ✔ dplyr   1.1.0
## ✔ tidyr   1.3.0     ✔ stringr 1.5.0
## ✔ readr   2.1.3     ✔ forcats 1.0.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
library(tidyquant)
## Loading required package: lubridate
## 
## Attaching package: 'lubridate'
## 
## The following objects are masked from 'package:base':
## 
##     date, intersect, setdiff, union
## 
## Loading required package: PerformanceAnalytics
## Loading required package: xts
## Loading required package: zoo
## 
## Attaching package: 'zoo'
## 
## The following objects are masked from 'package:base':
## 
##     as.Date, as.Date.numeric
## 
## 
## Attaching package: 'xts'
## 
## The following objects are masked from 'package:dplyr':
## 
##     first, last
## 
## 
## Attaching package: 'PerformanceAnalytics'
## 
## The following object is masked from 'package:graphics':
## 
##     legend
## 
## Loading required package: quantmod
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(broom)

Import Stock Prices

symbols <- c("SPY", "EFA", "IJS", "EEM", "AGG")
prices <- tq_get(x = symbols,
                 get = "stock.prices", 
                 from = "2012-12-31",
                 to = "2017-12-31")

Convert Prices to Monthly Returns

asset_returns_tbl <- prices %>%
    
    group_by(symbol) %>%
    
    tq_transmute(select = adjusted,
                mutate_fun = periodReturn,
                period = "monthly",
                type = "log") %>%
    
    slice(-1) %>%
    
    ungroup()

set_names(c("asset", "date", "returns"))
##     asset      date   returns 
##   "asset"    "date" "returns"

Assign Weight to each Asset

# symbols
symbols <- asset_returns_tbl %>% distinct(symbol) %>% pull()
    

# weights
weights <- c(0.25, 0.25, 0.2, 0.2, 0.1)
weights
## [1] 0.25 0.25 0.20 0.20 0.10
w_tbl <- tibble(symbols, weights)
w_tbl
## # A tibble: 5 × 2
##   symbols weights
##   <chr>     <dbl>
## 1 AGG        0.25
## 2 EEM        0.25
## 3 EFA        0.2 
## 4 IJS        0.2 
## 5 SPY        0.1

Build a Portfolio

portfolio_returns_tbl <- asset_returns_tbl %>%
    tq_portfolio(assets_col = symbol, 
                 returns_col = monthly.returns,
                 weights = w_tbl,
                rebalance_on = "months", 
                col_rename = "returns")

portfolio_returns_tbl
## # A tibble: 60 × 2
##    date        returns
##    <date>        <dbl>
##  1 2013-01-31  0.0204 
##  2 2013-02-28 -0.00239
##  3 2013-03-28  0.0121 
##  4 2013-04-30  0.0174 
##  5 2013-05-31 -0.0128 
##  6 2013-06-28 -0.0247 
##  7 2013-07-31  0.0321 
##  8 2013-08-30 -0.0224 
##  9 2013-09-30  0.0511 
## 10 2013-10-31  0.0301 
## # … with 50 more rows

Calculate CAPM Beta

5.1 Get market returns

market_retruns_tbl <- tq_get(x = "SPY",
                 get = "stock.prices", 
                 from = "2012-12-31",
                 to = "2017-12-31")  %>%
    
    tq_transmute(select = adjusted,
                mutate_fun = periodReturn,
                period = "monthly",
                type = "log", col_rename = "returns") %>%
    
    slice(-1)

Join returns

portfolio_market_returns_tbl <- left_join(market_retruns_tbl, 
                                  portfolio_returns_tbl,
                                  "date") %>%
    
    set_names("date", "market_returns", "portfolio_returns")

CAPM Beta

portfolio_market_returns_tbl %>%
    
    tq_performance(Ra = portfolio_returns, 
                   Rb = market_returns,
                    performance_fun = CAPM.beta)
## # A tibble: 1 × 1
##   CAPM.beta.1
##         <dbl>
## 1       0.738

Plot

Scatter plot of returns with regression line

portfolio_market_returns_tbl %>%
    
    ggplot(aes(x = market_returns,
               y = portfolio_returns)) +
    
    geom_point(color = "cornflowerblue") +

geom_smooth(method = "lm", se = FALSE,
size = 1.5, color = tidyquant::palette_light()[3]) +
    
    labs(x = "portfolio returns", 
         y = "market returns")
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## `geom_smooth()` using formula = 'y ~ x'

Line plot of fitted vs actual returns

actual_fitted_long_tbl <- portfolio_market_returns_tbl %>%
    
    # linear regregression model
    lm(portfolio_returns ~ market_returns, data = .) %>%
    
    # get fitted and actual returns
    broom::augment() %>%
    
    # Add date
    mutate(date = portfolio_market_returns_tbl$date) %>%
    select(date, portfolio_returns, .fitted) %>%
    
    
    # transform data to long term
    pivot_longer(cols = c(portfolio_returns, .fitted), names_to = "type",
                        values_to = "returns")

actual_fitted_long_tbl %>%
    ggplot(aes(x = date, y = returns, color = type)) +
    geom_line()