PROJECT

HRUSHI RIYAN GAJJALA

2024-10-26

library(plotly)

## Loading required package: ggplot2

##
## Attaching package: 'plotly'
## The following object is masked from 'package:ggplot2':
##
## last_plot
## The following object is masked from 'package:stats':
##
## filter
## The following object is masked from 'package:graphics':
##
## layout
library(corpcor)
library(quantmod)

## Loading required package: xts

## Loading required package: zoo
##
## Attaching package: 'zoo'
## The following objects are masked from 'package:base':
##
## [Link], [Link]
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## [Link] zoo
library(PerformanceAnalytics)

##
## Attaching package: 'PerformanceAnalytics'
## The following object is masked from 'package:graphics':
##
## legend

1
library(tseries)
library(forecast)
library(smooth)

## Loading required package: greybox

## Package "greybox", v2.0.2 loaded.
## This is package "smooth", v4.1.0
##
## Attaching package: 'smooth'
## The following object is masked from 'package:TTR':
##
## lags
library(readxl)

# Question 2

start_date = "2017-01-01"
end_date = "2020-12-31"

# Apple (AAPL) Monthly Returns

getSymbols("AAPL", from = start_date, to = end_date, src = "yahoo")

## [1] "AAPL"
monthly_aapl <- [Link](AAPL)
aapl_prices <- monthly_aapl$[Link]
aapl_returns <- diff(log(aapl_prices))

# Procter & Gamble (PG) Monthly Returns

getSymbols("PG", from = start_date, to = end_date, src = "yahoo")

## [1] "PG"
monthly_pg <- [Link](PG)
pg_prices <- monthly_pg$[Link]
pg_returns <- diff(log(pg_prices))

# Amazon (AMZN) Monthly Returns

getSymbols("AMZN", from = start_date, to = end_date, src = "yahoo")

## [1] "AMZN"
monthly_amzn <- [Link](AMZN)
amzn_prices <- monthly_amzn$[Link]
amzn_returns <- diff(log(amzn_prices))

# JPMorgan Chase (JPM) Monthly Returns

getSymbols("JPM", from = start_date, to = end_date, src = "yahoo")

## [1] "JPM"
monthly_jpm <- [Link](JPM)
jpm_prices <- monthly_jpm$[Link]
jpm_returns <- diff(log(jpm_prices))

2
# Walmart (WMT) Monthly Returns
getSymbols("WMT", from = start_date, to = end_date, src = "yahoo")

## [1] "WMT"
monthly_wmt <- [Link](WMT)
wmt_prices <- monthly_wmt$[Link]
wmt_returns <- diff(log(wmt_prices))

# Monthly returns of 10-year bond (risk-free rate)

getSymbols("ˆTNX", from = start_date, to = end_date, src = "yahoo")

## Warning: ^TNX contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using [Link](),
## [Link](), [Link](), etc to remove or replace them.
## [1] "TNX"
monthly_tnx <- [Link](TNX)

## Warning in [Link](x, "months", indexAt = indexAt, name = name, ...): missing

## values removed from data
tnx_rates <- monthly_tnx$[Link]
risk_free_returns <- tnx_rates / 1200

# Excess Returns
excess_aapl <- aapl_returns - risk_free_returns
excess_pg <- pg_returns - risk_free_returns
excess_amzn <- amzn_returns - risk_free_returns
excess_jpm <- jpm_returns - risk_free_returns
excess_wmt <- wmt_returns - risk_free_returns

# Information Tables
price_data <- [Link](aapl_prices, pg_prices, amzn_prices, jpm_prices, wmt_prices)
returns_data <- [Link](aapl_returns, pg_returns, amzn_returns, jpm_returns, wmt_returns)
excess_returns_data <- [Link](excess_aapl, excess_pg, excess_amzn, excess_jpm, excess_wmt)
returns_data <- returns_data[-1,] # Remove NA row
excess_returns_data <- excess_returns_data[-1,]

# Variance-Covariance Matrix
stock_names <- c("AAPL", "PG", "AMZN", "JPM", "WMT") # Stock names
var_cov_matrix <- matrix(c(cov(returns_data)), nrow = 5, ncol = 5, byrow = TRUE)
dimnames(var_cov_matrix) <- list(stock_names, stock_names)

# Display Data
var_cov_matrix

## AAPL PG AMZN JPM WMT

## AAPL 0.008008934 0.0013818531 0.0039332326 0.0028196860 0.001257458
## PG 0.001381853 0.0019548100 0.0004591876 0.0009843019 0.001037191
## AMZN 0.003933233 0.0004591876 0.0067755011 0.0020653669 0.001260708
## JPM 0.002819686 0.0009843019 0.0020653669 0.0055085219 0.001091875
## WMT 0.001257458 0.0010371906 0.0012607080 0.0010918745 0.002854092

