In alejandro-sotolongo/InvestmentSuite: Investment Asset and Portfolio Time-Series Analysis

knitr::opts_chunk$set(echo = FALSE, warning = FALSE, error = FALSE, 
                      message = FALSE)

library(InvestmentSuite)
library(kableExtra)
library(ggplot2)
data(SampleFundReport)
data(RF)
data(ETF)
data(FF)
combo_all <- combine_time_series(fund, bench, freq = 'w', trunc_start = FALSE)
combo <- combine_time_series(fund, bench, freq = 'w')
combo_d <- combine_time_series(fund, bench, freq = 'd')
asof <- as.Date('2019-12-30')
fund_w <- change_freq(fund, 'w')

\newpage

Summary

Fund: Fidelity Contrafund (FCNTX)

Benchmark for this report: IShares Russell 1000 Growth ETF (IWF)

AUM: $119,700 MM

Expense Ratio: 0.82%

Fund Objective: The investment seeks capital appreciation. The fund normally invests primarily in common stocks. It invests in securities of companies whose value the advisor believes is not fully recognized by the public. The fund invests in domestic and foreign issuers. It invests in either "growth" stocks or "value" stocks or both. The fund uses fundamental analysis of factors such as each issuer's financial condition and industry position, as well as market and economic conditions to select investments.

Inception: May 17, 1967

PMs: William Danoff, Sep 1990 to Present.

\newpage

Performance Summary

Max data available. Fund r min(fund$date), Benchmark r min(bench$date)

res <- tbl_cal_perf(combo_all, freq = 'w', asof = asof)
df_to_kable(res$fmt)

Max common weekly overlap r min(combo$date)

wealth_index <- ret_to_price(combo)
chart_line(wealth_index) +
  ylab('Hypothetical value of $1 investment') +
  theme(legend.position = 'bottom')

\vspace{18pt}

res <- tbl_perf_summary(fund, bench, rf, 'w')
df_to_kable(res$fmt)

\newpage

Drawdowns

Fund and Benchmark Overlap

dd <- drawdown(combo)
chart_line(dd) +
  ylab('Peak to trough loss') +
  scale_y_continuous(labels = fPercent) +
  theme(legend.position = 'bottom')

\vspace{18pt}

Fund Only

dd <- drawdown(fund)
chart_line(dd) +
  ylab('Peak to trough loss') +
  scale_y_continuous(labels = fPercent) +
  theme(legend.position = 'bottom')

\newpage

Fund

dd_tbl <- worst_n_drawdowns(fund, 10)
dd_tbl$Drawdown <- fPercent(dd_tbl$Drawdown)
df_to_kable(dd_tbl, TRUE)

Fund Truncated to Benchmark Overlap

fund_trunc <- trunc_time_series(fund, min(bench$date))
dd_tbl <- worst_n_drawdowns(fund_trunc, 10)
dd_tbl$Drawdown <- fPercent(dd_tbl$Drawdown)
df_to_kable(dd_tbl, TRUE)

Benchmark

dd_tbl <- worst_n_drawdowns(bench, 10)
dd_tbl$Drawdown <- fPercent(dd_tbl$Drawdown)
df_to_kable(dd_tbl, TRUE)

\newpage

Correlation

all_ret <- combine_time_series(fund, ret, freq = 'w')
clust <- pca_hclust(all_ret)
plot(clust, labels = colnames(all_ret)[2:ncol(all_ret)], ann = FALSE)
title('Hierachical Clustering around Latents')

df_to_kable(tbl_cov(all_ret))

\newpage

Fama-French Factors

Fund

res <- run_reg(fund, combine_time_series(ff$ff_5, ff$ff_mo, freq = 'w'), rf, 'w')
df <- res$fmt
df_to_kable(df, TRUE)

Fund and Benchmark Overlap

res2 <- run_reg(combo, combine_time_series(ff$ff_5, ff$ff_mo, freq = 'w'), rf, 'w')
df <- res2$fmt
df_to_kable(df, TRUE)

df <- data.frame(y = res$fit[[1]]$model[, 1], 
                 y_hat = res$fit[[1]]$fitted.values)
idx <- rownames(res$fit[[1]]$model)
idx <- as.numeric(idx)
dt <- fund_w$date[idx]
names(res$fit[[1]]$residuals) <- dt
opar <- par()
par(mfrow = c(2, 2))
plot(res$fit[[1]])

Distribution

Fund Since Inception

tidyfund <- tidy_ret(fund_w)
ggplot(tidyfund, aes(x = values, fill = series)) +
  geom_density() +
  scale_x_continuous(labels = fPercent) +
  xlab('weekly returns')

Fund and Benchmark Overlap

