Part 1.

Chapter 6 Problem set 21

# Input values
params <- list(E_rP = 0.11, sigma_P = 0.15, r_f = 0.05, target_return = 0.08, sigma_target = 0.12)

# Client 1: Allocation
alloc_client1 <- with(params, {
  y <- (target_return - r_f) / (E_rP - r_f)
  x <- 1 - y
  list(y = y, x = x, sigma = y * sigma_P)
})

# Client 2: Allocation
alloc_client2 <- with(params, {
  y <- sigma_target / sigma_P
  E_r <- r_f + y * (E_rP - r_f)
  list(y = y, E_r = E_r)
})

# Risk aversion
risk_aversion <- with(params, {
  a1 <- (E_rP - r_f) / sigma_P / alloc_client1$y
  a2 <- (E_rP - r_f) / sigma_P / alloc_client2$y
  more_risk_averse <- ifelse(a1 > a2, "Client 1", "Client 2")
  list(a1 = a1, a2 = a2, more = more_risk_averse)
})

alloc_client1
## $y
## [1] 0.5
## 
## $x
## [1] 0.5
## 
## $sigma
## [1] 0.075
alloc_client2
## $y
## [1] 0.8
## 
## $E_r
## [1] 0.098
risk_aversion
## $a1
## [1] 0.8
## 
## $a2
## [1] 0.5
## 
## $more
## [1] "Client 1"

Chapter 6 Problem set 22

# Market inputs
market <- list(E_rM = 0.12, sigma_M = 0.20, r_f = 0.05, sigma_C = 0.10)

# Portfolio return via CML
allocation <- with(market, {
  y <- sigma_C / sigma_M
  E_r <- r_f + y * (E_rM - r_f)
  list(y = y, E_r = E_r)
})

allocation
## $y
## [1] 0.5
## 
## $E_r
## [1] 0.085

Chapter 6 CFA Problem 8

# Portfolio values
portfolio <- list(w_E = 0.6, w_F = 0.4, risk_premium = 0.10, rf = 0.06, sd_equity = 0.14)

# Calculations
results <- with(portfolio, {
  ret_E <- rf + risk_premium
  ret_P <- w_E * ret_E + w_F * rf
  sd_P <- w_E * sd_equity
  list(Expected_Return = ret_P * 100, SD = sd_P * 100)
})

cat("Expected Return:", results$Expected_Return, "%\n")
## Expected Return: 12 %
cat("Standard Deviation:", results$SD, "%\n")
## Standard Deviation: 8.4 %

Chapter 7 Problem set 11

library(ggplot2)

# Inputs
inputs <- list(mu_stock = 0.18, sd_stock = 0.22, mu_gold = 0.10, sd_gold = 0.30, rho = -0.2)

# Covariance
cov <- with(inputs, rho * sd_stock * sd_gold)

# Weights
w <- seq(0, 1, by = 0.01)

# Portfolio metrics
mu_p <- w * inputs$mu_stock + (1 - w) * inputs$mu_gold
sd_p <- sqrt(w^2 * inputs$sd_stock^2 + (1 - w)^2 * inputs$sd_gold^2 + 2 * w * (1 - w) * cov)

# Plot 1
df1 <- data.frame(Return = mu_p, Risk = sd_p)
plot1 <- ggplot(df1, aes(x = Risk, y = Return)) +
  geom_line(color = "blue") +
  geom_point(aes(x = inputs$sd_stock, y = inputs$mu_stock), color = "red", size = 3) +
  geom_point(aes(x = inputs$sd_gold, y = inputs$mu_gold), color = "gold", size = 3) +
  labs(title = "Efficient Frontier", x = "Risk", y = "Return") + theme_minimal()

# Perfect correlation
cov_perfect <- with(inputs, 1 * sd_stock * sd_gold)
sd_perfect <- w * inputs$sd_stock + (1 - w) * inputs$sd_gold

df2 <- data.frame(Return = mu_p, Risk = sd_perfect)
plot2 <- ggplot(df2, aes(x = Risk, y = Return)) +
  geom_line(color = "red") +
  geom_point(aes(x = inputs$sd_stock, y = inputs$mu_stock), color = "blue", size = 3) +
  geom_point(aes(x = inputs$sd_gold, y = inputs$mu_gold), color = "gold", size = 3) +
  labs(title = "Perfect Correlation (ρ = 1)", x = "Risk", y = "Return") + theme_minimal()