3
# Calculate Returns
mean_returns <- matrix(colMeans(returns_data, [Link] = TRUE))
mean_excess_returns <- matrix(colMeans(excess_returns_data, [Link] = TRUE))
avg_risk_free <- mean((risk_free_returns)[-1,])

# Create Return Table

return_matrix <- matrix(c(mean_returns, mean_excess_returns), ncol = 2)
dimnames(return_matrix) <- list(stock_names, c("Return ", "Excess Return"))

cat("\n")
return_matrix

## Return Excess Return

## AAPL 0.03271767 0.031034323
## PG 0.01196776 0.010284408
## AMZN 0.02944343 0.027760082
## JPM 0.01061726 0.008933908
## WMT 0.01820945 0.016526098
cat("\n")
cat("Monthly Risk Free: ", avg_risk_free)

## Monthly Risk Free: 0.001683351

# Optimum Portfolio
optimal_weights <- solve(var_cov_matrix, mean_excess_returns)
optimal_weight <- optimal_weights / sum(optimal_weights)
dimnames(optimal_weight) <- list(stock_names, "Weights")

# Display Data
optimal_weight

## Weights
## AAPL 0.2682597
## PG 0.2191622
## AMZN 0.2765342
## JPM -0.1756479
## WMT 0.4116918
# Calculate Stats
opt_portfolio_return <- t(optimal_weight) %*% mean_returns
opt_portfolio_variance <- t(optimal_weight) %*% var_cov_matrix %*% optimal_weight
opt_portfolio_sd <- sqrt(opt_portfolio_variance)
Sharpe_Ratio <- (opt_portfolio_return - avg_risk_free) / opt_portfolio_sd

# Create Optimal Stats Table