tidycombo <- tidy_ret(combo)
ggplot(tidycombo, aes(x = values, fill = series)) +
  geom_density(position = 'stack') +
  scale_x_continuous(labels = fPercent) +
  xlab('weekly returns')

\newpage

Rolling Stats

Mean: Rolling 52 weeks

res <- roll_mean(fund_w, xwin = 54)
chart_line(res) +
  geom_path() +
  scale_y_continuous(labels = fPercent) +
  ylab('Weekly return') +
  theme(legend.position = 'bottom')

Mean: Rolling 60 months

res <- roll_mean(change_freq(fund, 'm'), 60)
chart_line(res) +
  scale_y_continuous(labels = fPercent) +
  ylab('Monthly return') +
  theme(legend.position = 'bottom')

\newpage

Mean: Rolling 52 weeks

res <- roll_mean(combo, xwin = 54)
chart_line(res) +
  scale_y_continuous(labels = fPercent) +
  ylab('Weekly return') +
  theme(legend.position = 'bottom')

Mean fund less benchmark: Rolling 54 weeks

res <- roll_excess_mean(fund, bench, 'w', 54)
chart_line(res) +
  scale_y_continuous(labels = fPercent) +
  ylab('Weekly excess return') +  
  theme(legend.position = 'bottom')

\newpage

Fund beta to benchmark: Rolling 26 weeks

res <- roll_beta(fund, bench, 'w', 26)
chart_line(res) +
  ylab('Beta') +  
  theme(legend.position = 'none')

Fund annualized standard deviation: Rolling 26 weeks

res <- roll_vol(fund, 26, 'w')
chart_line(res) +
  ylab('Annual Standard Deviation') + 
  scale_y_continuous(labels = fPercent) +
  theme(legend.position = 'none')

\newpage

Diversification Potential

Rolling absorption ratio for diversified ETF portfolio with and without the Fund

c87186ed59a060ac4350fc2a3627b71fc4609c5c

port_a <- roll_absorp_ratio(ret)
port_b <- roll_absorp_ratio(combine_time_series(fund, ret, freq = 'd'))
df <- data.frame(Date = port_a$date, 
                 Port = port_a$absorp.ratio, 
                 Port.w.Fund = port_b$absorp.ratio)
chart_line(df) +
  ylab('Rolling Absorption Ratio') +
  theme(legend.position = 'bottom')

PCA of diversified ETF portfolio with and without the Fund

x <- combine_time_series(fund, ret, freq = 'w')

p <- princomp(cor(x[, 2:ncol(x)]), cor = TRUE)
df <- data.frame(p$loadings[, 1:4])
df$Asset <- rownames(df)
plotdf <- tidyr::pivot_longer(df, c(Comp.1, Comp.2, Comp.3, Comp.4), 
                              names_to = 'PC', values_to = 'values')
plotdf$Asset <- factor(plotdf$Asset, unique(plotdf$Asset))
ggplot(plotdf, aes(x = Asset, y = values)) +

p1 <- princomp(cor(x[, 2:ncol(x)]), cor = TRUE)
p2 <- princomp(cor(x[, 3:ncol(x)]), cor = TRUE)
cve1 <- cumsum(p1$sdev^2) / sum(p1$sdev^2)
cve2 <- cumsum(p2$sdev^2) / sum(p2$sdev^2)
df <- data.frame(Without.Fund = cve1[1:8], With.Fund = cve2[1:8], PC = 1:8)
tidy_df <- tidyr::pivot_longer(df, c(Without.Fund, With.Fund), 
                               names_to = 'series', values_to = 'values')
ggplot(tidy_df, aes(x = PC, y = values, fill = series)) +
  geom_bar(stat = 'identity', position = 'dodge') +
  ylab('Cumulative Variance Explained') +
  scale_x_continuous(breaks = 1:8) +
  scale_y_continuous(labels = fPercent) +
  theme(legend.position = 'bottom')

PCA Loadings

# df <- data.frame(p1$loadings[, 1:8])
# df$Asset <- rownames(df)
# plotdf <- tidyr::pivot_longer(df, c(Comp.1, Comp.2, Comp.3, Comp.4, 
#                                     Comp.5, Comp.6, Comp.7, Comp.8), 
#                               names_to = 'PC', values_to = 'values')
# plotdf$Asset <- factor(plotdf$Asset, unique(plotdf$Asset))
# ggplot(plotdf, aes(x = Asset, y = values)) +
#   geom_bar(stat = 'identity', position = 'dodge') +
#   coord_flip() +
#   facet_wrap(.~ PC) +
#   theme(axis.text.x = element_text(angle = 90))
p_chart <- chart_pca(x)
p_chart$loadings

alejandro-sotolongo/InvestmentSuite documentation built on Jan. 19, 2020, 5:20 p.m.