print(plot1)
## Warning in geom_point(aes(x = inputs$sd_stock, y = inputs$mu_stock), color = "red", : All aesthetics have length 1, but the data has 101 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
## Warning in geom_point(aes(x = inputs$sd_gold, y = inputs$mu_gold), color = "gold", : All aesthetics have length 1, but the data has 101 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

print(plot2)
## Warning in geom_point(aes(x = inputs$sd_stock, y = inputs$mu_stock), color = "blue", : All aesthetics have length 1, but the data has 101 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.
## All aesthetics have length 1, but the data has 101 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

Chapter 7 Problem set 12

# Inputs
inputs <- list(mu_A = 0.10, sigma_A = 0.15, mu_B = 0.05, sigma_B = 0.10, rho = -1)

# Weights for zero risk
w_B <- inputs$sigma_A / (inputs$sigma_A + inputs$sigma_B)
w_A <- 1 - w_B
rf <- w_A * inputs$mu_A + w_B * inputs$mu_B

cat("The risk-free rate is:", round(rf * 100, 2), "%\n")
## The risk-free rate is: 7 %

Chapter 7 CFA Problem 1-3

library(ggplot2)

# Risk function
risk_fn <- function(n, mkt_risk = 0.20, unsys_risk = 0.30) {
  sqrt(mkt_risk^2 + unsys_risk^2 / n)
}

n_vals <- 5:50
risks <- sapply(n_vals, risk_fn)
df <- data.frame(Stocks = n_vals, Risk = risks)

# Plot
ggplot(df, aes(x = Stocks, y = Risk)) +
  geom_line(color = "blue") +
  geom_vline(xintercept = c(10, 20, 40), linetype = "dashed", color = c("purple", "green", "red")) +
  labs(title = "Portfolio Risk vs. Number of Stocks", x = "Stocks", y = "Risk") +
  theme_minimal()

Chapter 8 Problem set 17

# Inputs
data <- data.frame(
  Asset = c("A", "B", "C", "D"),
  Expected_Return = c(20, 18, 17, 12),
  Beta = c(1.3, 1.8, 0.7, 1.0),
  Residual_SD = c(58, 71, 60, 55)
)

rf <- 8
rm <- 16
sd_mkt <- 23

# Alpha and residual variance
data$Excess_Return <- data$Expected_Return - rf
data$Alpha <- data$Expected_Return - (rf + data$Beta * (rm - rf))
data$Res_Var <- (data$Residual_SD / 100)^2

# Weights
data$Weight <- data$Alpha / data$Res_Var
data$Weight <- data$Weight / sum(data$Weight)

theta <- sum(data$Weight^2 * data$Res_Var)
alpha_P <- sum(data$Weight * data$Alpha)
sharpe_opt <- alpha_P / sqrt(theta)
sharpe_mkt <- (rm - rf) / sd_mkt
sharpe_gain <- sqrt(sharpe_mkt^2 + sharpe_opt^2) - sharpe_mkt
A <- 2.8
y_opt <- sharpe_opt / (A * sd_mkt^2)

cat("Tracking Error Variance:", round(theta, 4), "\n")
## Tracking Error Variance: 2.1809
cat("Sharpe (Optimal):", round(sharpe_opt, 4), "\n")
## Sharpe (Optimal): -11.4463
cat("Sharpe Improvement:", round(sharpe_gain, 4), "\n")
## Sharpe Improvement: 11.1038
cat("Proportion in Optimal Risky Portfolio:", round(y_opt, 4), "\n")
## Proportion in Optimal Risky Portfolio: -0.0077
cat("Proportion in Risk-Free Asset:", round(1 - y_opt, 4), "\n")
## Proportion in Risk-Free Asset: 1.0077

Chapter 8 CFA Problem 1

# Inputs
stocks <- list(
  ABC = list(alpha = -0.032, beta = 0.60, r2 = 0.35, res_sd = 0.1302, beta_a = 0.62, beta_b = 0.71),
  XYZ = list(alpha = 0.073, beta = 0.97, r2 = 0.17, res_sd = 0.2145, beta_a = 1.45, beta_b = 1.25)
)

interpret <- function(name, info) {
  cat("\nStock:", name, "\n")
  cat("Alpha:", info$alpha * 100, "%\n")
  cat("Beta:", info$beta, "\n")
  cat("R-squared:", info$r2, "\n")
  cat("Residual SD:", info$res_sd * 100, "%\n")
  cat(ifelse(info$alpha > 0, "Positive excess returns.\n", "Underperformed market.\n"))
  cat(ifelse(info$r2 < 0.3, "Low market explanation.\n", "Moderate market explanation.\n"))
  cat(ifelse(info$beta > 1, "Volatile.\n", "Defensive.\n"))
}