opt_portfolio_stats <- matrix(c(opt_portfolio_return, opt_portfolio_variance, opt_portfolio_sd, Sharpe_R
optstat_names <- c("Return", "Variance", "Std Dev", "Sharpe ratio")

cat("\n")
dimnames(opt_portfolio_stats) <- list(optstat_names, "Opt. Portfolio")
opt_portfolio_stats

## Opt. Portfolio

4
## Return 0.025173612
## Variance 0.002695675
## Std Dev 0.051919894
## Sharpe ratio 0.452432754
## Global Minimum Variance portfolio
gmv_weights <- solve(var_cov_matrix, matrix(rep(1, 5), byrow = TRUE))
gmv_weight <- gmv_weights / sum(gmv_weights)
dimnames(gmv_weight) <- list(stock_names, "Weights")

# Calculate GMV Portfolio Stats

gmv_return <- t(gmv_weight) %*% mean_returns
gmv_variance <- t(gmv_weight) %*% var_cov_matrix %*% gmv_weight
gmv_sd <- sqrt(gmv_variance)

# Create GMV Stats Table

gmv_portfolio_stats <- matrix(c(gmv_return, gmv_variance, gmv_sd), nrow = 3)
gmvstat_names <- c("Return", "Variance", "Std Dev")
dimnames(gmv_portfolio_stats) <- list(gmvstat_names, "GMV Portfolio")

# Display Data
gmv_weight

## Weights
## AAPL -0.05468113
## PG 0.59377999
## AMZN 0.13869409
## JPM 0.09273972
## WMT 0.22946732
cat("\n")
gmv_portfolio_stats

## GMV Portfolio
## Return 0.014563922
## Variance 0.001478138
## Std Dev 0.038446556
# Efficient Frontier and CAL

j <- 0
return_portfolio <- rep(0, 50000)
sd_portfolio <- rep(0, 50000)
vect_0 <- rep(0, 50000)
fractions <- matrix(vect_0, 10000, 5)

for (a in seq(-.2, 1, 0.1)) {

for (b in seq(-.2, 1, 0.1)) {
for (c in seq(-.2, 1, 0.1)) {
for (d in seq(-.2, 1, 0.1)) {
for (e in seq(-.2, 1, 0.1)) {
if (a + b + c + d + e == 1) {
j <- j + 1
fractions[j,] <- c(a, b, c, d, e)
sd_portfolio[j] <- sqrt(t(fractions[j,]) %*% var_cov_matrix %*% fractions[j,])

5
 return_portfolio[j] <- fractions[j,] %*% mean_returns
}
}
}
}
}
}

Return_p <- return_portfolio[1:j]

Stddev_p <- sd_portfolio[1:j]

## Create Capital Asset Line

f <- seq(0, .24, .01)
CAL <- avg_risk_free + Sharpe_Ratio * f

## Warning in Sharpe_Ratio * f: Recycling array of length 1 in array-vector arithmetic is deprecated.

## Use c() or [Link]() instead.
# Plot the portfolio possibilities curve
plot(Stddev_p, Return_p, col = "green1", xlab = "Portfolio Standard Deviation", ylab = "Portfolio Expect
points(gmv_sd, gmv_return, col = "red3", pch = 17)
points(opt_portfolio_sd, opt_portfolio_return, col = "black", pch = 16, bg = "black")
points(f, CAL, col = "cadetblue", type = "l")
legend("bottomright", c("Short Sale", "GMV", "Tangency Portfolio", "CAL"), cex = 0.8, col = c("green1",
0.04
Portfolio Expected Return

0.02
0.00

Short Sale
GMV
Tangency Portfolio
−0.02

CAL

0.00 0.05 0.10 0.15

Portfolio Standard Deviation

#QUESTION - 3
library(quantmod)
library(ggplot2)

# Set Dates
start_date = "2021-01-01"
end_date = "2024-06-30"

6
# Fetch Data for Selected Stocks
getSymbols("AAPL", from = start_date, to = end_date, periodicity = "monthly")

## [1] "AAPL"
getSymbols("PG", from = start_date, to = end_date, periodicity = "monthly")

## [1] "PG"
getSymbols("AMZN", from = start_date, to = end_date, periodicity = "monthly")

## [1] "AMZN"
getSymbols("JPM", from = start_date, to = end_date, periodicity = "monthly")

## [1] "JPM"
getSymbols("WMT", from = start_date, to = end_date, periodicity = "monthly")

## [1] "WMT"
# Fetch S&P 500 Data
getSymbols("ˆGSPC", from = start_date, to = end_date, src = "yahoo", periodicity = "monthly")

## [1] "GSPC"
rGSPC <- diff(log(Ad(GSPC))) # Use adjusted closing prices only
rGSPC <- rGSPC[-1,]
SP500 <- Ad(GSPC)

# Fetch 10-Year Treasury Note Data

getSymbols("ˆTNX", from = start_date, to = end_date, periodicity = "monthly", src = "yahoo")

## Warning: ^TNX contains missing values. Some functions will not work if objects
## contain missing values in the middle of the series. Consider using [Link](),
## [Link](), [Link](), etc to remove or replace them.
## [1] "TNX"
priceTNX <- Ad(TNX) # Accessing the adjusted close price for TNX
rTNX <- diff(log(priceTNX)) / 100

# Calculate Initial Prices

initial_priceAAPL <- [Link](Ad(AAPL)[1])
initial_pricePG <- [Link](Ad(PG)[1])
initial_priceAMZN <- [Link](Ad(AMZN)[1])
initial_priceJPM <- [Link](Ad(JPM)[1])
initial_priceWMT <- [Link](Ad(WMT)[1])

# Update initialmatrix to a vector

initialmatrix <- c(initial_priceAAPL, initial_pricePG, initial_priceAMZN, initial_priceJPM, initial_pric

optimal_weight <- optimal_weights / sum(optimal_weights)

# Calculate Number of Shares

NumberofShares <- (optimal_weight * 100 / initialmatrix)
NumberofShares

## [,1]
## AAPL 0.2078924

7
## PG 0.1887335
## AMZN 0.1724997
## JPM -0.1522083
## WMT 0.9299538
# Fetch Closing Prices
close_price_AAPL <- Ad(AAPL)
close_price_PG <- Ad(PG)
close_price_AMZN <- Ad(AMZN)
close_price_JPM <- Ad(JPM)
close_price_WMT <- Ad(WMT)

closing_prices_matrix <- [Link](close_price_AAPL, close_price_PG, close_price_AMZN, close_price_JPM,

# Calculate Portfolio Value

portfolio_value <- rowSums([Link](closing_prices_matrix) * [Link](NumberofShares))
portfolio_index <- 100 / portfolio_value[1] * portfolio_value # Scaling to start at 100

# S&P 500 Index Calculation

SP500_index <- 100 / [Link](SP500[1]) * [Link](SP500)

# Align Dates
min_length <- min(length(index(AAPL)), length(portfolio_index), length(SP500_index))
dates <- index(AAPL)[1:min_length]
portfolio_index <- portfolio_index[1:min_length]
SP500_index <- SP500_index[1:min_length]

# Create DataFrames
monthly_index_df <- [Link](Date = dates, Index = portfolio_index)
SP500_index_df <- [Link](Date = dates, Index = SP500_index)

# Plotting the Tangency Portfolio Index

ggplot(data = monthly_index_df, aes(x = Date, y = Index)) +
geom_line(color = "cyan3") +
geom_point(color = "cyan4", size = 1) +
geom_hline(yintercept = 100, linetype = "dashed", color = "grey") +
labs(title = "Tangency Portfolio Index (2021-2024)", x = "Date", y = "Index") +
theme_minimal()

8
 Tangency Portfolio Index (2021−2024)

120

100
Index

80

60

40
2021 2022 2023 2024
Date
# Question - 4
library(xts)
library(PerformanceAnalytics)
library(ggplot2)

# Calculate portfolio returns

portfolio_returns <- diff(log(portfolio_value))
portfolio_returns <- [Link](portfolio_returns)
portfolio_returns <- [Link](portfolio_returns)

# Calculate market returns

market_returns <- [Link](rGSPC)
market_returns <- [Link](market_returns)

# Use monthly rTNX directly

risk_free_rate <- mean(rTNX, [Link] = TRUE) # Monthly risk-free rate is assumed

# Clean the dates vector to remove invalid entries

dates <- dates[ &  & ]

# Ensure portfolio_returns and market_returns match the cleaned dates

portfolio_returns <- portfolio_returns[1:length(dates)]
market_returns <- market_returns[1:length(dates)]

# Create xts objects

portfolio_xts <- xts(portfolio_returns, [Link] = dates)
market_xts <- xts(market_returns, [Link] = dates)

9
# Estimate CAPM beta
beta <- [Link](portfolio_xts, market_xts, Rf = risk_free_rate)

# Calculate the average return and market risk premium

average_return <- mean(portfolio_returns, [Link] = TRUE)
market_risk_premium <- mean(market_returns, [Link] = TRUE) - risk_free_rate
market_return <- mean(market_returns, [Link] = TRUE)

# Create the Security Market Line (SML)

sml_x <- seq(0, 2, by = 0.01)
sml_y <- risk_free_rate + sml_x * market_risk_premium

# Plot the SML and portfolio data point

sml_plot <- ggplot([Link](sml_x, sml_y), aes(x = sml_x, y = sml_y)) +
geom_line(color = "blue") +
annotate("point", x = beta, y = average_return, color = "red", size = 4) +
xlab("Beta") +
ylab("Expected Return") +
ggtitle("Security Market Line (SML)") +
theme_minimal()

# Print the plot

print(sml_plot)

Security Market Line (SML)

0.01
Expected Return

0.00

0 1 2
Beta
# Calculate the excess returns for CAPM model
market_excess_returns <- market_returns - risk_free_rate
portfolio_excess_returns <- portfolio_returns - risk_free_rate

10
# Fit the CAPM model
capm_model <- lm(portfolio_excess_returns ~ market_excess_returns)

# Print CAPM summary

summary(capm_model)

##
## Call:
## lm(formula = portfolio_excess_returns ~ market_excess_returns)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.7447 -0.1482 0.0161 0.3651 0.6229
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.002716 0.066103 -0.041 0.967
## market_excess_returns -0.618277 1.338420 -0.462 0.647
##
## Residual standard error: 0.4161 on 39 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.005442, Adjusted R-squared: -0.02006
## F-statistic: 0.2134 on 1 and 39 DF, p-value: 0.6467
# Data frame for scatter plot of market vs portfolio returns
df <- [Link](market_excess_returns, portfolio_excess_returns)

# Scatter plot with linear regression line

ggplot(df, aes(x = market_excess_returns, y = portfolio_excess_returns)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE, color = "red") +
labs(x = "Market Return (RSP)", y = "Portfolio Return (WeightPortRet)") +
theme([Link].x = element_text(face = "bold"),
[Link].y = element_text(face = "bold")) +
geom_hline(yintercept = 0, linetype = "dashed", color = "black") +
geom_vline(xintercept = 0, linetype = "dashed", color = "black")

## `geom_smooth()` using formula = 'y ~ x'

## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_smooth()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_point()`).

11
 0.4
Portfolio Return (WeightPortRet)

0.0

−0.4

−0.8
−0.10 −0.05 0.00 0.05
Market Return (RSP)
#QUESTION-5
# Create xts object for portfolio returns
portfolio_xts <- xts(portfolio_returns, [Link] = dates)

# Define shutdown period (March 2020 - June 2020)

shutdown_dummy <- ifelse(index(portfolio_xts) >= [Link]("2020-03-01") & index(portfolio_xts) <= [Link]

# Convert shutdown dummy to xts

shutdown_dummy_xts <- xts(shutdown_dummy, [Link] = index(portfolio_xts))

# Create xts object for market returns

market_xts <- xts(market_returns, [Link] = index(portfolio_xts))

# Calculate excess market returns (market returns - risk-free rate)

excess_market_returns <- market_xts - risk_free_rate

# Calculate the interaction term between market returns and shutdown dummy
market_interaction <- [Link](excess_market_returns) * shutdown_dummy

# Convert all variables to vectors for regression

portfolio_returns_vector <- [Link](portfolio_xts)
excess_market_returns_vector <- [Link](excess_market_returns)
shutdown_dummy_vector <- [Link](shutdown_dummy)
market_interaction_vector <- [Link](market_interaction)

# Combine all variables into a data frame

covid_data <- [Link](

12
 portfolio_returns = portfolio_returns_vector,
excess_market_returns = excess_market_returns_vector,
shutdown_dummy = shutdown_dummy_vector,
market_interaction = market_interaction_vector
)

# Run linear regression with portfolio returns

covid <- lm(portfolio_returns ~ excess_market_returns + shutdown_dummy + market_interaction, data = covi

# Print the regression summary

summary(covid)

##
## Call:
## lm(formula = portfolio_returns ~ excess_market_returns + shutdown_dummy +
## market_interaction, data = covid_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.7447 -0.1482 0.0161 0.3651 0.6229
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -0.002358 0.066103 -0.036 0.972
## excess_market_returns -0.618277 1.338420 -0.462 0.647
## shutdown_dummy NA NA NA NA
## market_interaction NA NA NA NA
##
## Residual standard error: 0.4161 on 39 degrees of freedom
## (1 observation deleted due to missingness)
## Multiple R-squared: 0.005442, Adjusted R-squared: -0.02006
## F-statistic: 0.2134 on 1 and 39 DF, p-value: 0.6467
# QUESTION-6

# Define dates and fetch Vanguard data

start_date <- "2021-01-01"
end_date <- "2024-06-30"

getSymbols("VTI", from = start_date, to = end_date, src = "yahoo", periodicity = "monthly")

## [1] "VTI"
rVTI <- diff(log(VTI$[Link]))
rVTI <- [Link](rVTI)

# Ensure 'dates' and 'rVTI' align

dates <- dates[-1]
rVTI <- rVTI[1:length(dates)]

vanguard_xts <- xts(rVTI, [Link] = dates)

# Coefficient of Variation (CV)

calculateCV <- function(x) {
return(sd(x, [Link] = TRUE) / mean(x, [Link] = TRUE))

13
}

cv <- calculateCV(portfolio_returns)
cvVTI <- calculateCV(rVTI)

risk_free_rate

## [1] 0.0003577014
# Sharpe Ratio
sharpe_ratio <- [Link](portfolio_xts, Rf = risk_free_rate)
vanguard_sharpe_ratio <- [Link](vanguard_xts, Rf = risk_free_rate)

# Sortino Ratio
sortino_ratio <- SortinoRatio(portfolio_xts, MAR = risk_free_rate)
vanguard_sortino_ratio <- SortinoRatio(vanguard_xts, MAR = risk_free_rate)

# Treynor Ratio
treynor_ratio <- TreynorRatio(portfolio_xts, market_xts, Rf = risk_free_rate)
vanguard_treynor_ratio <- TreynorRatio(vanguard_xts, market_xts, Rf = risk_free_rate)

# Print results
print(paste("Coefficient of Variation Portfolio:", round(cv, 4)))

## [1] "Coefficient of Variation Portfolio: -51.8359"

print(paste("Coefficient of Variation Vanguard:", round(cvVTI, 4)))

## [1] "Coefficient of Variation Vanguard: 5.5738"

print(paste("Sharpe Ratio of Portfolio:", round([Link](sharpe_ratio), 4)))

## [1] "Sharpe Ratio of Portfolio: -0.5572"

print(paste("Sharpe Ratio of Vanguard:", round([Link](vanguard_sharpe_ratio), 4)))

## [1] "Sharpe Ratio of Vanguard: 0.5325"

print(paste("Sortino Ratio of Portfolio:", round([Link](sortino_ratio), 4)))

## [1] "Sortino Ratio of Portfolio: -0.0266"

print(paste("Sortino Ratio of Vanguard:", round([Link](vanguard_sortino_ratio), 4)))

## [1] "Sortino Ratio of Vanguard: 0.2593"

print(paste("Treynor Ratio of Portfolio:", round([Link](treynor_ratio), 4)))

## [1] "Treynor Ratio of Portfolio: 1.2861"

print(paste("Treynor Ratio of Vanguard:", round([Link](vanguard_treynor_ratio), 4)))

## [1] "Treynor Ratio of Vanguard: -0.4119"

#QUESTION-7

# Calculate mean returns

mean_return_monthlyVTI <- mean(rVTI)
mean_return_six_monthsVTI <- mean(rVTI) * 6
mean_return_annualVTI <- mean(rVTI) * 12

14
mean_return_monthly <- mean(portfolio_returns)
mean_return_six_months <- mean(portfolio_returns) * 6
mean_return_annual <- mean(portfolio_returns) * 12

# Calculate VaR at 2%
VaR_2_percent <- quantile(portfolio_returns, 0.02, [Link] = TRUE)
VaR_2_percentVTI <- quantile(rVTI, 0.02, [Link] = TRUE)

# Scale VaR for different horizons

VaR_monthly <- VaR_2_percent
VaR_six_months <- VaR_2_percent * sqrt(6)
VaR_annual <- VaR_2_percent * sqrt(12)

VaR_monthlyVTI <- VaR_2_percentVTI

VaR_six_monthsVTI <- VaR_2_percentVTI * sqrt(6)
VaR_annualVTI <- VaR_2_percentVTI * sqrt(12)

# Print results rounded to 4 decimals

print(paste("Portfolio One Month VaR:", round(VaR_monthly, 4)))

## [1] "Portfolio One Month VaR: -0.7609"

print(paste("Portfolio 6 Month VaR:", round(VaR_six_months, 4)))

## [1] "Portfolio 6 Month VaR: -1.8638"

print(paste("Portfolio 1-year VaR:", round(VaR_annual, 4)))

## [1] "Portfolio 1-year VaR: -2.6358"

print(paste("Vanguard One Month VaR:", round(VaR_monthlyVTI, 4)))

## [1] "Vanguard One Month VaR: -0.0943"

print(paste("Vanguard Six Month VaR:", round(VaR_six_monthsVTI, 4)))

## [1] "Vanguard Six Month VaR: -0.2311"

print(paste("Vanguard 1-year VaR:", round(VaR_annualVTI, 4)))

## [1] "Vanguard 1-year VaR: -0.3268"

#QUESTION-8
portfolio_df <- [Link](portfolio_xts)
market_df <- [Link](market_xts)
dates <- dates[1:nrow(portfolio_df)]
# Scatter diagram for Portfolio Returns over time
plot(dates, portfolio_df$portfolio_xts,
col = 'black',
pch = 16,
main = 'Scatter Diagram of Portfolio Returns Over Time',
xlab = 'Dates',
ylab = 'Portfolio Returns')
abline(h = 0, col = 'red', lty = 2) # Add horizontal line at 0 for reference

15
 Scatter Diagram of Portfolio Returns Over Time
0.4
Portfolio Returns

0.0
−0.4
−0.8

2021 2022 2023 2024

Dates
# Scatter diagram for Portfolio vs. S&P 500 Returns
plot(portfolio_df$portfolio_xts, market_df$market_xts,
col = 'black',
pch = 16,
main = 'Scatter Plot of Portfolio vs. S&P 500 Returns',
xlab = 'Portfolio Returns',
ylab = 'S&P 500 Returns')
abline(lm(market_df$market_xts ~ portfolio_df$portfolio_xts), col = 'red') # Add trend line
legend("topleft", legend = c("Scatter Points", "Trend Line"), col = c('black', 'red'),
pch = c(16, NA), lty = c(NA, 1))

16
 Scatter Plot of Portfolio vs. S&P 500 Returns

Scatter Points
Trend Line
0.05
S&P 500 Returns

0.00
−0.05
−0.10

−0.8 −0.6 −0.4 −0.2 0.0 0.2 0.4 0.6

Portfolio Returns
print(portfolio_returns)

## [1] -0.76271239 0.43849808 0.12660141 -0.13639150 0.41635823 -0.75528360

## [7] 0.44613249 0.07626547 -0.02737007 0.30979331 -0.76043886 0.49684854
## [13] -0.13156536 0.19222913 -0.04924927 -0.71810935 0.56818040 -0.18384750
## [19] 0.29051199 -0.07507604 -0.57188245 0.56926956 -0.08767919 0.16076064
## [25] -0.11161311 -0.50027429 0.61177426 -0.15188907 0.38351053 -0.06060510
## [31] -0.60839372 0.41521187 -0.06825504 0.31010523 0.03165657 -0.61724315
## [37] 0.44899041 0.18240372 -0.09817035 0.20912620 -0.53405577 NA
library(Metrics)

##
## Attaching package: 'Metrics'
## The following object is masked from 'package:smooth':
##
## accuracy
## The following object is masked from 'package:greybox':
##
## accuracy
## The following object is masked from 'package:forecast':
##
## accuracy
# Split data into training and testing sets
train_size <- length(portfolio_returns) - 2
train_set <- [Link](
portfolio_excess_returns = portfolio_excess_returns[1:train_size],
market_excess_returns = market_excess_returns[1:train_size]
)

17
test_set <- [Link](
portfolio_excess_returns = portfolio_excess_returns[(train_size+1):(train_size+2)],
market_excess_returns = market_excess_returns[(train_size+1):(train_size+2)]
)

# Build CAPM model

capm_model <- lm(portfolio_excess_returns ~ market_excess_returns, data = train_set)

# Predict using test data

pred <- predict(capm_model, newdata = test_set)

# Calculate accuracy statistics

mae_post <- mae(test_set$portfolio_excess_returns, pred)
mape_post <- mape(test_set$portfolio_excess_returns, pred)
rmse_post <- rmse(test_set$portfolio_excess_returns, pred)

Results_post <- [Link](

Method = 'EX_POST_F',
MAE = mae_post,
MAPE = mape_post,
RMSE = rmse_post
)
print(Results_post)

## Method MAE MAPE RMSE

## 1 EX_POST_F NA NA NA
# Plot actual vs. forecasted returns
plot(test_set$portfolio_excess_returns, type = "o", col = "red", pch = 16,
xlab = "Test Periods", ylab = "Returns",
main = "Actual vs Forecasted Portfolio Returns")
lines(pred, type = "o", col = "blue", pch = 16)
legend("bottomleft", legend = c("Actual", "Forecasted"), col = c("red", "blue"), pch = 16, lty = 1)

18
 Actual vs Forecasted Portfolio Returns
−0.4
−0.5
Returns

−0.6
−0.7

Actual
Forecasted

1.0 1.2 1.4 1.6 1.8 2.0

Test Periods
# Show CAPM model details
capm_model

##
## Call:
## lm(formula = portfolio_excess_returns ~ market_excess_returns,
## data = train_set)
##
## Coefficients:
## (Intercept) market_excess_returns
## 0.008922 -0.483695
# Predictions with standard error
pred <- predict(capm_model, newdata = test_set, [Link] = TRUE)
print(pred)

## $fit
## 1 2
## -0.00739087 NA
##
## $[Link]
## 1 2
## 0.07350413 NA
##
## $df
## [1] 38
##
## $[Link]
## [1] 0.4130659

19
#QUESTION-10
capm_model <- lm(portfolio_excess_returns ~ market_excess_returns, data = train_set)

# Ex-ante forecasting using predict()

fore <- predict(capm_model, newdata = [Link](market_excess_returns = c(-0.02309905, -0.05082038)))
print(fore)

## 1 2
## 0.02009444 0.03350310
# Plot forecasted values with appropriate labels
plot(1:2, fore, type = "o", col = "blue", pch = 16,
xaxt = "n", # Disable default x-axis
xlab = "Periods", ylab = "Forecasted Portfolio Returns",
main = "Ex-Ante Forecast of Portfolio Returns")
axis(1, at = 1:2, labels = c("2024M7", "2023M8")) # Add custom x-axis labels

Ex−Ante Forecast of Portfolio Returns

0.032
Forecasted Portfolio Returns

0.028
0.024
0.020

2024M7 2023M8

Periods
#QUESTION-11

library(Metrics)
samplestart4 <- [Link]('2020-01-01')
sampleend4 <- [Link]('2024-08-01')

start_date1 = "2017-01-01"
end_date1 = "2024-08-31"

# Define optimal weights

optimal_weight <- c(0.2, 0.2, 0.2, 0.2, 0.2)

# Get stock data

20
AAPL23 <- getSymbols("AAPL", from = start_date1, to = end_date1, periodicity = "monthly", [Link] =
MSFT23 <- getSymbols("MSFT", from = start_date1, to = end_date1, periodicity = "monthly", [Link] =
AMZN23 <- getSymbols("AMZN", from = start_date1, to = end_date1, periodicity = "monthly", [Link] =
JNJ23 <- getSymbols("JNJ", from = start_date1, to = end_date1, periodicity = "monthly", [Link] = FA
WMT23 <- getSymbols("WMT", from = start_date1, to = end_date1, periodicity = "monthly", [Link] = FA

start_date1 <- [Link]("2017-01-01")

end_date1 <- [Link]("2024-08-31")

sampleend4 <- [Link](sampleend4)

start_date <- [Link](start_date1)
monthindex4 <- [Link]((sampleend4 - start_date1) / 30) + 1
skipped4 <- [Link]((samplestart4 - start_date1)/30) + 1

priceAAPL1 <- AAPL23[skipped4:monthindex4, 6]

## Warning in `[.xts`(AAPL23, skipped4:monthindex4, 6): converting 'i' to integer

## because it appears to contain fractions
priceMSFT1 <- MSFT23[skipped4:monthindex4, 6]

## Warning in `[.xts`(MSFT23, skipped4:monthindex4, 6): converting 'i' to integer

## because it appears to contain fractions
priceAMZN1 <- AMZN23[skipped4:monthindex4, 6]

## Warning in `[.xts`(AMZN23, skipped4:monthindex4, 6): converting 'i' to integer

## because it appears to contain fractions
priceJNJ1 <- JNJ23[skipped4:monthindex4, 6]

## Warning in `[.xts`(JNJ23, skipped4:monthindex4, 6): converting 'i' to integer

## because it appears to contain fractions
priceWMT1 <- WMT23[skipped4:monthindex4, 6]

## Warning in `[.xts`(WMT23, skipped4:monthindex4, 6): converting 'i' to integer

## because it appears to contain fractions
indexmat1 <- [Link](priceAAPL1, priceMSFT1, priceAMZN1, priceJNJ1, priceWMT1)

# Portfolio time series

Port4 <- ts(indexmat1 %*% optimal_weight, start = 2020, frequency = 12)

# Naïve Forecast
Lagged <- rwf(Port4, h = 3)
plot(Lagged, ylab = 'Indexed Portfolio')

21
 Forecasts from Random walk
200
Indexed Portfolio

150
100

2020 2021 2022 2023 2024 2025

# Moving Average Forecast
MovAvg <- ma(Port4, order = 15)
plot(Port4, ylab = 'Indexed Portfolio')
lines(MovAvg, col = 'blue')
180
Indexed Portfolio

140
100

2020 2021 2022 2023 2024

Time
# Exponential Smoothing
ESfit1 <- ses(Port4, alpha = 0.2, initial = "simple", h = 3)
ESfit2 <- ses(Port4, alpha = 0.6, initial = "simple", h = 3)
ESfit3 <- ses(Port4, h = 3)

plot(ESfit1, main = "Simple Exponential Smoothing, Portfolio",

22
 fcol = "white", type = "o")
lines(fitted(ESfit1), col = "red", type = "o")
lines(fitted(ESfit2), col = "black", type = "o")
lines(fitted(ESfit3), col = "blue", type = "o")
lines(ESfit1$mean, col = "red", type = "o")
lines(ESfit2$mean, col = "black", type = "o")
lines(ESfit3$mean, col = "blue", type = "o")
legend("topleft", lty = 1, col = c(1, "red", "black", "blue"),
c("data", expression(alpha == 0.2), expression(alpha == 0.6),
expression(alpha == 0.99)), pch = 1)

Simple Exponential Smoothing, Portfolio

220

data
α = 0.2
α = 0.6
α = 0.99
180
140
100

2020 2021 2022 2023 2024 2025

# Calculate accuracy statistics for Moving Average
movavg_actual <- Port4[15:length(Port4)] # Adjust for moving average window
movavg_forecast <- [Link](MovAvg)
mae <- mae(movavg_actual, movavg_forecast)
mse <- mse(movavg_actual, movavg_forecast)
rmse <- sqrt(mse)
mape <- mape(movavg_actual, movavg_forecast)

accuracy_matrix <- matrix(c(MAE = mae, RMSE = rmse, MAPE = mape, MSE = mse),
nrow = 1,
dimnames = list(c(" "),
c("MAE", "RMSE", "MAPE", "SE")))

# Accuracy for Naïve Forecast

naive_actual <- Port4[(length(Port4) - 2):length(Port4)]
naive_forecast <- Lagged$mean
naive_accuracy <- [Link](
MAE = mae(naive_actual, naive_forecast),
RMSE = rmse(naive_actual, naive_forecast),
MAPE = mape(naive_actual, naive_forecast)
)

23
# Print accuracy comparison
print(accuracy_matrix)

## MAE RMSE MAPE SE

## 18.39022 19.87103 0.1105702 394.8578
print(naive_accuracy)

## MAE RMSE MAPE

## 1 1.096769 1.610908 0.00521771
# Detach Metrics package AFTER all calculations
detach("package:Metrics", unload = TRUE)

24