FundExcess
#Installing packages as needed
#NOTE: This statement essentially checks if PerformanceAnalytics package is available #locally in your R library distribution. If not, it will install it and then include it #as a part of this code, so that we can use its functions and features
if (!require(tidyverse)) install.packages("tidyverse")
## Loading required package: tidyverse
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v ggplot2 3.3.5 v purrr 0.3.4
## v tibble 3.1.7 v dplyr 1.0.7
## v tidyr 1.1.4 v stringr 1.4.0
## v readr 2.1.1 v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
if (!require(tidyquant)) install.packages("tidyquant")
## Loading required package: 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
if (!require(PerformanceAnalytics)) install.packages("PerformanceAnalytics")
if (!require(xts)) install.packages("xts")
if (!require(lubridate)) install.packages("lubridate")
#Package Details
#1) Tidyverse: The tidyverse is an opinionated collection of R packages designed for data science. All packages share an underlying design philosophy, grammar, and data structures: https://www.tidyverse.org/
#2)Tidyquant: The ‘tidyquant’ package provides a convenient wrapper to various ‘xts’, ‘zoo’, ‘quantmod’ and ‘TTR’ package functions and returns the objects in the tidy ‘tibble’ format. The main advantage is being able to use quantitative functions with the ‘tidyverse’ functions including ‘purrr’, ‘dplyr’, ‘tidyr’, ‘ggplot2’, ‘lubridate’, etc: https://www.rdocumentation.org/packages/tidyquant/versions/0.3.0
#3)Performanceanalytics: A very useful package for investment and financial performance and risk #analytics. Official Documentation: https://www.rdocumentation.org/packages/PerformanceAnalytics/versions/1.5.3 #Presentation Deck by Package Founders: http://past.rinfinance.com/RinFinance2009/presentations/PA%20Workshop%20Chi%20RFinance%202009-04.pdf #Quick Video on calculating returns: https://www.youtube.com/watch?v=0rAVPUNf9yI
#4) xts: xts is a useful packge useful in time-series analysis. We use xts package here since #PerformanceAnalytics functions usually require xts objects (time-series of prices etc.) rather than simple #lists of prices for more accurate performance evaluation
#5) lubridate: lubridate is a date manipulation package. We use mdy() function of lubridate to standardize dates of our data #Useful Resource: https://raw.githubusercontent.com/rstudio/cheatsheets/master/lubridate.pdf
library(tidyverse)
library(tidyquant)
library(PerformanceAnalytics)
library(xts)
library(lubridate)
tickers <- c(
"SPY",
"EFA",
"IJS",
"EEM",
"AGG",
"TLT",
"VNQ")
tickers <- "SPY"
prices_volume_via_tq_2020 <-
tickers %>%
tq_get(get = "stock.price", from = "2020-01-01") %>%
select(date,ticker = symbol, close, volume) %>%
mutate(date = as.Date(date))
#Financial asset (individual stocks, securities, etc) and portfolio (groups of stocks, securities, etc) performance analysis is a deep field with a wide range of theories and methods for analyzing risk versus reward. The PerformanceAnalytics package consolidates functions to compute many of the most widely used performance metrics. tidquant integrates this functionality so it can be used at scale using the split, apply, combine framework within the tidyverse. Two primary functions integrate the performance analysis functionality:
##tq_performance implements the performance analysis functions in a tidy way, enabling scaling analysis using the split, apply, combine framework. ##tq_portfolio provides a useful tool set for aggregating a group of individual asset returns into one or many portfolios.
#An important concept is that performance analysis is based on the statistical properties of returns (not prices). As a result, this package uses inputs of time-based returns as opposed to stock prices. The arguments change to Ra for the asset returns and Rb for the baseline returns. We’ll go over how to get returns in the Workflow section.
#Another important concept is the baseline. The baseline is what you are measuring performance against. A baseline can be anything, but in many cases it’s a representative average of how an investment might perform with little or no effort. Often indexes such as the S&P500 are used for general market performance. Other times more specific Exchange Traded Funds (ETFs) are used such as the SPDR Technology ETF (XLK). The important concept here is that you measure the asset performance (Ra) against the baseline (Rb).
stock_prices <- c("AAPL", "GOOG", "NFLX") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = Sys.Date())
stock_returns_monthly <- stock_prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra")
baseline_returns_monthly <- "XLK" %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = Sys.Date()) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Rb")
#The tidyquant function, tq_portfolio() aggregates a group of individual assets into a single return using a weighted composition of the underlying assets. To do this we need to first develop portfolio weights. We supplying a vector of weights and form the portfolio.
wts <- c(0.4, 0.3, 0.3)
portfolio_returns_monthly <- stock_returns_monthly %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = wts,
col_rename = "Ra")
RaRb_single_portfolio <- left_join(portfolio_returns_monthly,
baseline_returns_monthly,
by = "date")
RaRb_single_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.CAPM) %>%
select(Alpha, AnnualizedAlpha, Beta, Correlation, 'R-squared')
## # A tibble: 1 x 5
## Alpha AnnualizedAlpha Beta Correlation `R-squared`
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 0.0085 0.107 1.08 0.572 0.327
stock_returns_monthly_multi <- stock_returns_monthly %>%
tq_repeat_df(n = 3)
## Ungrouping data frame groups: symbol
#Examining the results, we can see that a few things happened:
##The length (number of rows) has tripled. This is the essence of tq_repeat_df: it grows the data frame length-wise, repeating the data frame n times. In our case, n = 3. ##Our data frame, which was grouped by symbol, was ungrouped. This is needed to prevent tq_portfolio from blending on the individual stocks. tq_portfolio only works on groups of stocks. ##We have a new column, named “portfolio”. The “portfolio” column name is a key that tells tq_portfolio that multiple groups exist to analyze. Just note that for multiple portfolio analysis, the “portfolio” column name is required. ##We have three groups of portfolios. This is what tq_portfolio will split, apply (aggregate), then combine on.
#Now the tricky part: We need a new table of weights to map on. There’s a few requirements:
##We must supply a three column tibble with the following columns: “portfolio”, asset, and weight in that order. ##The “portfolio” column must be named “portfolio” since this is a key name for mapping. ##The tibble must be grouped by the portfolio column.
#Here’s what the weights table should look like:
weights <- c(
0.50, 0.25, 0.25,
0.25, 0.50, 0.25,
0.25, 0.25, 0.50
)
stocks <- c("AAPL", "GOOG", "NFLX")
weights_table <- tibble(stocks) %>%
tq_repeat_df(n = 3) %>%
bind_cols(tibble(weights)) %>%
group_by(portfolio)
weights_table
## # A tibble: 9 x 3
## # Groups: portfolio [3]
## portfolio stocks weights
## <int> <chr> <dbl>
## 1 1 AAPL 0.5
## 2 1 GOOG 0.25
## 3 1 NFLX 0.25
## 4 2 AAPL 0.25
## 5 2 GOOG 0.5
## 6 2 NFLX 0.25
## 7 3 AAPL 0.25
## 8 3 GOOG 0.25
## 9 3 NFLX 0.5
portfolio_returns_monthly_multi <- stock_returns_monthly_multi %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = weights_table,
col_rename = "Ra")
#we merge with the baseline using “date” as the key.
RaRb_multiple_portfolio <- left_join(portfolio_returns_monthly_multi,
baseline_returns_monthly,
by = "date")
RaRb_multiple_portfolio %>%
tq_performance(Ra = Ra, Rb = Rb, performance_fun = table.CAPM) %>%
select(Alpha, AnnualizedAlpha, Beta, Correlation, 'R-squared')
## Adding missing grouping variables: `portfolio`
## # A tibble: 3 x 6
## # Groups: portfolio [3]
## portfolio Alpha AnnualizedAlpha Beta Correlation `R-squared`
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 0.0079 0.099 1.10 0.626 0.392
## 2 2 0.0072 0.0898 1.07 0.585 0.342
## 3 3 0.012 0.153 1.04 0.439 0.193
wts <- c(0.4, 0.3, 0.3)
portfolio_returns_monthly <- stock_returns_monthly %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = wts,
col_rename = "Ra")
portfolio_returns_monthly %>%
ggplot(aes(x = date, y = Ra)) +
geom_bar(stat = "identity", fill = palette_light()[[1]]) +
labs(title = "Portfolio Returns",
subtitle = "40% AAPL, 30% GOOG, and 30% NFLX",
caption = "Shows an above-zero trend meaning positive returns",
x = "", y = "Monthly Returns") +
geom_smooth(method = "lm") +
theme_tq() +
scale_color_tq() +
scale_y_continuous(labels = scales::percent)
## `geom_smooth()` using formula 'y ~ x'
wts <- c(0.4, 0.3, 0.3)
portfolio_growth_monthly <- stock_returns_monthly %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = wts,
col_rename = "investment.growth",
wealth.index = TRUE) %>%
mutate(investment.growth = investment.growth * 1000)
portfolio_growth_monthly %>%
ggplot(aes(x = date, y = investment.growth)) +
geom_line(size = 2, color = palette_light()[[1]]) +
labs(title = "Portfolio Growth",
subtitle = "40% AAPL, 30% GOOG, and 30% NFLX",
caption = "Now we can really visualize performance!",
x = "", y = "Portfolio Value") +
geom_smooth(method = "loess") +
theme_tq() +
scale_color_tq() +
scale_y_continuous(labels = scales::dollar)
## `geom_smooth()` using formula 'y ~ x'
#Finally, taking this one step further, we apply the same process to the “Multiple Portfolio” example:
##50% AAPL, 25% GOOG, 25% NFLX ##25% AAPL, 50% GOOG, 25% NFLX ##25% AAPL, 25% GOOG, 50% NFLX
portfolio_growth_monthly_multi <- stock_returns_monthly_multi %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = weights_table,
col_rename = "investment.growth",
wealth.index = TRUE) %>%
mutate(investment.growth = investment.growth * 1000)
portfolio_growth_monthly_multi %>%
ggplot(aes(x = date, y = investment.growth, color = factor(portfolio))) +
geom_line(size = 2) +
labs(title = "Portfolio Growth",
subtitle = "Comparing Multiple Portfolios",
caption = "Portfolio 3 is a Standout!",
x = "", y = "Portfolio Value",
color = "Portfolio") +
geom_smooth(method = "loess") +
theme_tq() +
scale_color_tq() +
scale_y_continuous(labels = scales::dollar)
## `geom_smooth()` using formula 'y ~ x'
stock_prices <- c("BIIB", "RDY", "GSK","PFE","JNJ","COST","PG","PEP","CL","BA","NOC","GD","HSBC","JPM","MS","WFC","AAPL","GOOG","NFLX","AMZN") %>%
tq_get(get = "stock.prices",
from = "2010-01-01",
to = "2018-06-01")
#stock_prices
stock_returns_monthly <- stock_prices %>%
group_by(symbol) %>%
tq_transmute(select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "Ra")
#stock_returns_monthly
pharma_weights <- c(0.2,0.2,0.2,0.2,0.2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
equal_weights <- c(0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05)
portfolio_returns_monthly_pharma <- stock_returns_monthly %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = pharma_weights,
col_rename = "Ra") %>% mutate(date=substring(date,1,7)) %>%
rename(Date=date)
#portfolio_returns_monthly
portfolio_returns_monthly_diverse <- stock_returns_monthly %>%
tq_portfolio(assets_col = symbol,
returns_col = Ra,
weights = equal_weights,
col_rename = "Ra") %>% mutate(date=substring(date,1,7)) %>%
rename(Date=date)
#portfolio_returns_monthly
#contra_fund<-read.csv("contrafund.csv")
contra_fund<-read.csv("C:/Users/shant/OneDrive/Documents/GA Tech/MGT 6203/MidTerm/Part 2/contrafund.csv", header=TRUE, stringsAsFactors=FALSE, fileEncoding="UTF-8-BOM")
contra_fund$Date<-mdy(contra_fund$Date)
contra_fund <- contra_fund %>% mutate(Date=substring(Date,1,7))
#Reading contrafund CSV for comparison and to get market and risk free data. Contrafund is a mutual fund operated by Fidelity investments with an AUM of over $112 Billion.
final_portfolio_pharma <- left_join(portfolio_returns_monthly_pharma,
contra_fund,
by = "Date") %>% mutate(Date=paste(Date,"01",sep="-"))
final_portfolio_pharma$Date <- as.Date(as.character(final_portfolio_pharma$Date))
final_data_pharma <-xts(final_portfolio_pharma[,-1],final_portfolio_pharma$Date)
sharperatio_contra <- SharpeRatio(final_data_pharma$ContraRet,final_data_pharma$Risk.Free)
sharperatio_pharma <-SharpeRatio(final_data_pharma$Ra,final_data_pharma$Risk.Free)
Return.cumulative(final_data_pharma, geometric =TRUE)
## Ra ContraRet Market.Return Risk.Free
## Cumulative Return 1.643605 2.150156 1.963436 0.01846127
chart.CumReturns(final_data_pharma, wealth.index =FALSE, geometric = TRUE, legend.loc = "topleft")
final_portfolio_diverse <- left_join(portfolio_returns_monthly_diverse,
contra_fund,
by = "Date") %>% mutate(Date=paste(Date,"01",sep="-"))
final_portfolio_diverse$Date <- as.Date(as.character(final_portfolio_diverse$Date))
final_data_diverse <-xts(final_portfolio_diverse[,-1],final_portfolio_diverse$Date)
sharperatio_contra <- SharpeRatio(final_data_diverse$ContraRet,final_data_diverse$Risk.Free)
sharperatio_diverse <-SharpeRatio(final_data_diverse$Ra,final_data_diverse$Risk.Free)
Return.cumulative(final_data_diverse, geometric =TRUE)
## Ra ContraRet Market.Return Risk.Free
## Cumulative Return 4.958707 2.150156 1.963436 0.01846127
chart.CumReturns(final_data_diverse, wealth.index =FALSE, geometric = TRUE, legend.loc = "topleft")
sharperatio_pharma
## Ra
## StdDev Sharpe (Rf=0%, p=95%): 0.2394144
## VaR Sharpe (Rf=0%, p=95%): 0.1826114
## ES Sharpe (Rf=0%, p=95%): 0.1449073
sharperatio_diverse
## Ra
## StdDev Sharpe (Rf=0%, p=95%): 0.4328820
## VaR Sharpe (Rf=0%, p=95%): 0.3607376
## ES Sharpe (Rf=0%, p=95%): 0.2214831
sharperatio_contra
## ContraRet
## StdDev Sharpe (Rf=0%, p=95%): 0.3438307
## VaR Sharpe (Rf=0%, p=95%): 0.2664665
## ES Sharpe (Rf=0%, p=95%): 0.1969612
treynor_pharma <- TreynorRatio(final_data_pharma$Ra,final_data_pharma$Market.Return,final_data_pharma$Risk.Free)
treynor_pharma
## [1] 0.1663588
treynor_diverse <- TreynorRatio(final_data_diverse$Ra,final_data_diverse$Market.Return,final_data_diverse$Risk.Free)
treynor_diverse
## [1] 0.2556795
Pharma_Jensen_df<-transform(final_data_pharma,MktExcess=Market.Return-Risk.Free,FundExcess=Ra-Risk.Free)
head(Pharma_Jensen_df)
## Ra ContraRet Market.Return Risk.Free Market.Return.1
## 2010-01-01 -0.035943968 -0.045813 -0.0336 0e+00 -0.0336
## 2010-02-01 -0.002249311 0.028474 0.0340 0e+00 0.0340
## 2010-03-01 0.048948286 0.055692 0.0632 1e-04 0.0631
## 2010-04-01 -0.029350930 0.016589 0.0201 1e-04 0.0200
## 2010-05-01 -0.065618695 -0.065764 -0.0788 1e-04 -0.0789
## 2010-06-01 0.015152294 -0.032489 -0.0555 1e-04 -0.0556
## Ra.1
## 2010-01-01 -0.035943968
## 2010-02-01 -0.002249311
## 2010-03-01 0.048848286
## 2010-04-01 -0.029450930
## 2010-05-01 -0.065718695
## 2010-06-01 0.015052294
Alpha_pharma=lm(Ra.1~Market.Return.1,data=Pharma_Jensen_df)
summary(Alpha_pharma)
##
## Call:
## lm(formula = Ra.1 ~ Market.Return.1, data = Pharma_Jensen_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.082464 -0.019809 -0.002269 0.023648 0.112061
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.002289 0.003681 0.622 0.535
## Market.Return.1 0.721320 0.098748 7.305 7.17e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.03527 on 99 degrees of freedom
## Multiple R-squared: 0.3502, Adjusted R-squared: 0.3437
## F-statistic: 53.36 on 1 and 99 DF, p-value: 7.167e-11
Diverse_Jensen_df<-transform(final_data_diverse,MktExcess=Market.Return-Risk.Free,FundExcess=Ra-Risk.Free)
Alpha_diverse=lm(Ra.1~Ra.1,data=Diverse_Jensen_df)
summary(Alpha_diverse)
##
## Call:
## lm(formula = Ra.1 ~ Ra.1, data = Diverse_Jensen_df)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.147298 -0.027163 0.001171 0.030835 0.154368
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.018547 0.004258 4.355 3.22e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.0428 on 100 degrees of freedom
temp_pharma <- select(final_portfolio_pharma, Date, Ra) %>% rename(R_pharma = Ra)
temp_diverse <- select(final_portfolio_diverse, Date, Ra) %>% rename(R_diverse = Ra)
Comparison_df <- inner_join(temp_pharma, temp_diverse, by = "Date")
ggplot_demo <- Comparison_df %>% mutate(R_pharma=R_pharma+1,R_diverse=R_diverse+1)%>%mutate(Pharma_Cumul = cumprod(R_pharma),Diverse_cumul = cumprod(R_diverse)) %>% select(Date,Pharma_Cumul,Diverse_cumul)
ggplot(ggplot_demo, aes(x=Date))+geom_line(aes(y=Pharma_Cumul, color="Pharma"))+geom_line(aes(x=Date,y=Diverse_cumul,color="Diverse"))+ggtitle("Portfolio Cumulative Returns over Time")+xlab("Year")+ylab("Cumulative Returns") + scale_color_manual(breaks = c("Pharma", "Diverse"), values = c("blue", "black")) + labs(color = "Portfolio")