interpret("ABC", stocks$ABC)
## 
## Stock: ABC 
## Alpha: -3.2 %
## Beta: 0.6 
## R-squared: 0.35 
## Residual SD: 13.02 %
## Underperformed market.
## Moderate market explanation.
## Defensive.
interpret("XYZ", stocks$XYZ)
## 
## Stock: XYZ 
## Alpha: 7.3 %
## Beta: 0.97 
## R-squared: 0.17 
## Residual SD: 21.45 %
## Positive excess returns.
## Low market explanation.
## Defensive.
# Average betas
abc_beta_avg <- mean(c(stocks$ABC$beta_a, stocks$ABC$beta_b))
xyz_beta_avg <- mean(c(stocks$XYZ$beta_a, stocks$XYZ$beta_b))

cat("\nImplication: ")
## 
## Implication:
if (abc_beta_avg < 1 & xyz_beta_avg > 1) {
  cat("ABC stabilizes, XYZ adds upside.\n")
} else {
  cat("Similar risk profiles.\n")
}
## ABC stabilizes, XYZ adds upside.

Part 2. 

library(tidyquant)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
## ── Attaching core tidyquant packages ─────────────────────── tidyquant 1.0.11 ──
## ✔ PerformanceAnalytics 2.0.8      ✔ TTR                  0.24.4
## ✔ quantmod             0.4.27     ✔ xts                  0.14.1
## ── Conflicts ────────────────────────────────────────── tidyquant_conflicts() ──
## ✖ zoo::as.Date()                 masks base::as.Date()
## ✖ zoo::as.Date.numeric()         masks base::as.Date.numeric()
## ✖ PerformanceAnalytics::legend() masks graphics::legend()
## ✖ quantmod::summary()            masks base::summary()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(timetk)
## 
## Attaching package: 'timetk'
## 
## The following object is masked from 'package:tidyquant':
## 
##     FANG
library(PerformanceAnalytics)
library(dplyr)
## 
## ######################### Warning from 'xts' package ##########################
## #                                                                             #
## # The dplyr lag() function breaks how base R's lag() function is supposed to  #
## # work, which breaks lag(my_xts). Calls to lag(my_xts) that you type or       #
## # source() into this session won't work correctly.                            #
## #                                                                             #
## # 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.                                #
## #                                                                             #
## # Code in packages is not affected. It's protected by R's namespace mechanism #
## # Set `options(xts.warn_dplyr_breaks_lag = FALSE)` to suppress this warning.  #
## #                                                                             #
## ###############################################################################
## 
## Attaching package: 'dplyr'
## 
## The following objects are masked from 'package:xts':
## 
##     first, last
## 
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(ggplot2)
library(purrr)

# 1. Get ETF prices & returns
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
prices <- tq_get(tickers, from = "2010-01-01") %>%
  select(symbol, date, adjusted) %>%
  pivot_wider(names_from = symbol, values_from = adjusted) %>%
  arrange(date)

returns_xts <- prices %>%
  tk_xts(silent = TRUE) %>%
  ROC(type = "discrete") %>%
  na.omit()

monthly_returns <- returns_xts[endpoints(returns_xts, on = "months"), ] %>%
  tk_tbl(preserve_index = TRUE, rename_index = "date")

# 2. Simulated Fama-French data
set.seed(123)
ff_factors <- tibble(
  date = seq(as.Date("2010-01-31"), as.Date("2024-03-31"), by = "month"),
  Mkt.RF = rnorm(171, 0.008, 0.045),
  SMB = rnorm(171, 0.002, 0.02),
  HML = rnorm(171, 0.001, 0.025),
  RF = rep(0.0003, 171)
)

# 3. Merge returns & factors
merged <- left_join(monthly_returns, ff_factors, by = "date") %>%
  drop_na()

tickers <- colnames(returns_xts)

# Excess returns
excess_returns <- merged %>%
  mutate(across(all_of(tickers), ~ .x - RF, .names = "{.col}_excess"))

# 4. CAPM MVP
capm_data <- excess_returns %>% filter(date >= "2019-03-01", date <= "2024-02-29")

capm_models <- map(tickers, ~lm(reformulate("Mkt.RF", response = paste0(.x, "_excess")), data = capm_data))
betas <- map_dbl(capm_models, ~coef(.x)[2])
res_vars <- map_dbl(capm_models, ~var(resid(.x)))
mkt_var <- var(capm_data$Mkt.RF)

capm_cov <- outer(betas, betas, "*") * mkt_var
diag(capm_cov) <- diag(capm_cov) + res_vars
dimnames(capm_cov) <- list(tickers, tickers)

