R/optim_msm.R

In ahoundetoungan/multifractal: Multifractal volatility models

# These functions optimises the likelihood 
# using specified method
#' @importFrom stats nlm
f_opt_nlm <- function(ncparms, fun.lik,  y, p1, kbar, n, NL,  method, leverage) {
  tmp     <- NULL
  parms   <- NULL
  na.p    <- c("m0", "sigma2", "gamma1", "b")
  nstates <- 2^kbar
  g       <- numeric(nstates)
  w       <- rep(0.0, nstates)
  P       <- matrix(0.0, nrow = nstates, ncol = nstates)
  Lt      <- NULL
  
  if (leverage) {
    Lt    <- numeric(n)
    tmp   <- nlm(f = fun.lik[[2]], p = ncparms, y = y, p1 = p1, kbar = kbar, n = n,
                 NL = NL, g = g, w = w, P = P, Lt = Lt, gradtol = 1e-5, steptol = 1e-6)
    parms <- c(ftrans_nc_c_lev(tmp$estimate))
    na.p  <- c(na.p, "l1", "thetaL")
  }
  else{
    tmp   <- nlm(f = fun.lik[[1]], p = ncparms,  y = y, p1 = p1, kbar = kbar, n = n,
                 g = g, w = w, P = P, gradtol = 1e-6, steptol = 1e-6)
    parms <- c(ftrans_nc_c(tmp$estimate))
  }
  
  names(parms) <- na.p
  out     <- list("estimates"      = list("parms"          = parms,
                                          "log.likelihood" = -tmp$minimum,
                                          "g"              = g,
                                          "w"              = w,
                                          "P"              = P),
                  "Lt"             = Lt,
                  "iterations"     = tmp$iterations,
                  "convergence"    = (tmp$code == 1))
  out
}

f_opt_optim <- function(ncparms, fun.lik,  y, p1, kbar, n, NL,  method, leverage) {
  stop("Is not coded")
}

f_opt_solnp <- function(ncparms, fun.lik,  y, p1, kbar, n, NL,  method, leverage) {
  stop("Is not coded")
}


# f_opt_optim <- function(ncparms, fun.lik,  y, p1, kbar, n, NL,  method, leverage) {
#   tmp     <- NULL
#   parms   <- NULL
#   na.p    <- c("m0", "sigma2", "gamma1", "b")
#   nstates <- 2^kbar
#   g       <- numeric(nstates)
#   w       <- numeric(nstates)
#   P       <- matrix(0, nrow = nstates, ncol = nstates)
#   Lt      <- NULL
#   
#   # control
#   op.cont <- list("maxit" = 1e3, "abstol" = 1e-8, "abstol" = 1e-8)
#   
#   # optimization
#   if (leverage) {
#     Lt    <- numeric(n)
#     tmp   <- optim(par = ncparms, fn = fun.lik[[2]], gr = NULL, y = y, p1 = p1, kbar = kbar,
#                    n = n, NL = NL, g = g, w = w, P = P, Lt = Lt, method = method, control = op.cont)
#     parms <- c(ftrans_nc_c_lev(tmp$par))
#     na.p  <- c(na.p, "l1", "thetaL")
#   }
#   else{
#     tmp   <- optim(par = ncparms, fn = fun.lik[[1]], gr = NULL, y = y, p1 = p1, kbar = kbar,
#                    n = n, g = g, w = w, P = P, method = method, control = op.cont)
#     parms <- c(ftrans_nc_c(tmp$par))
#   }
#   
#   names(parms) <- na.p
#   out     <- list("parms"          = parms,
#                   "unc.parms"      = c(tmp$par),
#                   "log.likelihood" = -tmp$value,
#                   "w"              = w,
#                   "P"              = P,
#                   "leverage"       = Lt,
#                   "iterations"     = tmp$counts["function"],
#                   "convergence"    = (tmp$convergence == 0))
#   out
# }
# 
# 
# f_opt_solnp <- function(ncparms, fun.lik,  y, p1, kbar, n, NL,  method, leverage) {
#   tmp     <- NULL
#   parms   <- NULL
#   na.p    <- c("m0", "sigma2", "gamma1", "b")
#   nstates <- 2^kbar
#   g       <- numeric(nstates)
#   w       <- numeric(nstates)
#   P       <- matrix(0, nrow = nstates, ncol = nstates)
#   Lt      <- NULL
#   
#   # control
#   op.cont <- list("outer.iter" = 1e3, "inner.iter" = 2e3, "tol" = 1e-16)
#   
#   if (leverage) {
#     Lt    <- numeric(n)
#     tmp   <- Rsolnp::solnp(pars = ncparms, fun = fun.lik[[2]], y = y, p1 = p1, kbar = kbar,
#                            n = n, NL = NL, g = g,w = w, P = P, Lt = Lt, control = op.cont)
#     parms <- c(ftrans_nc_c_lev(tmp$pars))
#     na.p  <- c(na.p, "l1", "thetaL")
#   }
#   else{
#     tmp   <- Rsolnp::solnp(pars = ncparms, fun = fun.lik[[1]],  y = y, p1 = p1, kbar = kbar,
#                            n = n, g = g, w = w, P = P, control = op.cont)
#     parms <- c(ftrans_nc_c(tmp$pars))
#   }
#   
#   names(parms) <- na.p
#   out     <- list("parms"          = parms,
#                   "unc.parms"      = c(tmp$par),
#                   "log.likelihood" = -tail(tmp$value, 1),
#                   "g"              = g,
#                   "w"              = w,
#                   "P"              = P,
#                   "leverage"       = Lt,
#                   "iterations"     = tmp$nfuneval,
#                   "convergence"    = (tmp$convergence == 0))
#   out
# }