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(xts)
library(zoo)
library(PerformanceAnalytics)##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legendlibrary(quadprog)
library(frenchdata)
library(moments)##
## Attaching package: 'moments'## The following objects are masked from 'package:PerformanceAnalytics':
##
## kurtosis, skewnesstickers <- c("SPY", "QQQ", "EEM", "IWM", "EFA", "TLT", "IYR", "GLD")
getSymbols(tickers, src = "yahoo", from = "2010-01-01", to = "2025-12-31", auto.assign = TRUE)## [1] "SPY" "QQQ" "EEM" "IWM" "EFA" "TLT" "IYR" "GLD"prices_list <- lapply(tickers, function(t) Ad(get(t)))
prices <- do.call(merge, prices_list)
colnames(prices) <- tickers
cat("Dimensions:", dim(prices), "\n")## Dimensions: 4023 8cat("Period:", as.character(start(prices)), "to", as.character(end(prices)), "\n")## Period: 2010-01-04 to 2025-12-30head(prices)## SPY QQQ EEM IWM EFA TLT IYR
## 2010-01-04 84.79638 40.29079 30.35151 51.36656 35.12844 56.13520 26.76810
## 2010-01-05 85.02082 40.29079 30.57180 51.18994 35.15940 56.49770 26.83238
## 2010-01-06 85.08070 40.04774 30.63577 51.14176 35.30801 55.74136 26.82070
## 2010-01-07 85.43983 40.07380 30.45811 51.51912 35.17179 55.83513 27.06028
## 2010-01-08 85.72419 40.40363 30.69971 51.80010 35.45044 55.81017 26.87913
## 2010-01-11 85.84388 40.23871 30.63577 51.59136 35.74146 55.50391 27.00768
## GLD
## 2010-01-04 109.80
## 2010-01-05 109.70
## 2010-01-06 111.51
## 2010-01-07 110.82
## 2010-01-08 111.37
## 2010-01-11 112.85prices_monthly <- to.monthly(prices, indexAt = "lastof", OHLC = FALSE)
returns_monthly <- na.omit(Return.calculate(prices_monthly, method = "discrete"))
returns_df <- data.frame(Date = as.yearmon(index(returns_monthly)), coredata(returns_monthly))
colnames(returns_df) <- c("Date", tickers)
cat("Monthly returns dimensions:", dim(returns_df), "\n")## Monthly returns dimensions: 191 9head(returns_df)## Date SPY QQQ EEM IWM EFA
## 1 Feb 2010 0.03119441 0.04603815 0.017763704 0.04475113 0.002667974
## 2 Mar 2010 0.06087968 0.07710929 0.081109140 0.08230717 0.063854079
## 3 Apr 2010 0.01547042 0.02242500 -0.001662131 0.05678469 -0.028045775
## 4 May 2010 -0.07945481 -0.07392314 -0.093935569 -0.07536655 -0.111927890
## 5 Jun 2010 -0.05174111 -0.05975695 -0.013986708 -0.07743387 -0.020619413
## 6 Jul 2010 0.06830108 0.07258260 0.109324932 0.06730887 0.116104108
## TLT IYR GLD
## 1 -0.003423509 0.05457017 0.032748219
## 2 -0.020574199 0.09748516 -0.004386396
## 3 0.033218763 0.06388095 0.058834363
## 4 0.051083417 -0.05683559 0.030513147
## 5 0.057977663 -0.04670078 0.023553189
## 6 -0.009463169 0.09404763 -0.050871157ff3_raw <- download_french_data("Fama/French 3 Factors")## New names:
## New names:
## • `` -> `...1`ff3_monthly <- ff3_raw$subsets$data[[1]]
colnames(ff3_monthly)[colnames(ff3_monthly) == "date"] <- "Date"
colnames(ff3_monthly)[colnames(ff3_monthly) == "Mkt-RF"] <- "Mkt_RF"
ff3_monthly$Date <- as.yearmon(as.character(ff3_monthly$Date), "%Y%m")
ff3_monthly$Mkt_RF <- as.numeric(ff3_monthly$Mkt_RF) / 100
ff3_monthly$SMB <- as.numeric(ff3_monthly$SMB) / 100
ff3_monthly$HML <- as.numeric(ff3_monthly$HML) / 100
ff3_monthly$RF <- as.numeric(ff3_monthly$RF) / 100
ff3 <- ff3_monthly[ff3_monthly$Date >= as.yearmon("2010-01") &
ff3_monthly$Date <= as.yearmon("2025-04"), ]
cat("FF3 dimensions:", dim(ff3), "\n")## FF3 dimensions: 184 5head(ff3)## # A tibble: 6 × 5
## Date Mkt_RF SMB HML RF
## <yearmon> <dbl> <dbl> <dbl> <dbl>
## 1 Jan 2010 -0.0335 0.0043 0.0033 0
## 2 Feb 2010 0.0339 0.0118 0.0318 0
## 3 Mar 2010 0.063 0.0146 0.0219 0.0001
## 4 Apr 2010 0.0199 0.0484 0.0296 0.0001
## 5 May 2010 -0.079 0.0013 -0.0248 0.0001
## 6 Jun 2010 -0.0556 -0.0179 -0.0473 0.0001merged_df <- merge(returns_df, ff3, by = "Date")
cat("Merged dimensions:", dim(merged_df), "\n")## Merged dimensions: 183 13head(merged_df)## Date SPY QQQ EEM IWM EFA
## 1 Feb 2010 0.03119441 0.04603815 0.017763704 0.04475113 0.002667974
## 2 Mar 2010 0.06087968 0.07710929 0.081109140 0.08230717 0.063854079
## 3 Apr 2010 0.01547042 0.02242500 -0.001662131 0.05678469 -0.028045775
## 4 May 2010 -0.07945481 -0.07392314 -0.093935569 -0.07536655 -0.111927890
## 5 Jun 2010 -0.05174111 -0.05975695 -0.013986708 -0.07743387 -0.020619413
## 6 Jul 2010 0.06830108 0.07258260 0.109324932 0.06730887 0.116104108
## TLT IYR GLD Mkt_RF SMB HML RF
## 1 -0.003423509 0.05457017 0.032748219 0.0339 0.0118 0.0318 0e+00
## 2 -0.020574199 0.09748516 -0.004386396 0.0630 0.0146 0.0219 1e-04
## 3 0.033218763 0.06388095 0.058834363 0.0199 0.0484 0.0296 1e-04
## 4 0.051083417 -0.05683559 0.030513147 -0.0790 0.0013 -0.0248 1e-04
## 5 0.057977663 -0.04670078 0.023553189 -0.0556 -0.0179 -0.0473 1e-04
## 6 -0.009463169 0.09404763 -0.050871157 0.0692 0.0022 -0.0050 1e-04window_data <- merged_df[merged_df$Date >= as.yearmon("2020-03") &
merged_df$Date <= as.yearmon("2025-02"), ]
etf_returns <- as.matrix(window_data[, tickers])
rf_vec <- window_data$RF
mkt <- window_data$Mkt_RF
n <- length(tickers)
excess_ret <- etf_returns - rf_vec
resid_capm <- matrix(NA, nrow = nrow(window_data), ncol = n)
colnames(resid_capm) <- tickers
for (i in 1:n) {
fit <- lm(excess_ret[, i] ~ mkt)
resid_capm[, i] <- residuals(fit)
}
cov_capm <- cov(resid_capm)
Amat <- cbind(rep(1, n), diag(n))
bvec <- c(1, rep(0, n))
weights_capm <- solve.QP(2*cov_capm, rep(0,n), Amat, bvec, meq=1)$solution
names(weights_capm) <- tickers
cat("=== MVP Weights (CAPM) ===\n")## === MVP Weights (CAPM) ===print(round(weights_capm, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.7482 0.1017 0.0062 0.1412 0.0000 0.0000 0.0000 0.0028cat("Sum:", round(sum(weights_capm), 6), "\n")## Sum: 1var_capm <- t(weights_capm) %*% cov_capm %*% weights_capm
cat("Monthly Volatility (CAPM):", round(sqrt(var_capm)*100, 4), "%\n")## Monthly Volatility (CAPM): 0.2916 %smb <- window_data$SMB
hml <- window_data$HML
resid_ff3 <- matrix(NA, nrow = nrow(window_data), ncol = n)
colnames(resid_ff3) <- tickers
for (i in 1:n) {
fit <- lm(excess_ret[, i] ~ mkt + smb + hml)
resid_ff3[, i] <- residuals(fit)
}
cov_ff3 <- cov(resid_ff3)
weights_ff3 <- solve.QP(2*cov_ff3, rep(0,n), Amat, bvec, meq=1)$solution
names(weights_ff3) <- tickers
cat("=== MVP Weights (FF3) ===\n")## === MVP Weights (FF3) ===print(round(weights_ff3, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.6352 0.0830 0.0117 0.2701 0.0000 0.0000 0.0000 0.0000cat("Sum:", round(sum(weights_ff3), 6), "\n")## Sum: 1var_ff3 <- t(weights_ff3) %*% cov_ff3 %*% weights_ff3
cat("Monthly Volatility (FF3):", round(sqrt(var_ff3)*100, 4), "%\n")## Monthly Volatility (FF3): 0.2508 %mar_row <- merged_df[merged_df$Date == as.yearmon("2025-03"), ]
ret_mar2025 <- as.numeric(mar_row[, tickers])
names(ret_mar2025) <- tickers
cat("ETF Returns - March 2025:\n")## ETF Returns - March 2025:print(round(ret_mar2025, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## -0.0557 -0.0759 0.0113 -0.0685 0.0018 -0.0120 -0.0234 0.0945ret_capm_mar <- sum(weights_capm * ret_mar2025)
ret_ff3_mar <- sum(weights_ff3 * ret_mar2025)
cat("\nMVP Return CAPM (March 2025):", round(ret_capm_mar*100, 4), "%\n")##
## MVP Return CAPM (March 2025): -5.8742 %cat("MVP Return FF3 (March 2025):", round(ret_ff3_mar*100, 4), "%\n")## MVP Return FF3 (March 2025): -6.007 %window_apr <- merged_df[merged_df$Date >= as.yearmon("2020-04") &
merged_df$Date <= as.yearmon("2025-03"), ]
etf_ret_apr <- as.matrix(window_apr[, tickers])
rf_apr <- window_apr$RF
mkt_apr <- window_apr$Mkt_RF
smb_apr <- window_apr$SMB
hml_apr <- window_apr$HML
excess_apr <- etf_ret_apr - rf_apr
resid_capm_apr <- matrix(NA, nrow = nrow(window_apr), ncol = n)
for (i in 1:n) {
fit <- lm(excess_apr[, i] ~ mkt_apr)
resid_capm_apr[, i] <- residuals(fit)
}
cov_capm_apr <- cov(resid_capm_apr)
resid_ff3_apr <- matrix(NA, nrow = nrow(window_apr), ncol = n)
for (i in 1:n) {
fit <- lm(excess_apr[, i] ~ mkt_apr + smb_apr + hml_apr)
resid_ff3_apr[, i] <- residuals(fit)
}
cov_ff3_apr <- cov(resid_ff3_apr)
w_capm_apr <- solve.QP(2*cov_capm_apr, rep(0,n), Amat, bvec, meq=1)$solution
w_ff3_apr <- solve.QP(2*cov_ff3_apr, rep(0,n), Amat, bvec, meq=1)$solution
names(w_capm_apr) <- tickers
names(w_ff3_apr) <- tickers
cat("MVP Weights CAPM - April 2025:\n")## MVP Weights CAPM - April 2025:print(round(w_capm_apr, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.7497 0.1019 0.0060 0.1410 0.0000 0.0000 0.0000 0.0014cat("\nMVP Weights FF3 - April 2025:\n")##
## MVP Weights FF3 - April 2025:print(round(w_ff3_apr, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## 0.6436 0.0840 0.0088 0.2636 0.0000 0.0000 0.0000 0.0000apr_row <- merged_df[merged_df$Date == as.yearmon("2025-04"), ]
ret_apr2025 <- as.numeric(apr_row[, tickers])
names(ret_apr2025) <- tickers
cat("\nETF Returns - April 2025:\n")##
## ETF Returns - April 2025:print(round(ret_apr2025, 4))## SPY QQQ EEM IWM EFA TLT IYR GLD
## -0.0087 0.0140 0.0014 -0.0232 0.0370 -0.0136 -0.0215 0.0542ret_capm_apr <- sum(w_capm_apr * ret_apr2025)
ret_ff3_apr <- sum(w_ff3_apr * ret_apr2025)
cat("\nMVP Return CAPM (April 2025):", round(ret_capm_apr*100, 4), "%\n")##
## MVP Return CAPM (April 2025): -0.8266 %cat("MVP Return FF3 (April 2025):", round(ret_ff3_apr*100, 4), "%\n")## MVP Return FF3 (April 2025): -1.0512 %port6_raw <- download_french_data("6 Portfolios Formed on Size and Book-to-Market (2 x 3)")## New names:
## New names:
## New names:
## New names:
## • `` -> `...1`port6 <- port6_raw$subsets$data[[1]]
port6$date <- as.Date(paste0(as.character(port6$date), "01"), format = "%Y%m%d")
port6 <- port6[port6$date >= as.Date("1930-01-01") &
port6$date <= as.Date("2018-12-31"), ]
port_names <- names(port6)[-1]
port6[, port_names] <- port6[, port_names] / 100
n_half <- floor(nrow(port6) / 2)
first_half <- port6[1:n_half, ]
second_half <- port6[(n_half+1):nrow(port6), ]
cat("First half: ", as.character(min(first_half$date)), "to", as.character(max(first_half$date)), "\n")## First half: 1930-01-01 to 1974-06-01cat("Second half:", as.character(min(second_half$date)), "to", as.character(max(second_half$date)), "\n\n")## Second half: 1974-07-01 to 2018-12-01compute_stats <- function(df, cols) {
data.frame(
Portfolio = cols,
Mean_pct = sapply(cols, function(c) round(mean(df[[c]], na.rm=TRUE)*100, 3)),
SD_pct = sapply(cols, function(c) round(sd(df[[c]], na.rm=TRUE)*100, 3)),
Skewness = sapply(cols, function(c) round(skewness(df[[c]], na.rm=TRUE), 3)),
Kurtosis = sapply(cols, function(c) round(kurtosis(df[[c]], na.rm=TRUE), 3))
)
}
cat("=== First Half Statistics ===\n")## === First Half Statistics ===print(compute_stats(first_half, port_names))## Portfolio Mean_pct SD_pct Skewness Kurtosis
## SMALL LoBM SMALL LoBM 0.971 8.225 1.180 12.072
## ME1 BM2 ME1 BM2 1.169 8.423 1.580 15.740
## SMALL HiBM SMALL HiBM 1.484 10.206 2.288 20.076
## BIG LoBM BIG LoBM 0.765 5.709 0.178 9.894
## ME2 BM2 ME2 BM2 0.812 6.734 1.712 20.535
## BIG HiBM BIG HiBM 1.187 8.911 1.769 17.468cat("\n=== Second Half Statistics ===\n")##
## === Second Half Statistics ===print(compute_stats(second_half, port_names))## Portfolio Mean_pct SD_pct Skewness Kurtosis
## SMALL LoBM SMALL LoBM 0.996 6.688 -0.409 5.159
## ME1 BM2 ME1 BM2 1.355 5.282 -0.533 6.425
## SMALL HiBM SMALL HiBM 1.425 5.499 -0.464 7.306
## BIG LoBM BIG LoBM 0.978 4.696 -0.334 4.992
## ME2 BM2 ME2 BM2 1.058 4.339 -0.473 5.653
## BIG HiBM BIG HiBM 1.145 4.887 -0.517 5.805Interpretation: The two sub-periods show notably different means, SDs, skewness and kurtosis. The first half (1930–1974) has higher volatility and fatter tails due to the Great Depression and WWII. Returns do not come from the same distribution — the return-generating process is non-stationary over the full period.
E_rP <- 0.11; sigma_P <- 0.15; rf <- 0.05
y_a <- (0.08 - rf) / (E_rP - rf)
cat("(a) y in risky portfolio:", round(y_a, 4), "\n")## (a) y in risky portfolio: 0.5cat(" 1-y in risk-free: ", round(1-y_a, 4), "\n\n")## 1-y in risk-free: 0.5sigma_C <- y_a * sigma_P
cat("(b) SD of complete portfolio:", round(sigma_C*100, 4), "%\n\n")## (b) SD of complete portfolio: 7.5 %y_c <- 0.12 / sigma_P
E_rC2 <- rf + y_c*(E_rP - rf)
cat("(c) Client 2: y =", round(y_c,4), "-> E(r) =", round(E_rC2*100,4), "%\n")## (c) Client 2: y = 0.8 -> E(r) = 9.8 %cat(" Client 1 is MORE risk averse (invests less in risky asset).\n")## Client 1 is MORE risk averse (invests less in risky asset).Answers: (a) y = 0.50 in risky, 0.50 in risk-free. (b) σC = 7.5%. (c) Client 1 is more risk averse.
E_rM <- 0.12; sigma_M <- 0.20; rf22 <- 0.05
sigma_target <- sigma_M / 2
E_rC22 <- rf22 + ((E_rM - rf22)/sigma_M) * sigma_target
cat("Slope of CML:", round((E_rM-rf22)/sigma_M, 4), "\n")## Slope of CML: 0.35cat("Expected return for Johnson:", round(E_rC22*100, 4), "%\n")## Expected return for Johnson: 8.5 %Answer: Using the CML: E(rC) = 5% + (7%/20%) × 10% = 8.5%
Answer: Indifference curve 4 represents the greatest achievable utility. It is the highest curve still tangent to the CAL. Curves above it are preferred but unattainable.
Answer: Point H is the optimal risky portfolio — the tangency point between the CAL and the efficient frontier, where the Sharpe ratio is maximized.
rf8 <- 0.06; E_eq <- 0.16; sigma_eq <- 0.14
w_eq <- 0.60; w_rf8 <- 0.40
E_client <- w_eq*E_eq + w_rf8*rf8
sigma_client <- w_eq*sigma_eq
cat("Expected return:", round(E_client*100, 4), "%\n")## Expected return: 12 %cat("Standard deviation:", round(sigma_client*100, 4), "%\n")## Standard deviation: 8.4 %Answers: E(rC) = 60% × 16% + 40% × 6% = 12%. σC = 60% × 14% = 8.4%.
cat("(a) Gold appears inferior in both return and SD.\n")## (a) Gold appears inferior in both return and SD.cat(" However if correlation(Gold,Stocks) < 1, adding gold REDUCES\n")## However if correlation(Gold,Stocks) < 1, adding gold REDUCEScat(" portfolio variance through diversification. An investor would\n")## portfolio variance through diversification. An investor wouldcat(" hold gold for its diversification benefit.\n\n")## hold gold for its diversification benefit.cat("(b) If rho = 1: no diversification benefit.\n")## (b) If rho = 1: no diversification benefit.cat(" Gold is fully dominated -> no investor would hold it.\n\n")## Gold is fully dominated -> no investor would hold it.cat("(c) rho=1 with gold inferior CANNOT be equilibrium.\n")## (c) rho=1 with gold inferior CANNOT be equilibrium.cat(" Gold price would fall until its return rises enough to attract buyers.\n")## Gold price would fall until its return rises enough to attract buyers.sigma_A <- 0.05; sigma_B <- 0.10
E_A <- 0.10; E_B <- 0.15
w_A <- sigma_B / (sigma_A + sigma_B)
w_B <- 1 - w_A
cat("Zero-variance portfolio: w_A =", round(w_A,4), ", w_B =", round(w_B,4), "\n")## Zero-variance portfolio: w_A = 0.6667 , w_B = 0.3333var_p <- w_A^2*sigma_A^2 + w_B^2*sigma_B^2 + 2*w_A*w_B*(-1)*sigma_A*sigma_B
cat("Portfolio variance (should be 0):", round(var_p, 10), "\n")## Portfolio variance (should be 0): 0rf_implied <- w_A*E_A + w_B*E_B
cat("Implied risk-free rate:", round(rf_implied*100, 4), "%\n")## Implied risk-free rate: 11.6667 %Answer: With ρ = −1, zero-variance portfolio: w_A = 2/3, w_B = 1/3. Implied rf = 11.67%.
w_orig <- 0.90; w_abc <- 0.10
E_orig <- 0.0067; sigma_orig <- 0.0237
E_abc <- 0.0125; sigma_abc <- 0.0295
rho <- 0.40
E_new <- w_orig*E_orig + w_abc*E_abc
cov_abc <- rho*sigma_abc*sigma_orig
var_new <- w_orig^2*sigma_orig^2 + w_abc^2*sigma_abc^2 + 2*w_orig*w_abc*cov_abc
sigma_new <- sqrt(var_new)
cat("(a.i) New E(r):", round(E_new*100,4), "%/month\n")## (a.i) New E(r): 0.728 %/monthcat("(a.ii) Covariance:", round(cov_abc,8), "\n")## (a.ii) Covariance: 0.00027966cat("(a.iii) New SD:", round(sigma_new*100,4), "%/month\n\n")## (a.iii) New SD: 2.2672 %/monthE_rfb <- 0.0042
E_new_b <- w_orig*E_orig + w_abc*E_rfb
sigma_new_b <- sqrt(w_orig^2*sigma_orig^2)
cat("(b.i) E(r) with gov securities:", round(E_new_b*100,4), "%/month\n")## (b.i) E(r) with gov securities: 0.645 %/monthcat("(b.ii) Covariance(gov, Portfolio): 0\n")## (b.ii) Covariance(gov, Portfolio): 0cat("(b.iii) SD with gov securities:", round(sigma_new_b*100,4), "%/month\n\n")## (b.iii) SD with gov securities: 2.133 %/monthcat("(c) Gov securities portfolio has LOWER systematic risk (beta = 0).\n\n")## (c) Gov securities portfolio has LOWER systematic risk (beta = 0).cat("(d) Husband INCORRECT: portfolio risk depends on covariance, not just SD.\n\n")## (d) Husband INCORRECT: portfolio risk depends on covariance, not just SD.cat("(e.i) SD penalizes upside and downside equally - not suitable for Grace.\n")## (e.i) SD penalizes upside and downside equally - not suitable for Grace.cat("(e.ii) Better measure: Lower Partial Standard Deviation (LPSD).\n")## (e.ii) Better measure: Lower Partial Standard Deviation (LPSD).rf_17 <- 0.08; E_mkt17 <- 0.16; sig_mkt17 <- 0.23
E_r17 <- c(0.20, 0.18, 0.17, 0.12)
beta17 <- c(1.3, 1.8, 0.7, 1.0)
res_sd17 <- c(0.58, 0.71, 0.60, 0.55)
stocks17 <- c("A", "B", "C", "D")
alpha17 <- E_r17 - (rf_17 + beta17*(E_mkt17 - rf_17))
res_var17 <- res_sd17^2
cat("=== (a) Alpha and Residual Variance ===\n")## === (a) Alpha and Residual Variance ===print(data.frame(Stock=stocks17, Alpha_pct=round(alpha17*100,2), Res_Var=round(res_var17,4)))## Stock Alpha_pct Res_Var
## 1 A 1.6 0.3364
## 2 B -4.4 0.5041
## 3 C 3.4 0.3600
## 4 D -4.0 0.3025w_act17 <- (alpha17/res_var17) / sum(alpha17/res_var17)
cat("\n=== (b) Active Portfolio Weights ===\n")##
## === (b) Active Portfolio Weights ===print(data.frame(Stock=stocks17, Weight=round(w_act17,4)))## Stock Weight
## 1 A -0.6136
## 2 B 1.1261
## 3 C -1.2185
## 4 D 1.7060alpha_A17 <- sum(w_act17*alpha17)
beta_A17 <- sum(w_act17*beta17)
sig2_eA17 <- sum(w_act17^2*res_var17)
sig_eA17 <- sqrt(sig2_eA17)
SR_pass17 <- (E_mkt17 - rf_17) / sig_mkt17
IR_17 <- alpha_A17 / sig_eA17
SR_opt17 <- sqrt(SR_pass17^2 + IR_17^2)
cat("\n=== (c) Sharpe Ratios ===\n")##
## === (c) Sharpe Ratios ===cat("Passive:", round(SR_pass17,4), "| Optimal:", round(SR_opt17,4), "\n")## Passive: 0.3478 | Optimal: 0.3662cat("\n=== (d) Improvement:", round(SR_opt17-SR_pass17,4), "===\n")##
## === (d) Improvement: 0.0183 ===w0_A17 <- (alpha_A17/sig2_eA17) / ((E_mkt17-rf_17)/sig_mkt17^2)
w_A17 <- w0_A17 / (1+(1-beta_A17)*w0_A17)
E_rP17 <- rf_17 + w_A17*alpha_A17 + (w_A17*beta_A17+(1-w_A17))*(E_mkt17-rf_17)
var_P17 <- (w_A17*beta_A17+(1-w_A17))^2*sig_mkt17^2 + w_A17^2*sig2_eA17
y17 <- (E_rP17-rf_17) / (2.8*var_P17)
cat("\n=== (e) Complete Portfolio (A=2.8) ===\n")##
## === (e) Complete Portfolio (A=2.8) ===cat("y in risky portfolio:", round(y17,4), "\n")## y in risky portfolio: 0.5701cat("y in T-bills: ", round(1-y17,4), "\n")## y in T-bills: 0.4299cat("Regression Results:\n")## Regression Results:cat(" ABC XYZ\n")## ABC XYZcat("Alpha: -3.20% +7.30%\n")## Alpha: -3.20% +7.30%cat("Beta: 0.60 0.97\n")## Beta: 0.60 0.97cat("R-squared: 0.35 0.17\n")## R-squared: 0.35 0.17cat("Residual SD: 13.02% 21.45%\n\n")## Residual SD: 13.02% 21.45%cat("ABC: Negative alpha -> underperformed benchmark.\n")## ABC: Negative alpha -> underperformed benchmark.cat(" Low beta (0.60) -> defensive, stable systematic risk.\n\n")## Low beta (0.60) -> defensive, stable systematic risk.cat("XYZ: Positive alpha (+7.30%) -> outperformed benchmark.\n")## XYZ: Positive alpha (+7.30%) -> outperformed benchmark.cat(" R2=0.17 -> 83% firm-specific risk.\n")## R2=0.17 -> 83% firm-specific risk.cat(" Recent betas (1.25-1.45) >> historical (0.97) ->\n")## Recent betas (1.25-1.45) >> historical (0.97) ->cat(" systematic risk has INCREASED, use recent estimates.\n")## systematic risk has INCREASED, use recent estimates.Conclusion: In a diversified portfolio, beta is the relevant risk measure. ABC has low systematic risk but negative alpha. XYZ has positive alpha but its rising beta indicates increasing market sensitivity — the 5-year historical beta understates current risk.