# 5. FF3 MVP
ff3_models <- map(tickers, ~lm(reformulate(c("Mkt.RF", "SMB", "HML"), response = paste0(.x, "_excess")), data = capm_data))
ff3_betas <- map(ff3_models, ~coef(.x)[-1])
res_ff3 <- map_dbl(ff3_models, ~var(resid(.x)))
factor_cov <- cov(select(capm_data, Mkt.RF, SMB, HML))

ff3_cov <- matrix(0, nrow = length(tickers), ncol = length(tickers))
for (i in 1:length(tickers)) {
  for (j in 1:length(tickers)) {
    beta_i <- ff3_betas[[i]]
    beta_j <- ff3_betas[[j]]
    cov_ij <- t(beta_i) %*% factor_cov %*% beta_j
    ff3_cov[i, j] <- ifelse(i == j, cov_ij + res_ff3[i], cov_ij)
  }
}
dimnames(ff3_cov) <- list(tickers, tickers)

# 6. MVP weight function
mvp_weights <- function(cov_matrix) {
  inv <- solve(cov_matrix)
  w <- inv %*% rep(1, ncol(cov_matrix))
  w / sum(w)
}

capm_wts <- mvp_weights(capm_cov)
ff3_wts <- mvp_weights(ff3_cov)
names(capm_wts) <- names(ff3_wts) <- tickers

# 7. March 2024 return
latest_ret <- monthly_returns %>%
  filter(date >= "2024-03-01") %>%
  slice(1)

latest_vec <- as.numeric(latest_ret[1, tickers])
names(latest_vec) <- tickers

capm_return <- sum(capm_wts * latest_vec)
ff3_return <- sum(ff3_wts * latest_vec)

# 8. Results
cat("CAPM Return:", round(capm_return, 4), "\n")
## CAPM Return: 0.002
cat("FF3 Return:", round(ff3_return, 4), "\n")
## FF3 Return: 0.0022
# Comparison tables
weights_df <- tibble(Asset = tickers, CAPM = capm_wts, FF3 = ff3_wts)
returns_df <- tibble(Model = c("CAPM", "FF3"), Return = c(capm_return, ff3_return))

print(weights_df)
## # A tibble: 8 × 3
##   Asset CAPM[,1] FF3[,1]
##   <chr>    <dbl>   <dbl>
## 1 SPY     0.142   0.135 
## 2 QQQ     0.0868  0.0773
## 3 EEM     0.0842  0.0677
## 4 IWM     0.0645  0.0504
## 5 EFA     0.212   0.201 
## 6 TLT     0.184   0.224 
## 7 IYR     0.101   0.104 
## 8 GLD     0.125   0.141
print(returns_df)
## # A tibble: 2 × 2
##   Model  Return
##   <chr>   <dbl>
## 1 CAPM  0.00203
## 2 FF3   0.00216
# 9. Plot Weights
weights_df_long <- pivot_longer(weights_df, -Asset, names_to = "Model", values_to = "Weight")

ggplot(weights_df_long, aes(x = Asset, y = Weight, fill = Model)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "MVP Weights: CAPM vs FF3") +
  theme_minimal()

# 10. Plot Portfolio Performance
monthly_returns_only <- monthly_returns %>% select(date, all_of(tickers))
port_returns <- monthly_returns_only %>%
  mutate(
    CAPM_Port = as.numeric(as.matrix(select(., tickers)) %*% capm_wts),
    FF3_Port = as.numeric(as.matrix(select(., tickers)) %*% ff3_wts),
    CAPM_Cum = cumprod(1 + CAPM_Port),
    FF3_Cum = cumprod(1 + FF3_Port)
  )
## Warning: There was 1 warning in `mutate()`.
## ℹ In argument: `CAPM_Port = as.numeric(as.matrix(select(., tickers)) %*%
##   capm_wts)`.
## Caused by warning:
## ! Using an external vector in selections was deprecated in tidyselect 1.1.0.
## ℹ Please use `all_of()` or `any_of()` instead.
##   # Was:
##   data %>% select(tickers)
## 
##   # Now:
##   data %>% select(all_of(tickers))
## 
## See <https://tidyselect.r-lib.org/reference/faq-external-vector.html>.
ggplot(port_returns, aes(x = date)) +
  geom_line(aes(y = CAPM_Cum, color = "CAPM")) +
  geom_line(aes(y = FF3_Cum, color = "FF3")) +
  labs(title = "Cumulative Portfolio Returns") +
  theme_minimal()