knitr::opts_chunk$set(echo = TRUE,fig.align = "center",fig.height = 8,fig.width = 7,
message = FALSE,dpi = 180,
warning = FALSE)loading the required libraries
library(tidymodels)
library(tidyquant)
library(tidyverse)
library(scales)
library(ggplot2)
library(plotly)
library(timetk)
library(modeltime)
library(slider)
library(frenchdata)
library(correlationfunnel)
library(silgelib)
library(tibbletime)
library(ggplot2)
library(highcharter)
library(htmltools)
library(tidyfit)
library(tidyverse)symbols <- read_rds("Symbols/technology.rds")
symbols## [1] "AAPL" "ADBE" "AMD" "MSFT" "ORCL"
prices <- tq_get(symbols, get = "stock.prices", from = "1990-01-01")
pricesreturns <- prices |>
group_by(symbol) |>
tq_transmute(
select = adjusted,
mutate_fun = periodReturn,
period = "monthly",
col_rename = "returns"
) |>
mutate(date = rollback(date, roll_to_first = TRUE))
returnsreturns |>
ggplot(aes(date,returns, col = symbol)) +
geom_line() +
theme_tq() + scale_color_tq() +
scale_y_continuous(labels = function(x) paste0(x, "%")) +
facet_wrap(~symbol, scales = "free_y") + theme(legend.position = "none") +
labs(title = "Monthly Returns of Selected Technology Stocks",
y = "Returns", x = "")
# Downloading Fama-French data from the Kenneth French site :- Big help
is the library(frenchdata)
# Fama- French 3 Factors
library(frenchdata)
# this code allows to easily impor the three factors data
factors_ff_monthly_raw <- download_french_data("Fama/French 3 Factors")
factors_ff_monthly <- factors_ff_monthly_raw$subsets$data[[1]] |>
transmute(
date = floor_date(ymd(str_c(date,"01")),"month"),
rf = as.numeric(RF) / 100,
mkt_excess = as.numeric(`Mkt-RF`) / 100,
smb = as.numeric(SMB) / 100,
hml = as.numeric(HML) / 100
) %>%
# filter the dates
filter(date >= "1989-12-01")
factors_ff_monthly # so we use the timetk, modeltime and create lags
factors_ff_monthly <- factors_ff_monthly |>
tk_augment_lags(contains("rf"), .lags = 1) |>
tk_augment_lags(contains("mkt_excess"), .lags = 1) |>
tk_augment_lags(contains("smb"), .lags = 1) |>
tk_augment_lags(contains("hml"),.lags = 1) |>
select(-rf,- mkt_excess,- smb,- hml ) |>
mutate_if(is.numeric,replace_na,replace = 0)
# now we can slice the
factors_ff_monthly <- factors_ff_monthly |> slice(-1)
factors_ff_monthly <- factors_ff_monthly |>
rename(rf = rf_lag1, mkt_excess = mkt_excess_lag1, smb = smb_lag1,hml = hml_lag1)
factors_ff_monthlydata <- returns |>
left_join(factors_ff_monthly, by = "date") |>
mutate(excess_returns = returns - rf) |>
select(-returns, -rf)
dataestimate_capm <- function(data, min_obs = 1) {
if (nrow(data) < min_obs) {
regression_coefficients <- tibble(term = c("(Intercept)", "mkt_excess","smb","hml"),
estimate = NA)
} else {
fit <- lm(excess_returns ~ mkt_excess+smb+hml, data = data)
regression_coefficients <- broom::tidy(fit) |> select(term, estimate)
}
return(regression_coefficients)
}
# rolling capm estimation
roll_capm_estimation <- function(data, months, min_obs) {
data <- data |>
arrange(date)
betas <- slide_period(
.x = data,
.i = data$date,
.period = "month",
.f = ~ estimate_capm(., min_obs),
.before = months - 1,
.complete = FALSE
)
return(tibble(
date = unique(data$date),
beta = betas
))
}#Rolling window Beta Estimation:- We estimate the Beta(ß) which is the first logical step for Fama-Macbeth
# now in dplyr 1.1 we have pick() inplace of curl
beta_tbl <- data|>
mutate(roll_capm_estimation(pick(everything()), months = 60, min_obs = 48)) %>%
drop_na() %>%
select(symbol, date, beta) |>
unnest(beta) |>
drop_na()
beta_tbl market_risk_tbl <- data |> select(-mkt_excess,-smb,-hml) |>
left_join(beta_tbl|>
pivot_wider(names_from = term, values_from = estimate) |> select(- '(Intercept)' ), by = c("date","symbol")) |>
drop_na()
market_risk_tbl# Define a list to store the regression models
cross_sectional_models <- list()
library(sandwich)
library(lmtest)
#Loop through each unique stock symbol
for (i in unique(market_risk_tbl$symbol)) {
# Subset the data for the current stock
stock_data <- subset(market_risk_tbl, symbol == i)
# Define the formula for the regression
formula <- formula(paste("excess_returns ~", paste0(names(market_risk_tbl)[4:6], collapse = " + ")))
# Fit the regression model and store it in the list
cross_sectional_models[[i]] <- lm(formula, data = stock_data)
# Compute the Newey-West standard errors
vcov <- NeweyWest(cross_sectional_models[[i]],lag = 12 )
# Compute Newey-West standard errors and print the regression results
cat("\n\nRegression results for", i, "\n")
print(summary(cross_sectional_models[[i]]))
print(coeftest(cross_sectional_models[[i]], vcov. = vcov ))
}##
##
## Regression results for AAPL
##
## Call:
## lm(formula = formula, data = stock_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.56781 -0.06699 -0.00042 0.06843 0.43848
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.034097 0.007516 4.537 7.87e-06 ***
## mkt_excess 0.021207 0.013840 1.532 0.1264
## smb 0.008681 0.012401 0.700 0.4844
## hml 0.028121 0.012499 2.250 0.0251 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1193 on 348 degrees of freedom
## Multiple R-squared: 0.02328, Adjusted R-squared: 0.01486
## F-statistic: 2.765 on 3 and 348 DF, p-value: 0.04189
##
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0340974 0.0065308 5.2210 3.068e-07 ***
## mkt_excess 0.0212074 0.0175689 1.2071 0.22821
## smb 0.0086814 0.0139679 0.6215 0.53466
## hml 0.0281209 0.0118562 2.3718 0.01824 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
##
## Regression results for ADBE
##
## Call:
## lm(formula = formula, data = stock_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.47550 -0.06814 0.00789 0.06443 0.81202
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.022930 0.007988 2.871 0.00435 **
## mkt_excess -0.005437 0.012803 -0.425 0.67133
## smb 0.007877 0.015470 0.509 0.61097
## hml 0.014553 0.010856 1.341 0.18094
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1232 on 348 degrees of freedom
## Multiple R-squared: 0.009428, Adjusted R-squared: 0.0008887
## F-statistic: 1.104 on 3 and 348 DF, p-value: 0.3475
##
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0229298 0.0070769 3.2401 0.00131 **
## mkt_excess -0.0054373 0.0169244 -0.3213 0.74820
## smb 0.0078766 0.0151858 0.5187 0.60431
## hml 0.0145529 0.0113511 1.2821 0.20067
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
##
## Regression results for AMD
##
## Call:
## lm(formula = formula, data = stock_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.4334 -0.1228 -0.0119 0.1097 0.7520
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0259416 0.0106746 2.430 0.0156 *
## mkt_excess -0.0268651 0.0211790 -1.268 0.2055
## smb -0.0008092 0.0120382 -0.067 0.9464
## hml 0.0137566 0.0086048 1.599 0.1108
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.1857 on 348 degrees of freedom
## Multiple R-squared: 0.01223, Adjusted R-squared: 0.003715
## F-statistic: 1.436 on 3 and 348 DF, p-value: 0.232
##
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.02594160 0.01046892 2.4780 0.01369 *
## mkt_excess -0.02686510 0.02346316 -1.1450 0.25300
## smb -0.00080919 0.01039912 -0.0778 0.93802
## hml 0.01375664 0.00666136 2.0651 0.03965 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
##
## Regression results for MSFT
##
## Call:
## lm(formula = formula, data = stock_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.37086 -0.05503 0.00266 0.04616 0.38566
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.016923 0.005581 3.032 0.00261 **
## mkt_excess -0.029049 0.023367 -1.243 0.21463
## smb -0.025970 0.017371 -1.495 0.13582
## hml 0.022986 0.013662 1.682 0.09338 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.08645 on 348 degrees of freedom
## Multiple R-squared: 0.009881, Adjusted R-squared: 0.001345
## F-statistic: 1.158 on 3 and 348 DF, p-value: 0.3259
##
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0169231 0.0045689 3.7039 0.0002468 ***
## mkt_excess -0.0290495 0.0238250 -1.2193 0.2235610
## smb -0.0259697 0.0157251 -1.6515 0.0995430 .
## hml 0.0229861 0.0112009 2.0522 0.0409021 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
##
## Regression results for ORCL
##
## Call:
## lm(formula = formula, data = stock_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.37152 -0.06397 -0.00053 0.05113 0.60321
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.011222 0.009822 1.143 0.254
## mkt_excess 0.010873 0.014441 0.753 0.452
## smb 0.019095 0.017137 1.114 0.266
## hml -0.017803 0.015380 -1.158 0.248
##
## Residual standard error: 0.112 on 348 degrees of freedom
## Multiple R-squared: 0.004948, Adjusted R-squared: -0.00363
## F-statistic: 0.5769 on 3 and 348 DF, p-value: 0.6306
##
##
## t test of coefficients:
##
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.0112218 0.0075912 1.4783 0.1402
## mkt_excess 0.0108734 0.0169422 0.6418 0.5214
## smb 0.0190947 0.0290178 0.6580 0.5110
## hml -0.0178026 0.0266841 -0.6672 0.5051