Q1 · Single-Factor Model
n <- 96; alpha_hat <- 0.0017; alpha_se <- 0.0020
beta_hat <- 0.98; beta_se <- 0.17
R2 <- 0.50; mkt_prem <- 0.0070; t_crit <- 1.98
# (a) t-test beta = 0
t_b0 <- (beta_hat - 0) / beta_se
cat("(a) t(beta=0):", round(t_b0, 4), "| Reject H0:", abs(t_b0) > t_crit)
## (a) t(beta=0): 5.7647 | Reject H0: TRUE
# (b) t-test beta = 1
t_b1 <- (beta_hat - 1) / beta_se
cat("\n(b) t(beta=1):", round(t_b1, 4), "| Reject H0:", abs(t_b1) > t_crit)
##
## (b) t(beta=1): -0.1176 | Reject H0: FALSE
# (c) t-test alpha
t_a <- alpha_hat / alpha_se
cat("\n(c) t(alpha):", round(t_a, 4), "| Reject H0:", abs(t_a) > t_crit)
##
## (c) t(alpha): 0.85 | Reject H0: FALSE
# (d) R2 decomposition
cat("\n(d) Systematic:", R2*100, "% | Idiosyncratic:", (1-R2)*100, "%")
##
## (d) Systematic: 50 % | Idiosyncratic: 50 %
# (e) CAPM expected return
capm_exp <- beta_hat * mkt_prem
cat("\n(e) CAPM E[R]:", round(capm_exp * 100, 4), "% per month")
##
## (e) CAPM E[R]: 0.686 % per month
Q2 · Fama-French Three-Factor Model
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
coefs <- tibble(
Term = c("alpha", "MKT", "SMB", "HML"),
Est = c(0.0029, 0.97, 0.75, -0.13),
SE = c(0.0018, 0.08, 0.11, 0.13)
) |> mutate(t_stat = round(Est / SE, 4),
Significant = abs(t_stat) > 1.98)
# (f)
print(coefs)
## # A tibble: 4 × 5
## Term Est SE t_stat Significant
## <chr> <dbl> <dbl> <dbl> <lgl>
## 1 alpha 0.0029 0.0018 1.61 FALSE
## 2 MKT 0.97 0.08 12.1 TRUE
## 3 SMB 0.75 0.11 6.82 TRUE
## 4 HML -0.13 0.13 -1 FALSE
# (g) style
cat("SMB =", coefs$Est[3], "-> small-cap tilt")
## SMB = 0.75 -> small-cap tilt
cat("\nHML =", coefs$Est[4], "-> mild growth tilt (insignificant)")
##
## HML = -0.13 -> mild growth tilt (insignificant)
# (h) alpha
cat("\nalpha t =", coefs$t_stat[1], "-> NOT significant; manager does not add value")
##
## alpha t = 1.6111 -> NOT significant; manager does not add value
# (i)
cat("\nR2 CAPM = 0.75 | R2 FF3 = 0.92 | Delta =", 0.92 - 0.75)
##
## R2 CAPM = 0.75 | R2 FF3 = 0.92 | Delta = 0.17
cat("\nAdj R2 = 0.918 penalises extra predictors; confirms SMB/HML are genuinely informative")
##
## Adj R2 = 0.918 penalises extra predictors; confirms SMB/HML are genuinely informative
Q3 · Logistic Regression
b0 <- -0.02; b1 <- 5.4; b2 <- -0.38
r_lag <- 0.010; dVIX <- 1.5
# (j)
logit_val <- b0 + b1*r_lag + b2*dVIX
prob_up <- 1 / (1 + exp(-logit_val))
cat("(j) logit:", round(logit_val, 4),
"| P(Up):", round(prob_up, 4),
"| Class:", ifelse(prob_up >= 0.5, "Up", "Down"))
## (j) logit: -0.536 | P(Up): 0.3691 | Class: Down
# (l) confusion matrix metrics
TP <- 67; FP <- 44; FN <- 33; TN <- 56; N <- 200
accuracy <- (TP + TN) / N
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)
precision <- TP / (TP + FP)
cat("\n(l) Accuracy:", round(accuracy, 4),
"| Sensitivity:", round(sensitivity, 4),
"| Specificity:", round(specificity, 4),
"| Precision:", round(precision, 4))
##
## (l) Accuracy: 0.615 | Sensitivity: 0.67 | Specificity: 0.56 | Precision: 0.6036
# (m) naive baseline
naive_acc <- max(100, 100) / N
cat("\n(m) Naive accuracy:", naive_acc,
"| Model beats naive:", accuracy > naive_acc)
##
## (m) Naive accuracy: 0.5 | Model beats naive: TRUE
Q4 · Resampling and Regularization
library(ggplot2)
mu <- 0.0070; sigma <- 0.0550; n_months <- 48
# (n) Sharpe ratio
SR_monthly <- mu / sigma
SR_annual <- SR_monthly * sqrt(12)
cat("(n) SR monthly:", round(SR_monthly, 4),
"| SR annual:", round(SR_annual, 4),
"| Scale factor: sqrt(12)")
## (n) SR monthly: 0.1273 | SR annual: 0.4409 | Scale factor: sqrt(12)
# (o) bootstrap demo
set.seed(42)
B <- 5000
sim_ret <- arima.sim(list(ar = 0.15), n = n_months,
rand.gen = function(n) rnorm(n, mu, sigma))
sr_fn <- function(x) mean(x) / sd(x)
iid_boot <- replicate(B, sr_fn(sample(sim_ret, n_months, replace = TRUE)))
cat("\n(o) Bootstrap SE (iid):", round(sd(iid_boot), 4))
##
## (o) Bootstrap SE (iid): 0.1476
# block bootstrap
blk <- 4
blk_boot <- replicate(B, {
starts <- sample(seq_len(n_months - blk + 1), ceiling(n_months/blk), replace = TRUE)
s <- unlist(lapply(starts, function(i) sim_ret[i:(i+blk-1)]))[seq_len(n_months)]
sr_fn(s)
})
cat("\n(o) Bootstrap SE (block, l=4):", round(sd(blk_boot), 4))
##
## (o) Bootstrap SE (block, l=4): 0.1725
# (p)
cat("\n(p) Choose lambda_1SE = 0.065 (7 factors): more parsimonious,",
"lower overfitting risk, better OOS stability")
##
## (p) Choose lambda_1SE = 0.065 (7 factors): more parsimonious, lower overfitting risk, better OOS stability
# (q) walk-forward diagram
fold_df <- lapply(1:4, function(k) {
te <- 24 + (k-1)*6; bind_rows(
tibble(Fold=k, Type="Train", Start=1, End=te),
tibble(Fold=k, Type="Test", Start=te+1, End=te+6))
}) |> bind_rows()
ggplot(fold_df, aes(xmin=Start, xmax=End, ymin=Fold-.4, ymax=Fold+.4, fill=Type)) +
geom_rect(colour="white") +
scale_fill_manual(values=c(Train="#2c7bb6", Test="#d7191c")) +
labs(title="Walk-Forward CV", x="Month", y=NULL) +
theme_minimal()
