Midterm Exam
114035129_Mochammad Raffy Anugerah
2026-04-16
I. Computer questions
library(quantmod)## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: TTR## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(PerformanceAnalytics)##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legend# --- QUESTION 1: Download ETF Data ---
tickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
getSymbols(tickers, from = "2010-01-01", to = "2025-05-01", src = "yahoo")## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"# Merge adjusted prices only
prices <- do.call(merge, lapply(tickers, function(x) Ad(get(x))))
colnames(prices) <- tickers# --- QUESTION 2: Calculate Monthly Discrete Returns ---
# suppressWarnings hides the "missing values removed" message from to.period
returns_monthly <- suppressWarnings(to.period(Return.calculate(prices, method = "discrete"),
period = "months", OHLC = FALSE))
returns_monthly <- na.omit(returns_monthly)# --- QUESTION 3: Fama French 3 Factors ---
ff_raw <- read.csv("F-F_Research_Data_Factors.CSV", skip = 3)
end_row <- which(nchar(as.character(ff_raw[, 1])) != 6)[1] - 1
ff_factors <- ff_raw[1:end_row, ]
colnames(ff_factors) <- c("Date", "Mkt.RF", "SMB", "HML", "RF")
ff_factors$Mkt.RF <- as.numeric(as.character(ff_factors$Mkt.RF)) / 100
ff_factors$SMB <- as.numeric(as.character(ff_factors$SMB)) / 100
ff_factors$HML <- as.numeric(as.character(ff_factors$HML)) / 100
ff_factors$RF <- as.numeric(as.character(ff_factors$RF)) / 100# --- QUESTION 4: Merge Returns and Factors ---
index(returns_monthly) <- as.yearmon(index(returns_monthly))
ff_factors$Date <- as.yearmon(as.character(ff_factors$Date), format="%Y%m")
ff_xts <- xts(ff_factors[,-1], order.by=ff_factors$Date)
merged_data <- merge(returns_monthly, ff_xts, join = "inner")# --- QUESTION 5: CAPM-based MVP (March 2025 Prediction) ---
# Window: 2020/03 - 2025/02
window_5 <- merged_data["2020-03/2025-02"][, 1:8]
cov_mat_5 <- cov(window_5)
inv_cov_5 <- solve(cov_mat_5)
ones <- rep(1, 8)
w_capm <- (inv_cov_5 %*% ones) / as.numeric(t(ones) %*% inv_cov_5 %*% ones)# --- QUESTION 6: FF 3-Factor Model MVP ---
window_6_ret <- merged_data["2020-03/2025-02"][, 1:8]
window_6_factors <- merged_data["2020-03/2025-02"][, 9:11] # Mkt-RF, SMB, HML
cov_factors <- cov(window_6_factors)
# Calculate Betas via linear regression for each ETF
betas <- matrix(NA, nrow=8, ncol=3)
for(i in 1:8) {
model <- lm(window_6_ret[,i] ~ window_6_factors)
betas[i,] <- coef(model)[2:4]
}
# Factor Implied Covariance: B * Cov(F) * B' + Residual Variance (simplified)
cov_ff3 <- betas %*% cov_factors %*% t(betas) + diag(diag(cov(window_6_ret - window_6_factors %*% t(betas))))
inv_cov_ff3 <- solve(cov_ff3)
w_ff3 <- (inv_cov_ff3 %*% ones) / as.numeric(t(ones) %*% inv_cov_ff3 %*% ones)# --- QUESTION 7: Realized Returns (March 2025) ---
ret_mar <- as.numeric(merged_data["2025-03"][, 1:8])
realized_mar_capm <- sum(w_capm * ret_mar)
realized_mar_ff3 <- sum(w_ff3 * ret_mar)# --- QUESTION 8: Realized Return (April 2025) ---
# Shift Window: 2020/04 - 2025/03
window_8 <- merged_data["2020-04/2025-03"][, 1:8]
cov_8 <- cov(window_8)
w_apr <- (solve(cov_8) %*% ones) / as.numeric(t(ones) %*% solve(cov_8) %*% ones)
ret_apr <- as.numeric(merged_data["2025-04"][, 1:8])
realized_apr <- sum(w_apr * ret_apr)
# Print Final Results
print(paste("Q7 CAPM Realized Mar:", round(realized_mar_capm, 4)))## [1] "Q7 CAPM Realized Mar: 0.0112"print(paste("Q7 FF3 Realized Mar:", round(realized_mar_ff3, 4)))## [1] "Q7 FF3 Realized Mar: 0.0036"print(paste("Q8 Realized Apr:", round(realized_apr, 4)))## [1] "Q8 Realized Apr: -0.0029"II. Complete the questions below from the textbook
Chapter 5 : Problem set 12
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, unionlibrary(moments)##
## Attaching package: 'moments'## The following objects are masked from 'package:PerformanceAnalytics':
##
## kurtosis, skewnessraw_data <- read.csv("6_Portfolios_2x3 2.csv", skip = 15, header = TRUE)
colnames(raw_data)[1] <- "Date"data_filtered <- raw_data %>%
mutate(Date = suppressWarnings(as.numeric(as.character(Date)))) %>%
dplyr::filter(!is.na(Date)) %>%
dplyr::filter(Date >= 193001 & Date <= 201812) %>%
mutate(across(-Date, ~suppressWarnings(as.numeric(as.character(.))))) %>%
mutate(across(-Date, ~ifelse(. <= -99, NA, .))) %>%
na.omit()half_point <- nrow(data_filtered) / 2
first_half <- data_filtered[1:half_point, ]
second_half <- data_filtered[(half_point + 1):nrow(data_filtered), ]get_stats <- function(df, period_name) {
cat("\n---", period_name, "---")
cat("\nDates:", min(df$Date), "to", max(df$Date), "\n")
df %>%
summarise(across(2:7, list(
Mean = ~mean(., na.rm = TRUE),
SD = ~sd(., na.rm = TRUE),
Skew = ~moments::skewness(., na.rm = TRUE),
Kurt = ~moments::kurtosis(., na.rm = TRUE) - 3
))) %>%
t() %>%
round(4) %>%
print()
}get_stats(first_half, "First Half Statistics")##
## --- First Half Statistics ---
## Dates: 193001 to 201812
## [,1]
## SMALL.LoBM_Mean 168.9127
## SMALL.LoBM_SD 386.3932
## SMALL.LoBM_Skew 2.4928
## SMALL.LoBM_Kurt 5.1160
## ME1.BM2_Mean 185.2396
## ME1.BM2_SD 378.5362
## ME1.BM2_Skew 2.1073
## ME1.BM2_Kurt 3.0899
## SMALL.HiBM_Mean 213.2044
## SMALL.HiBM_SD 455.8515
## SMALL.HiBM_Skew 2.3740
## SMALL.HiBM_Kurt 4.8312
## BIG.LoBM_Mean 193.2564
## BIG.LoBM_SD 327.7421
## BIG.LoBM_Skew 2.4341
## BIG.LoBM_Kurt 6.2749
## ME2.BM2_Mean 149.7639
## ME2.BM2_SD 253.7822
## ME2.BM2_Skew 2.9231
## ME2.BM2_Kurt 11.1226
## BIG.HiBM_Mean 95.8329
## BIG.HiBM_SD 235.1379
## BIG.HiBM_Skew 5.2952
## BIG.HiBM_Kurt 34.6979get_stats(second_half, "Second Half Statistics")##
## --- Second Half Statistics ---
## Dates: 193001 to 201812
## [,1]
## SMALL.LoBM_Mean 38.8416
## SMALL.LoBM_SD 142.3184
## SMALL.LoBM_Skew 4.3729
## SMALL.LoBM_Kurt 19.8237
## ME1.BM2_Mean 37.9919
## ME1.BM2_SD 136.5532
## ME1.BM2_Skew 4.2713
## ME1.BM2_Kurt 18.5158
## SMALL.HiBM_Mean 22.6995
## SMALL.HiBM_SD 78.1955
## SMALL.HiBM_Skew 4.4623
## SMALL.HiBM_Kurt 20.7303
## BIG.LoBM_Mean 1414.4932
## BIG.LoBM_SD 4952.0677
## BIG.LoBM_Skew 3.9410
## BIG.LoBM_Kurt 16.0677
## ME2.BM2_Mean 1000.1574
## ME2.BM2_SD 3634.3422
## ME2.BM2_Skew 4.3112
## ME2.BM2_Kurt 19.0722
## BIG.HiBM_Mean 892.4264
## BIG.HiBM_SD 3428.9861
## BIG.HiBM_Skew 4.7594
## BIG.HiBM_Kurt 23.8721Chapter 6 :Problem set 21 and 22
expected_return_p <- 0.11
sd_p <- 0.15
risk_free <- 0.05
target_return <- 0.08y <- (target_return - risk_free) / (expected_return_p - risk_free)
proportion_rf <- 1 - y
portfolio_sd <- y * sd_pcat("Proportion in Risky Portfolio:", y, "\n")## Proportion in Risky Portfolio: 0.5cat("Proportion in Risk-free Asset:", proportion_rf, "\n")## Proportion in Risk-free Asset: 0.5cat("Standard Deviation of Portfolio:", portfolio_sd, "\n")## Standard Deviation of Portfolio: 0.075r_f <- 0.05 # Risk-free rate
e_rm <- 0.12 # Expected Market Return
sd_m <- 0.20 # Market Volatility
sd_p_target <- 0.5 * sd_m # Johnson's target risk (half of market)e_rp <- r_f + ((e_rm - r_f) / sd_m) * sd_p_targetcat("Johnson's Portfolio Risk (SD):", sd_p_target * 100, "%\n")## Johnson's Portfolio Risk (SD): 10 %cat("Johnson's Expected Return:", e_rp * 100, "%\n")## Johnson's Expected Return: 8.5 %if(!is.null(dev.list())) dev.off()## null device
## 1par(mar = c(4, 4, 2, 1))plot(c(0, sd_m), c(r_f, e_rm), type = "l", lwd = 2, col = "blue",
xlab = "Standard Deviation (Risk)", ylab = "Expected Return",
main = "Capital Market Line (CML)")
points(sd_p_target, e_rp, col = "red", pch = 19, cex = 1.5)
text(sd_p_target, e_rp, labels = " Johnson's Portfolio", pos = 4)
points(sd_m, e_rm, col = "darkgreen", pch = 19, cex = 1.5)
text(sd_m, e_rm, labels = " Market Portfolio", pos = 2)
# CFA Problem. 4 and 5
# The y-intercept is the Risk-Free Rate (Rf)
rf <- 0.05
# Point P (The Risky Portfolio)
# Based on the graph: y = 11%, x = 15%
er_p <- 0.11
sd_p <- 0.15
# 2. Calculate the Reward-to-Volatility Ratio (Sharpe Ratio)
# This is the slope of the Capital Allocation Line (CAL)
sharpe_ratio <- (er_p - rf) / sd_pcat("--- Question 4 ---")## --- Question 4 ---cat("\nExpected Return of Risky Portfolio (P):", er_p * 100, "%")##
## Expected Return of Risky Portfolio (P): 11 %cat("\nStandard Deviation of Risky Portfolio (P):", sd_p * 100, "%\n")##
## Standard Deviation of Risky Portfolio (P): 15 %cat("\n--- Question 5 ---")##
## --- Question 5 ---cat("\nReward-to-Volatility Ratio (Sharpe Ratio):", round(sharpe_ratio, 2))##
## Reward-to-Volatility Ratio (Sharpe Ratio): 0.4if(!is.null(dev.list())) dev.off() # Reset plot device## null device
## 1par(mar = c(5, 5, 4, 2))
# Plot the CAL
plot(c(0, 0.30), c(rf, rf + 0.30 * sharpe_ratio), type = "l", lwd = 2, col = "blue",
xlab = "Standard Deviation (Risk)", ylab = "Expected Return",
main = "Capital Allocation Line (CAL)", xlim = c(0, 0.25), ylim = c(0, 0.15))
# Add the points for Rf and Portfolio P
points(0, rf, col = "black", pch = 19, cex = 1.2)
text(0, rf, " Rf (5%)", pos = 4)
points(sd_p, er_p, col = "red", pch = 19, cex = 1.2)
text(sd_p, er_p, " P (15%, 11%)", pos = 3)
# Draw lines to axes for P
segments(sd_p, 0, sd_p, er_p, lty = 2, col = "gray")
segments(0, er_p, sd_p, er_p, lty = 2, col = "gray")CFA Problem. 8
expected_risk_premium <- 0.10 # E(rp) - rf
sd_risky <- 0.14 # Sigma_p
risk_free <- 0.06 # rf
investment_equity <- 60000 # Dollars in risky fund
investment_tbill <- 40000 # Dollars in T-billsrm(list = ls())
# Equity Fund (Risky)
inv_equity <- 60000
risk_premium <- 0.10
sd_risky <- 0.14
# T-Bills (Risk-Free)
inv_tbill <- 40000
rf <- 0.06total_val <- inv_equity + inv_tbill
y_weight <- inv_equity / total_val
# Expected Return: E(rc) = rf + y * (Risk Premium)
port_return <- rf + (y_weight * risk_premium)
# Standard Deviation: Sigma_c = y * Sigma_p
port_sd <- y_weight * sd_riskyresults <- data.frame(
Metric = c("Total Investment", "Equity Weight (y)", "Expected Return", "Standard Deviation"),
Value = c(total_val, y_weight, port_return, port_sd)
)
print(results)## Metric Value
## 1 Total Investment 1.0e+05
## 2 Equity Weight (y) 6.0e-01
## 3 Expected Return 1.2e-01
## 4 Standard Deviation 8.4e-02cat("\nExpected Return:", port_return * 100, "%")##
## Expected Return: 12 %cat("\nStandard Deviation:", port_sd * 100, "%")##
## Standard Deviation: 8.4 %Chapter 7 :Problem set 11 and 12
library(ggplot2)r_s <- 0.18; sd_s <- 0.22 # Stocks
r_g <- 0.10; sd_g <- 0.30 # Gold
# Logic for calculating points on the line
calc_port <- function(w_s, rho) {
w_g <- 1 - w_s
r_p <- w_s * r_s + w_g * r_g
sd_p <- sqrt((w_s^2 * sd_s^2) + (w_g^2 * sd_g^2) + (2 * w_s * w_g * sd_s * sd_g * rho))
return(data.frame(SD = sd_p, Return = r_p))
}
# Generate data for Rho = 0.1 and Rho = 1.0
weights <- seq(0, 1, length.out = 100)
curve_a <- do.call(rbind, lapply(weights, calc_port, rho = 0.1))
curve_b <- do.call(rbind, lapply(weights, calc_port, rho = 1.0))
# --- GRAPHING ---
ggplot() +
geom_path(data = curve_a, aes(x = SD, y = Return, color = "Rho = 0.1"), size = 1) +
geom_path(data = curve_b, aes(x = SD, y = Return, color = "Rho = 1.0"), size = 1) +
geom_point(aes(x = c(sd_s, sd_g), y = c(r_s, r_g)), size = 3) +
annotate("text", x = sd_s, y = r_s, label = " Stocks", hjust = -0.1) +
annotate("text", x = sd_g, y = r_g, label = " Gold", hjust = -0.1) +
labs(title = "Why Investors Hold Gold", x = "Risk (SD)", y = "Return") +
theme_minimal()## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
er_a <- 0.10 # Expected Return A
sd_a <- 0.10 # SD of A
er_b <- 0.15 # Expected Return B
sd_b <- 0.15 # SD of B# 1. Calculate the weight of A for a zero-risk portfolio
w_a <- sd_b / (sd_a + sd_b)
w_b <- 1 - w_a
# 2. Calculate the Expected Return of this zero-risk portfolio
# In equilibrium, this MUST equal the risk-free rate (rf)
rf <- (w_a * er_a) + (w_b * er_b)cat("Weight in Stock A:", w_a, "\n")## Weight in Stock A: 0.6cat("Weight in Stock B:", w_b, "\n")## Weight in Stock B: 0.4cat("The Risk-Free Rate (rf) must be:", rf * 100, "%\n")## The Risk-Free Rate (rf) must be: 12 %CFA Problem. 12
# --- 1. SETUP DATA ---
# Total Portfolio = $900k + $100k = $1,000,000
w_p <- 900000 / 1000000 # Weight of original portfolio (0.9)
w_a <- 100000 / 1000000 # Weight of ABC stock (0.1)
ret_p <- 0.0067 # Original portfolio return: 0.67%
sd_p <- 0.0237 # Original portfolio SD: 2.37%
ret_a <- 0.0125 # ABC stock return: 1.25%
sd_a <- 0.0295 # ABC stock SD: 2.95%
corr <- 0.40 # Correlation between them
rf <- 0.0042 # Risk-free rate: 0.42%# --- 2. CALCULATIONS FOR PART A (Keeping ABC) ---
# i. Expected Return: E(rp) = w1r1 + w2r2
er_new <- (w_p * ret_p) + (w_a * ret_a)
# ii. Covariance: Cov = Corr * SD1 * SD2
cov_pa <- corr * sd_p * sd_a
# iii. Portfolio SD: Sqrt of Variance formula
port_var <- (w_p^2 * sd_p^2) + (w_a^2 * sd_a^2) + (2 * w_p * w_a * cov_pa)
port_sd <- sqrt(port_var)# --- 3. CALCULATIONS FOR PART B (Selling ABC for T-Bills) ---
# i. Expected Return
er_rf <- (w_p * ret_p) + (w_a * rf)
# ii. Covariance (Risk-free assets have 0 covariance with risky assets)
cov_rf <- 0
# iii. Portfolio SD (Simplified because SD of risk-free is 0)
port_sd_rf <- w_p * sd_p# --- 4. Output Results ---
cat("--- Part A Results ---\n")## --- Part A Results ---cat("Expected Return:", round(er_new * 100, 4), "%\n")## Expected Return: 0.728 %cat("Covariance:", round(cov_pa, 6), "\n")## Covariance: 0.00028cat("Portfolio SD:", round(port_sd * 100, 4), "%\n\n")## Portfolio SD: 2.2672 %cat("--- Part B Results ---\n")## --- Part B Results ---cat("Expected Return:", round(er_rf * 100, 4), "%\n")## Expected Return: 0.645 %cat("Covariance:", cov_rf, "\n")## Covariance: 0cat("Portfolio SD:", round(port_sd_rf * 100, 4), "%\n")## Portfolio SD: 2.133 %Chapter 8 :Problem set 17
rf <- 0.08 # T-bill return
rm <- 0.16 # Passive market return
sigma_m <- 0.23 # Market SD
stocks <- data.frame(
Asset = c("A","B","C","D"),
ER = c(0.20,0.18,0.17,0.12),
Beta = c(1.3,1.8,0.7,1.0),
Resid_SD = c(0.58,0.71,0.60,0.55)
)#-----------------------------
# (a) Expected Excess Return,
# Alpha, Residual Variance
#-----------------------------
stocks$Excess_Return <- stocks$ER - rf
stocks$Alpha <- stocks$ER - (rf + stocks$Beta*(rm-rf))
stocks$Residual_Var <- stocks$Resid_SD^2
stocks## Asset ER Beta Resid_SD Excess_Return Alpha Residual_Var
## 1 A 0.20 1.3 0.58 0.12 0.016 0.3364
## 2 B 0.18 1.8 0.71 0.10 -0.044 0.5041
## 3 C 0.17 0.7 0.60 0.09 0.034 0.3600
## 4 D 0.12 1.0 0.55 0.04 -0.040 0.3025#-----------------------------
# (b) Construct Optimal Risky Portfolio
#-----------------------------
# Treynor-Black Active Weights
stocks$Z <- stocks$Alpha / stocks$Residual_Var
sum_z <- sum(stocks$Z)
stocks$w_active <- stocks$Z / sum_z
stocks[,c("Asset","w_active")]## Asset w_active
## 1 A -0.613639
## 2 B 1.126121
## 3 C -1.218500
## 4 D 1.706018# Active Portfolio Alpha, Beta, Variance
alpha_A <- sum(stocks$w_active * stocks$Alpha)
beta_A <- sum(stocks$w_active * stocks$Beta)
var_eA <- sum((stocks$w_active^2) * stocks$Residual_Var)
alpha_A## [1] -0.1690372beta_A## [1] 2.082355var_eA## [1] 2.180878# Weight of Active Portfolio relative to Passive Portfolio
w0 <- (alpha_A / var_eA) / ((rm-rf)/(sigma_m^2))
# Beta adjustment
wA <- w0 / (1 + (1-beta_A)*w0)
wA## [1] -0.04855896#-----------------------------
# (c) Sharpe Ratio of Optimal Portfolio
#-----------------------------
beta_p <- 1 + wA*(beta_A - 1)
alpha_p <- wA * alpha_A
ER_p <- rf + beta_p*(rm-rf) + alpha_p
var_p <- (beta_p^2)*(sigma_m^2) + (wA^2)*var_eA
sd_p <- sqrt(var_p)
Sharpe <- (ER_p - rf)/sd_p
Sharpe## [1] 0.366176#-----------------------------
# (d) Improvement in Sharpe Ratio
#-----------------------------
Sharpe_passive <- (rm-rf)/sigma_m
Improvement <- Sharpe - Sharpe_passive
Sharpe_passive## [1] 0.3478261Improvement## [1] 0.01834991#-----------------------------
# (e) Complete Portfolio
# Risk Aversion = 2.8
#-----------------------------
A <- 2.8
y <- (ER_p - rf)/(A * var_p)
# y = fraction invested in risky portfolio
# (1-y) = invested in T-bills
y## [1] 0.57006411-y## [1] 0.4299359CFA Problem. 1
stats <- data.frame(
Statistic = c("Alpha", "Beta", "R_squared", "Residual_SD"),
ABC = c(-0.0320, 0.60, 0.35, 0.1302),
XYZ = c(0.073, 0.97, 0.17, 0.2145)
)
print(stats)## Statistic ABC XYZ
## 1 Alpha -0.0320 0.0730
## 2 Beta 0.6000 0.9700
## 3 R_squared 0.3500 0.1700
## 4 Residual_SD 0.1302 0.2145brokerage_betas <- data.frame(
House = c("A", "B"),
Beta_ABC = c(0.62, 0.71),
Beta_XYZ = c(1.45, 1.25)
)
print(brokerage_betas)## House Beta_ABC Beta_XYZ
## 1 A 0.62 1.45
## 2 B 0.71 1.25