Homework 02: Risk Premium & Fama-French Portfolios

knitr::opts_chunk$set(echo = TRUE)
# Install necessary packages if you don't have them:
# install.packages("dplyr")
# install.packages("moments")
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

library(moments)

## Warning: package 'moments' was built under R version 4.5.2

# Define probabilities and payoffs for Equities 
prob_eq <- c(0.6, 0.4)
payoff_eq <- c(50000, -30000)

# Calculate Expected Return for Equities
exp_return_eq <- sum(prob_eq * payoff_eq)

# Define probability and payoff for Risk-Free T-bills 
prob_rf <- 1.0
payoff_rf <- 5000

# Calculate Expected Return for T-bills
exp_return_rf <- prob_rf * payoff_rf

# Calculate Expected Risk Premium
risk_premium <- exp_return_eq - exp_return_rf

# Output the results
cat("Expected Return on Equities: $", exp_return_eq, "\n")

## Expected Return on Equities: $ 18000

cat("Expected Return on T-bills: $", exp_return_rf, "\n")

## Expected Return on T-bills: $ 5000

cat("Expected Risk Premium: $", risk_premium, "\n")

## Expected Risk Premium: $ 13000

# Note: eval=FALSE is set here. Change to eval=TRUE once your CSV is saved in the directory!

# 1. Load the cleaned Fama-French data
ff_data <- read.csv("ff_vw_clean.csv", header = TRUE)

# 2. Split the sample in half
# January 1930 to December 2018 is exactly 89 years, or 1068 months.
# Half of 1068 is 534 months.
# First half: Jan 1930 to June 1974
# Second half: July 1974 to Dec 2018

first_half <- ff_data[1:534, ]
second_half <- ff_data[535:1068, ]

# 3. Create a function to compute the 4 moments (Average, SD, Skewness, Kurtosis)
compute_moments <- function(data) {
  # Remove the Date column for calculations
  returns_only <- data %>% select(-Date) 
  
  # Calculate statistics
  stats <- data.frame(
    Average = sapply(returns_only, mean, na.rm = TRUE),
    SD = sapply(returns_only, sd, na.rm = TRUE),
    Skewness = sapply(returns_only, skewness, na.rm = TRUE),
    Kurtosis = sapply(returns_only, kurtosis, na.rm = TRUE)
  )
  return(stats)
}

# 4. Compute statistics for both halves
stats_first_half <- compute_moments(first_half)
stats_second_half <- compute_moments(second_half)

# Display the results
print("--- FIRST HALF (1930 - 1974) ---")

## [1] "--- FIRST HALF (1930 - 1974) ---"

print(round(stats_first_half, 4))

##            Average      SD Skewness Kurtosis
## SMALL.LoBM  0.9713  8.2253   1.1800  12.0716
## ME1.BM2     1.1695  8.4229   1.5797  15.7404
## SMALL.HiBM  1.4844 10.2059   2.2875  20.0760
## BIG.LoBM    0.7648  5.7095   0.1783   9.8941
## ME2.BM2     0.8118  6.7341   1.7116  20.5352
## BIG.HiBM    1.1874  8.9106   1.7694  17.4682

print("--- SECOND HALF (1974 - 2018) ---")

## [1] "--- SECOND HALF (1974 - 2018) ---"

print(round(stats_second_half, 4))

##            Average     SD Skewness Kurtosis
## SMALL.LoBM  0.9959 6.6884  -0.4086   5.1587
## ME1.BM2     1.3548 5.2817  -0.5330   6.4246
## SMALL.HiBM  1.4251 5.4987  -0.4644   7.3053
## BIG.LoBM    0.9781 4.6955  -0.3337   4.9925
## ME2.BM2     1.0578 4.3391  -0.4729   5.6534
## BIG.HiBM    1.1446 4.8871  -0.5172   5.8054