R/fun_getLmStats.R

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

#' fun_getLmStats
#'
#' @param df Dataframe with daily prices, mean, sd, reVol and lagged reVol one want to use as regressors
#' @param period Period one want to have the lagged date
#' @param sign If one want to regress on sign og value of lagged values
#' @param name Name of object
#' @param tablePeriods Periods one want to have in output table. This is also the range of the lagged plot
#' @param savePlot If one want to save plot
#' @param outputFig Output path if one have said TRUE to saveplot
#' @param width Width of plot saved
#' @param height heigh of plot saved
#'
#' @return A list
#'  \item{name table}{description Table of statistics for coefficients for regressors}
#'  \item{name tvalues}{description Table only with t-values}
#'  \item{name plotAlpha}{description plot of alpha's (intercepts) t-statistics}
#'  \item{name xtable}{description table but on the form which can be put directly into Latex}
#' @export
#'
fun_getLmStats <- function(df, period = "months", sign = TRUE, name = NULL,
                           tablePeriods = c(1, 3, 6, 9, 12),
                           savePlot = FALSE,
                           outputFig = c("C:/Users/Soren Schwartz/Dropbox/Egne dokumenter/Skole/master/opgave/Figures/"),
                           width = 8, height = 6) {

  period.df <- fun_toPeriodCl(df = df, period = period)

  periods <- seq(range(tablePeriods)[1], range(tablePeriods)[2], 1)

  if(sign == FALSE) {
    reName <- "reVolLag"
    ggName <- NULL
    pdfName <- NULL
  } else {
    reName <- "reSingLag"
    ggName <- " (sign)"
    pdfName <- "sign"
  }

  outName <- paste0(outputFig, name, period, "AlphaStats", pdfName, ".pdf")
  if(!is.null(name)) {name = paste("\n", name)}

  tables <- list()
  tvalues <- list()

  for(i in 1:length(periods)){
    period.dfLag <- fun_GetVolAdReturn(period.df, lag = periods[i])
    rowInd <- unique(which(is.na(period.dfLag) | is.infinite(period.dfLag), arr.ind = TRUE)[,1])
    if(length(rowInd) != 0 ) {
      period.dfLag <- period.dfLag[-rowInd, ]
    }
    model <- fun_lm(dependent = "reVol", regressors = c(paste0(reName, periods[i])),
                    data = period.dfLag)
    if(periods[i] %in% tablePeriods) {tables[[periods[i]]] <- model$tableStat}
    tvalues[[i]] <- model$tableStat[,"t value", drop = F]
  }

  tables <- tables[tablePeriods]
  names(tables) <- paste("Lag", tablePeriods)
  out.table <- do.call(dplyr::bind_rows, lapply(tables, function(x){
    as.data.frame(cbind(LookbackPeriod = c(stringr::str_match(rownames(x)[2],
                                                              "(?<=Lag).+"),
                                           rep("",nrow(x)-1)),
                        Parameter = rownames(x),
                        x), row.names = FALSE)
  }))
  colnames(out.table) <- c(paste0("Lookback period (", period,")"),
                           colnames(out.table)[-1])

  tvalues <- do.call(dplyr::bind_rows, lapply(tvalues, function(x) {
    data.frame(x, Param = c("alpha", paste0("beta_",
                                            seq(1, nrow(x)-1, by = 1))),
               Lag = rep(as.numeric(stringr::str_match(rownames(x)[-1], "(?<=Lag)[:digit:]+")), nrow(x)),
               row.names = NULL)
  }))
  plotAlpha <- ggplot2::ggplot(tvalues %>%
                                 dplyr::filter(Param == "alpha") %>%
                                 dplyr::select(t.value, Lag),
                               ggplot2::aes (x = Lag, y = forcats::fct_relevel(t.value))) +
    ggplot2::geom_bar(stat ="identity") +
    ggplot2::scale_x_discrete(name = bquote(paste(.(period), " lag - ", alpha, .(ggName))),
                              limits = as.character(periods)) +
    ggplot2::scale_y_discrete(name = "t-statistics") +
    ggplot2::ggtitle(paste("t-statistic by", period, name)) +
    ggplot2::theme(plot.title = ggplot2::element_text(size=12, hjust = 0.5))

  if(savePlot == TRUE) {
    pdf(file = outName,
        width = width, height = height)
    print(plotAlpha)
    dev.off()
  }

  out <- list(table = out.table,
              tvalues = tvalues,
              plotAlpha = plotAlpha,
              xtable = xtable::xtable(out.table))
  return(out)
}