R/get_log_like.R

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

#' get_log_like
#'
#' @param prices List with prices one want to get copula log-likelihod of
#' @param type Exchangeable or unstructured elliptical copula
#'
#' @return List with loglikelihood and if exchangeable, then estimated rho
#' @export
#'
get_log_like <- function(prices, type = c("ex", "un")) {

  out <- matrix(ncol = 4, nrow = length(prices))
  if (type == "ex") {
    rho_matrix <- matrix(ncol = 4, nrow = length(prices))
  }

  for (i in 1:length(prices)) {
    U <- as.matrix((pobs(prices[[i]])))
    fit.N <- fitCopula(normalCopula(dim = dim(U)[2], dispstr = type),  data = U)
    fit.t <- fitCopula(tCopula(dim = dim(U)[2], dispstr = type),       data = U) # df of freedom are estimated, too
    fit.C <- fitCopula(claytonCopula(dim = dim(U)[2]), data = U)
    fit.G <- fitCopula(gumbelCopula(dim = dim(U)[2]),  data = U)
    out[i, ] <- c(N = fit.N@loglik, t = fit.t@loglik, C = fit.C@loglik, G = fit.G@loglik)

    if (type == "ex") {
      rho_matrix[i, ] <- c((2/pi) * asin(fit.N@estimate), (2/pi) * asin(fit.t@estimate[1]),
                           fit.C@estimate / (fit.C@estimate + 2), (fit.G@estimate - 1) / fit.G@estimate)
    }
  }
  colnames(out) <- c("N", "t", "C", "G")
  rownames(out) <- names(prices)
  if (type == "ex") {
    colnames(rho_matrix) <- c("N", "t", "C", "G")
    rownames(rho_matrix) <- names(prices)
  }

  if (type == "ex") {
    return(list(
      log_like = out,
      rho = rho_matrix))
  } else {
    return(list(
      log_like = out))
  }
}