R/fun_tstats_allModels_v2.R

In 3schwartz/SpecialeScrAndFun: Script and functions used for master thesis.

#' fun_tstats_allModels_v2
#'
#' @description For each of the element in list a linear regression is made with the element in the list as independent variables.
#' A table of t-statistics is return and the maximum VIF value within each model
#'
#' @param list List of daily data excess, excess vol adjusted and sigma
#' @param period character vector Period of rebalance
#' @param lag int Number of lags
#'
#' @return A list
#'  \item{name name}{description Name n which one can se periodicity and lag of object}
#'  \item{name Sharpe}{description Table of t-statistics is return and the maximum VIF value within each model}
#' @export
#'
fun_tstats_allModels_v2 <- function(inputList = listExcess,
                                 period = c("days", "weeks", "months", "quarters", "years"),
                                 lag = 6){

  inputList <- inputList[[period]]

  if(!is.null(inputList[["Cum"]])){
    inputList <- inputList[-which(names(inputList) == "Cum")]
  }

  PeriodAndLags <- lapply(inputList, function(x) {
    fun_Lag_df(x, lag = lag)
  })

  LMIndex <- dplyr::intersect(zoo::index(PeriodAndLags[[1]]),
                              zoo::index(PeriodAndLags[[2]])) %>%
    dplyr::intersect(zoo::index(PeriodAndLags[[3]])) %>%
    dplyr::intersect(zoo::index(PeriodAndLags[[4]])) %>%
    lubridate::as_date()

  tlist <- list()

  for(i in 1:length(inputList)) {
    dependent <- names(inputList)[i]
    independent <- names(inputList)[-i]

    LMdata <- cbind(PeriodAndLags[[dependent]][LMIndex,"exReVol"],
                    do.call(cbind, lapply(PeriodAndLags[independent],
                                          function(x) {
      x[LMIndex,paste0("exReVol_lag", lag)]
    })))

    LMdata <- LMdata[-unique(which((is.infinite(LMdata) | is.na(LMdata)), arr.ind = TRUE)[,1]),]
    colnames(LMdata) <- c(dependent, independent)
    formel <- paste(dependent, "~", paste(independent, collapse = " + "))

    model <- lm(formel, data = as.data.frame(LMdata))

    tstats <- summary(model)$coef[,c("t value"),drop = F] %>%
      t()
    colnames(tstats)[1] <- "alpha"
    row.names(tstats) <- dependent
    tstats <- cbind(tstats, VIFmax = max(car::vif(model))) %>%
      round(digits = 2)
    tlist[[i]] <- tstats
  }

  lm_tstats <- do.call(dplyr::bind_rows, lapply(tlist, function(x) {
    data.frame(cbind(Dep = rownames(x), x))
  }))

  lm_tstats[is.na(lm_tstats)] <- ""

  lm_tstats <- cbind(lm_tstats[,-which(names(lm_tstats) == "VIFmax")],
                     VIFmax = lm_tstats[,c("VIFmax")])
  nameOut <- paste0("tstats-",period,"-",lag)

  out <- list(name = nameOut,
              tstats = lm_tstats)
  return(out)
}