hw01/tsla
erdembileg/112035150
2025-03-11
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
# Load libraries
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.2## Warning: package 'ggplot2' was built under R version 4.3.2## Warning: package 'tidyr' was built under R version 4.3.3## Warning: package 'purrr' was built under R version 4.3.3## Warning: package 'dplyr' was built under R version 4.3.3## Warning: package 'forcats' was built under R version 4.3.2## Warning: package 'lubridate' was built under R version 4.3.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.4 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(quantmod)## Warning: package 'quantmod' was built under R version 4.3.3## Loading required package: xts
## Loading required package: zoo
##
## Attaching package: 'zoo'
##
## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric
##
##
## ######################### 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: 'xts'
##
## The following objects are masked from 'package:dplyr':
##
## first, last
##
## Loading required package: TTR
## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(timetk)## Warning: package 'timetk' was built under R version 4.3.3library(lubridate)
library(broom)
# Define Tesla as the target stock
symbol <- "TSLA"
# Get stock prices from Yahoo Finance
getSymbols(symbol, src = 'yahoo', from = "2010-01-01", auto.assign = TRUE)## [1] "TSLA"tsla_prices <- Ad(TSLA)
# Convert to tibble format
tsla_tibble <- tk_tbl(tsla_prices, rename_index = "date") %>%
mutate(date = as.Date(date))
# Display first few rows
head(tsla_tibble)## # A tibble: 6 × 2
## date TSLA.Adjusted
## <date> <dbl>
## 1 2010-06-29 1.59
## 2 2010-06-30 1.59
## 3 2010-07-01 1.46
## 4 2010-07-02 1.28
## 5 2010-07-06 1.07
## 6 2010-07-07 1.05# Weekly log returns
weekly_prices <- tsla_tibble %>%
group_by(week = floor_date(date, "week")) %>%
summarize(TSLA = last(TSLA))
weekly_returns <- weekly_prices %>%
mutate(TSLA = log(TSLA / lag(TSLA))) %>%
drop_na()
# Monthly log returns
monthly_prices <- tsla_tibble %>%
group_by(month = floor_date(date, "month")) %>%
summarize(TSLA = last(TSLA))
monthly_returns <- monthly_prices %>%
mutate(TSLA = log(TSLA / lag(TSLA))) %>%
drop_na() %>%
rename(date = month)
# Display first few rows
head(monthly_returns)## # A tibble: 6 × 2
## date TSLA[,"TSLA.Open"] [,"TSLA.High"] [,"TSLA.Low"] [,"TSLA.Close"]
## <date> <xts[,1]> <xts[,1]> <xts[,1]> <xts[,1]>
## 1 2010-07-01 0 0 0 0
## 2 2010-08-01 0 0 0 0
## 3 2010-09-01 0 0 0 0
## 4 2010-10-01 0 0 0 0
## 5 2010-11-01 0 0 0 0
## 6 2010-12-01 0 0 0 0
## # ℹ 1 more variable: TSLA[5:6] <xts[,6]># Load Fama/French data
FFdata <- read.csv("https://mba.tuck.dartmouth.edu/pages/faculty/ken.french/ftp/F-F_Research_Data_Factors.CSV", skip = 3)
# Clean and format the data
FFdata <- FFdata %>%
mutate(date = parse_date_time(X, orders = "Y%m", quiet = TRUE)) %>%
filter(!is.na(date)) %>%
select(date, Mkt.RF, SMB, HML, RF) %>%
mutate(across(-date, ~ as.numeric(gsub(" ", "", .)))) %>%
mutate(date = as.Date(date))
# Display first few rows
head(FFdata)## date Mkt.RF SMB HML RF
## 1 1926-07-01 2.96 -2.56 -2.43 0.22
## 2 1926-08-01 2.64 -1.17 3.82 0.25
## 3 1926-09-01 0.36 -1.40 0.13 0.23
## 4 1926-10-01 -3.24 -0.09 0.70 0.32
## 5 1926-11-01 2.53 -0.10 -0.51 0.31
## 6 1926-12-01 2.62 -0.03 -0.05 0.28merged_data <- left_join(monthly_returns, FFdata, by = 'date')
# Display first few rows
head(merged_data)## # A tibble: 6 × 6
## date TSLA[,"TSLA.Open"] [,"TSLA.High"] Mkt.RF SMB HML RF
## <date> <xts[,1]> <xts[,1]> <dbl> <dbl> <dbl> <dbl>
## 1 2010-07-01 0 0 6.93 0.22 -0.33 0.01
## 2 2010-08-01 0 0 -4.77 -2.98 -1.93 0.01
## 3 2010-09-01 0 0 9.54 3.97 -3.18 0.01
## 4 2010-10-01 0 0 3.88 1.19 -2.51 0.01
## 5 2010-11-01 0 0 0.6 3.74 -0.92 0.01
## 6 2010-12-01 0 0 6.82 0.69 3.76 0.01
## # ℹ 1 more variable: TSLA[3:6] <xts[,6]># Extract data for CAPM model (2010-2015)
capm_returns <- merged_data %>%
filter(date >= "2010-02-01" & date <= "2015-01-31") %>%
select(-date, -Mkt.RF, -SMB, -HML, -RF)
# Compute covariance matrix
capm_cov_matrix <- cov(capm_returns)
print(capm_cov_matrix)## TSLA.TSLA.Open TSLA.TSLA.High TSLA.TSLA.Low TSLA.TSLA.Close
## TSLA.TSLA.Open 0 0 0 0
## TSLA.TSLA.High 0 0 0 0
## TSLA.TSLA.Low 0 0 0 0
## TSLA.TSLA.Close 0 0 0 0
## TSLA.TSLA.Volume 0 0 0 0
## TSLA.TSLA.Adjusted 0 0 0 0
## TSLA.TSLA.Volume TSLA.TSLA.Adjusted
## TSLA.TSLA.Open 0 0
## TSLA.TSLA.High 0 0
## TSLA.TSLA.Low 0 0
## TSLA.TSLA.Close 0 0
## TSLA.TSLA.Volume 0 0
## TSLA.TSLA.Adjusted 0 0# Extract data for FF model
ff_returns <- merged_data %>%
filter(date >= "2010-02-01" & date <= "2015-01-31")
# Compute residuals by regressing on FF factors
residuals <- ff_returns %>%
select(TSLA) %>%
map_dfc(~ residuals(lm(. ~ Mkt.RF + SMB + HML, data = ff_returns)))
# Compute covariance matrix of residuals
ff_cov_matrix <- cov(residuals)
print(ff_cov_matrix)## TSLA.TSLA.Open TSLA.TSLA.High TSLA.TSLA.Low TSLA.TSLA.Close
## TSLA.TSLA.Open 0 0 0 0
## TSLA.TSLA.High 0 0 0 0
## TSLA.TSLA.Low 0 0 0 0
## TSLA.TSLA.Close 0 0 0 0
## TSLA.TSLA.Volume 0 0 0 0
## TSLA.TSLA.Adjusted 0 0 0 0
## TSLA.TSLA.Volume TSLA.TSLA.Adjusted
## TSLA.TSLA.Open 0 0
## TSLA.TSLA.High 0 0
## TSLA.TSLA.Low 0 0
## TSLA.TSLA.Close 0 0
## TSLA.TSLA.Volume 0 0
## TSLA.TSLA.Adjusted 0 0compute_gmv_weights <- function(cov_matrix) {
inv_cov <- solve(cov_matrix)
ones <- rep(1, nrow(inv_cov))
weights <- inv_cov %*% ones / sum(inv_cov %*% ones)
return(weights)
}
# Compute weights
compute_gmv_weights <- function(cov_matrix) {
inv_cov <- solve(cov_matrix)
ones <- rep(1, nrow(inv_cov))
weights <- inv_cov %*% ones / sum(inv_cov %*% ones)
return(weights)
}
# Compute weightsIncluding Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.