knitr::opts_chunk$set(echo = TRUE,fig.align = "center",fig.height = 8,fig.width = 7,
                        message = FALSE,dpi = 360,
                      warning = FALSE)
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)

Communication Sector Stocks

symbols <- read_rds("/Users/mandarphatak/Desktop/Portfolio_Analysis/Symbols/communications.rds")

prices <- tq_get(symbols,get = "stock.prices", from = "1990-01-01")

communication <- prices |> 
    group_by(symbol) |> 
    tq_transmute(
        select = adjusted,
        mutate_fun = periodReturn,
        period     = "monthly",
        col_rename = "returns"
    ) |> 
    mutate(date = rollback(date, roll_to_first = TRUE))

1 Visualization of data

communication |> 
    ggplot(aes(date,returns,col = symbol)) +
    geom_line(linetype = 1) +
    facet_wrap(~symbol, scales = "free")

# Fama French Data

library(frenchdata)
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

Why we took 1989-12-01 as we need to use the past values to combine with the communications and as so that we don’t want to have forward looking bias*. Now the issue we face is that how to combine the data. In excel we can do it manually.

 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)

2 combining the fama-french factors with the communications

combined_data <- communication |> 
    left_join(factors_ff_monthly, by = "date")
market_risk_data <- combined_data |> 
    mutate(excess_returns = returns - rf) |> 
    select(symbol,date,excess_returns:mkt_excess)
market_risk_data

3 Rolling Function

library(slider)
# estimate capm
estimate_capm <- function(data, min_obs = 1) {
  if (nrow(data) < min_obs) {
    beta <- as.numeric(NA)
  } else {
    fit <- lm(excess_returns ~ mkt_excess + smb+hml, data = data)
    beta <- as.numeric(fit$coefficients[2])
  }
  return(beta)
}
# rolling capm estimation
roll_capm_estimation <- function(data, months, min_obs) {
  data <- bind_rows(data) |>
    arrange(date)

  betas <- slide_period_vec(
    .x = data,
    .i = data$date,
    .period = "month",
    .f = ~estimate_capm(., min_obs),
    .before = months - 1,
    .complete = FALSE
  )

  tibble(
    month = unique(data$date),
    beta = betas
  )
}
# now in dplyr 1.1 we have pick() inplace of curl
beta_tbl <- market_risk_data |> 
 mutate(roll_capm_estimation(pick(everything()), months = 60, min_obs = 48)) %>%
    drop_na() %>%
    select(symbol, date, beta) |> 
    drop_na()

4 Visualizing the Beta

beta_tbl |> 
    ggplot(aes(date,beta,col = symbol ))+
    geom_line() + theme_tq() + scale_color_tq()