Running 'testthat.R' [4s/5s]
Running the tests in 'tests/testthat.R' failed.
Complete output:
  > library(testthat)
  > library(mfGARCH)
  > 
  > test_check("mfGARCH")
  [1] "For ensuring numerical stability of the parameter optimization and inversion of the Hessian, it is best to multiply log returns by 100."
  [1] "No frequency specified for calculating the variance ratio - default: low.freq = date"
   ----------- FAILURE REPORT -------------- 
   --- failure: the condition has length > 1 ---
   --- srcref --- 
  : 
   --- package (from environment) --- 
  mfGARCH
   --- call from context --- 
  fit_mfgarch(data = df_financial, y = "return", K = 0)
   --- call from argument --- 
  if (class(inv_hessian) == "try-error") {
      warning("Inverting the OPG matrix failed. No OPG standard errors calculated.")
      opg.std.err <- NA
  }
   --- R stacktrace ---
  where 1: fit_mfgarch(data = df_financial, y = "return", K = 0)
  where 2: eval_bare(quo_get_expr(.quo), quo_get_env(.quo))
  where 3: withCallingHandlers(code, warning = function(condition) {
      out$push(condition)
      maybe_restart("muffleWarning")
  })
  where 4: .capture(act$val <- eval_bare(quo_get_expr(.quo), quo_get_env(.quo)), 
      ...)
  where 5: quasi_capture(enquo(object), label, capture_warnings)
  where 6 at testthat/test-estimation.R#2: expect_warning(mgarch_0 <- fit_mfgarch(data = df_financial, y = "return", 
      K = 0)$par)
  where 7: eval(code, test_env)
  where 8: eval(code, test_env)
  where 9: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 10: doTryCatch(return(expr), name, parentenv, handler)
  where 11: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 12: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 13: doTryCatch(return(expr), name, parentenv, handler)
  where 14: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 15: tryCatchList(expr, classes, parentenv, handlers)
  where 16: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 17: test_code(desc, code, env = parent.frame())
  where 18 at testthat/test-estimation.R#1: test_that("Estimation K = 0", {
      expect_warning(mgarch_0 <- fit_mfgarch(data = df_financial, 
          y = "return", K = 0)$par)
      expect_warning(mgarch_0 <- fit_mfgarch(data = df_financial, 
          y = "return", gamma = FALSE, K = 0)$par)
  })
  where 19: eval(code, test_env)
  where 20: eval(code, test_env)
  where 21: withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error)
  where 22: doTryCatch(return(expr), name, parentenv, handler)
  where 23: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  where 24: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
  where 25: doTryCatch(return(expr), name, parentenv, handler)
  where 26: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
      names[nh], parentenv, handlers[[nh]])
  where 27: tryCatchList(expr, classes, parentenv, handlers)
  where 28: tryCatch(withCallingHandlers({
      eval(code, test_env)
      if (!handled && !is.null(test)) {
          skip_empty()
      }
  }, expectation = handle_expectation, skip = handle_skip, warning = handle_warning, 
      message = handle_message, error = handle_error), error = handle_fatal, 
      skip = function(e) {
      })
  where 29: test_code(NULL, exprs, env)
  where 30: source_file(path, new.env(parent = env), chdir = TRUE, wrap = wrap)
  where 31: force(code)
  where 32: doWithOneRestart(return(expr), restart)
  where 33: withOneRestart(expr, restarts[[1L]])
  where 34: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 35: with_reporter(reporter = reporter, start_end_reporter = start_end_reporter, 
      {
          reporter$start_file(basename(path))
          lister$start_file(basename(path))
          source_file(path, new.env(parent = env), chdir = TRUE, 
              wrap = wrap)
          reporter$.end_context()
          reporter$end_file()
      })
  where 36: FUN(X[[i]], ...)
  where 37: lapply(paths, test_file, env = env, reporter = current_reporter, 
      start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
  where 38: force(code)
  where 39: doWithOneRestart(return(expr), restart)
  where 40: withOneRestart(expr, restarts[[1L]])
  where 41: withRestarts(testthat_abort_reporter = function() NULL, force(code))
  where 42: with_reporter(reporter = current_reporter, results <- lapply(paths, 
      test_file, env = env, reporter = current_reporter, start_end_reporter = FALSE, 
      load_helpers = FALSE, wrap = wrap))
  where 43: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 44: test_dir(path = test_path, reporter = reporter, env = env, filter = filter, 
      ..., stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
      wrap = wrap)
  where 45: test_package_dir(package = package, test_path = test_path, filter = filter, 
      reporter = reporter, ..., stop_on_failure = stop_on_failure, 
      stop_on_warning = stop_on_warning, wrap = wrap)
  where 46: test_check("mfGARCH")
  
   --- value of length: 2 type: logical ---
  [1] FALSE FALSE
   --- function from context --- 
  function (data, y, x = NULL, K = NULL, low.freq = "date", var.ratio.freq = NULL, 
      gamma = TRUE, weighting = "beta.restricted", x.two = NULL, 
      K.two = NULL, low.freq.two = NULL, weighting.two = NULL, 
      multi.start = FALSE, control = list(par.start = NULL)) 
  {
      print("For ensuring numerical stability of the parameter optimization and inversion of the Hessian, it is best to multiply log returns by 100.")
      if (is.null(weighting.two) == FALSE) {
          if (weighting.two != "beta.restricted") {
              stop("Right now, only beta.restricted weighting scheme is employed for the second covariate.")
          }
      }
      if (is.null(x.two) == FALSE) {
          weighting.two <- "beta.restricted"
      }
      if (is.null(x.two) == FALSE && gamma == FALSE) {
          stop("Regarding two covariates, only asymmetric GJR-GARCH component is implemented.")
      }
      if (is.null(K.two) == FALSE) {
          if (K == 1 & K.two > 1) {
              stop("Regarding two covariates with one of them being equal to one, only K.two = 1 is implemented.")
          }
      }
      if (is.null(x.two) == FALSE) {
          print("Specifying two covariates may lead to long estimation times.")
      }
      if (weighting %in% c("beta.restricted", "beta.unrestricted") == 
          FALSE) {
          stop("Incorrect weighting scheme specified - options are \"beta.restricted\" and \"beta.unrestricted\".")
      }
      if (gamma %in% c(TRUE, FALSE) == FALSE) {
          stop("Gamma can't be anything different than TRUE or FALSE.")
      }
      if ("date" %in% colnames(data) == FALSE) {
          stop("No date column.")
      }
      if (inherits(data$date, "Date") == FALSE) {
          stop(paste0("Supplied date column is not of format 'Date'. It is of class '", 
              class(data$date), "'."))
      }
      if (inherits(data[[low.freq]], "Date") == FALSE) {
          stop(paste0("Supplied low.freq column is not of format 'Date'. It is of class '", 
              class(data[[low.freq]]), "'."))
      }
      if (is.null(x) == FALSE && K == 0) {
          warning("You specified an external covariate x but chose K = 0 - simple GARCH is estimated (K = 0).")
      }
      if (is.null(x) == TRUE) {
          warning("No external covariate x is specified - simple GARCH is estimated (K = 0).")
          x <- "date"
          K <- 0
      }
      if (is.null(K) == TRUE) {
          warning("No K is specified - simple GARCH is estimated (K = 0).")
          x <- "date"
          K <- 0
      }
      if (K < 0 || K%%1 != 0) {
          stop("K can't be smaller than 0 and has to be an integer.")
      }
      if (dim(unique(data[c(x, low.freq)]))[1] > dim(unique(data[c(low.freq)]))[1]) {
          stop("There is more than one unique observation per low frequency entry.")
      }
      if (y %in% colnames(data) == FALSE) {
          stop(paste("There is no variable in your data frame with name ", 
              y, "."))
      }
      if (x %in% colnames(data) == FALSE && is.null(x) != FALSE) {
          stop(paste("There is no variable in your data frame with name ", 
              x, "."))
      }
      if (low.freq %in% colnames(data) == FALSE) {
          stop(paste("There is no low freq. variable in your data frame with name ", 
              low.freq, "."))
      }
      if ("tau" %in% colnames(data) == TRUE) {
          stop("There may not be a column named tau - it will be part of df.fitted")
      }
      if ("g" %in% colnames(data) == TRUE) {
          stop("There may not be a column named g - it will be part of df.fitted")
      }
      if (is.null(x) == TRUE) {
          if (sum(is.na(data[[y]]) == TRUE) > 0) {
              stop(paste0("Column ", y, "contains NAs."))
          }
      }
      else {
          if (sum(is.na(data[[y]]) == TRUE) > 0 | sum(is.na(data[[x]]) == 
              TRUE) > 0) {
              stop(paste0("Either column ", y, " or column ", x, 
                  "includes NAs."))
          }
      }
      if (length(unlist(unique(data[["date"]]))) != dim(data)[1]) {
          stop("There is more than one observation per high frequency (presumably date).")
      }
      if (is.null(var.ratio.freq) == FALSE) {
          if (var.ratio.freq %in% colnames(data) == FALSE) {
              stop(paste0("There is no var.ratio.freq column with name ", 
                  var.ratio.freq, "."))
          }
      }
      data <- data[order(data$date), ]
      date_backup <- data[["date"]]
      data["date"] <- as.numeric(unlist(data["date"]))
      if (is.null(var.ratio.freq) == TRUE) {
          var.ratio.freq <- low.freq
          print(paste0("No frequency specified for calculating the variance ratio - default: low.freq = ", 
              low.freq))
      }
      low_freq_backup <- data[, low.freq]
      if (x != "date") {
          if (is.null(x.two) == TRUE) {
              df_llh <- data[, c(y, x, low.freq)]
              df_llh[, low.freq] <- as.integer(unlist(df_llh[, 
                  low.freq]))
          }
          else {
              low_freq.two_backup <- data[, low.freq.two]
              if (low.freq != low.freq.two) {
                  df_llh <- data[, c(y, x, low.freq, x.two, low.freq.two)]
                  df_llh[, low.freq] <- as.integer(unlist(df_llh[, 
                    low.freq]))
                  df_llh[, low.freq.two] <- as.integer(unlist(df_llh[, 
                    low.freq.two]))
              }
              else {
                  df_llh <- data[, c(y, x, low.freq, x.two)]
                  df_llh[, low.freq] <- as.integer(unlist(df_llh[, 
                    low.freq]))
              }
          }
      }
      g_zero <- var(unlist(data[[y]]))
      ret <- data[[y]]
      if (K == 0) {
          if (gamma == TRUE) {
              lf <- function(p) {
                  llh_simple(y = ret, mu = p["mu"], alpha = p["alpha"], 
                    beta = p["beta"], gamma = p["gamma"], m = p["m"], 
                    g_zero = g_zero)
              }
              par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                  gamma = 0.04, m = 0)
              ui.opt <- rbind(c(0, -1, -1, -1/2, 0), c(0, 1, 0, 
                  0, 0), c(0, 0, 1, 0, 0))
              ci.opt <- c(-0.99999, 0, 0)
          }
          else {
              lf <- function(p) {
                  llh_simple(y = ret, mu = p["mu"], alpha = p["alpha"], 
                    beta = p["beta"], gamma = 0, m = p["m"], g_zero = g_zero)
              }
              par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                  m = 0)
              ui.opt <- rbind(c(0, -1, -1, 0), c(0, 1, 0, 0), c(0, 
                  0, 1, 0))
              ci.opt <- c(-0.99999, 0, 0)
          }
          if (is.null(control$par.start) == FALSE) {
              par.start <- control$par.start
          }
          p.e.nlminb <- constrOptim(theta = par.start, f = function(theta) {
              sum(lf(theta))
          }, grad = NULL, ui = ui.opt, ci = ci.opt, hessian = FALSE)
          if (multi.start == TRUE && gamma == TRUE) {
              p.e.nlminb.two <- try({
                  suppressWarnings(optim(par = p.e.nlminb$par, 
                    fn = function(theta) {
                      if (is.na(sum(lf(theta))) == TRUE) {
                        NA
                      }
                      else {
                        sum(lf(theta))
                      }
                    }, method = "BFGS"))
              }, silent = TRUE)
              if (class(p.e.nlminb.two) == "try-error") {
                  print("Second-step BFGS optimization failed. Fallback: First-stage Nelder-Mead estimate.")
              }
              else {
                  if (p.e.nlminb.two$value < p.e.nlminb$value) {
                    p.e.nlminb <- p.e.nlminb.two
                  }
              }
          }
          p.e.nlminb$value <- -p.e.nlminb$value
          par <- p.e.nlminb$par
          returns <- as.numeric(unlist(data[[y]]))
          tau <- rep(exp(par["m"]), times = length(returns))
          if (gamma == TRUE) {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"] - 
                    par["gamma"]/2, alpha = par["alpha"], beta = par["beta"], 
                    gamma = par["gamma"], as.numeric(na.exclude((returns - 
                      par["mu"])/sqrt(tau))), g0 = g_zero))
              tau <- rep(exp(par["m"]), times = length(g))
          }
          else {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"], 
                    alpha = par["alpha"], beta = par["beta"], gamma = 0, 
                    as.numeric(na.exclude((returns - par["mu"])/sqrt(tau))), 
                    g0 = g_zero))
              tau <- rep(exp(par["m"]), times = length(g))
          }
          if ((var.ratio.freq %in% c("date", "low.freq")) == FALSE) {
              df.fitted <- cbind(data[c("date", y, var.ratio.freq)], 
                  g = g, tau = tau)
          }
          else {
              df.fitted <- cbind(data[c("date", y)], g = g, tau = tau)
          }
          df.fitted$residuals <- unlist((df.fitted[y] - par["mu"])/sqrt(df.fitted$g * 
              df.fitted$tau))
      }
      else {
          covariate <- unlist(unique(data[c(low.freq, x)])[x])
          if (is.null(x.two) == FALSE) {
              covariate.two <- unlist(unique(data[c(low.freq.two, 
                  x.two)])[x.two])
          }
      }
      if (K == 1) {
          if (is.null(K.two) == FALSE) {
              if (gamma == TRUE) {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"] - p["gamma"]/2, 
                      alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                      m = p["m"], theta = p["theta"], w1 = 1, w2 = 1, 
                      g_zero = g_zero, K = K, x.two = covariate.two, 
                      K.two = K.two, low.freq.two = low.freq.two, 
                      theta.two = p["theta.two"], w1.two = 1, w2.two = 1)
                  }
                  par_start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    gamma = 0.04, m = 0, theta = 0, theta.two = 0)
                  ui_opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 0), 
                    c(0, 1, 0, 0, 0, 0, 0), c(0, 0, 1, 0, 0, 0, 
                      0))
                  ci_opt <- c(-0.99999, 0, 0)
              }
              else {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"], alpha = p["alpha"], 
                      beta = p["beta"], gamma = 0, m = p["m"], 
                      theta = p["theta"], w1 = 1, w2 = 1, g_zero = g_zero, 
                      K = K, x.two = covariate.two, K.two = K.two, 
                      low.freq.two = low.freq.two, theta.two = p["theta.two"], 
                      w1.two = 1, w2.two = 1)
                  }
                  par_start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    m = 0, theta = 0, theta.two = 0)
                  ui_opt <- rbind(c(0, -1, -1, 0, 0, 0), c(0, 1, 
                    0, 0, 0, 0), c(0, 0, 1, 0, 0, 0))
                  ci_opt <- c(-0.99999, 0, 0)
              }
          }
          else {
              if (gamma == TRUE) {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"] - p["gamma"]/2, 
                      alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                      m = p["m"], theta = p["theta"], w1 = 1, w2 = 1, 
                      g_zero = g_zero, K = K)
                  }
                  par_start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    gamma = 0.04, m = 0, theta = 0)
                  ui_opt <- rbind(c(0, -1, -1, -1/2, 0, 0), c(0, 
                    1, 0, 0, 0, 0), c(0, 0, 1, 0, 0, 0))
                  ci_opt <- c(-0.99999, 0, 0)
              }
              else {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"], alpha = p["alpha"], 
                      beta = p["beta"], gamma = 0, m = p["m"], 
                      theta = p["theta"], w1 = 1, w2 = 1, g_zero = g_zero, 
                      K = K)
                  }
                  par_start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    m = 0, theta = 0)
                  ui_opt <- rbind(c(0, -1, -1, 0, 0), c(0, 1, 0, 
                    0, 0), c(0, 0, 1, 0, 0))
                  ci_opt <- c(-0.99999, 0, 0)
              }
          }
          if (is.null(control$par.start) == FALSE) {
              par.start <- control$par.start
          }
          p.e.nlminb <- constrOptim(theta = par_start, f = function(theta) {
              sum(lf(theta))
          }, grad = NULL, ui = ui_opt, ci = ci_opt, hessian = FALSE)
          par <- p.e.nlminb$par
          p.e.nlminb$value <- -p.e.nlminb$value
          if (is.null(x.two) == FALSE) {
              tau <- calculate_tau_mf(df = data, x = covariate, 
                  low.freq = low.freq, w1 = 1, w2 = 1, theta = par["theta"], 
                  m = par["m"], K = K, x.two = covariate.two, K.two = K.two, 
                  theta.two = par["theta.two"], low.freq.two = low.freq.two, 
                  w1.two = 1, w2.two = 1)$tau
          }
          else {
              tau <- calculate_tau_mf(df = data, x = covariate, 
                  low.freq = low.freq, theta = par["theta"], m = par["m"], 
                  w1 = 1, w2 = 1, K = K)$tau
          }
          tau_forecast <- exp(sum_tau_fcts(m = par["m"], i = K + 
              1, theta = par["theta"], phivar = calculate_phi(w1 = 1, 
              w2 = 1, K = K), covariate = c(tail(unlist(unique(data[c(x, 
              low.freq)])[x]), K), NA), K = K))
          if (is.null(x.two) == FALSE) {
              tau_forecast <- tau_forecast * exp(sum_tau_fcts(m = 0, 
                  i = K.two + 1, theta = par["theta.two"], phivar = calculate_phi(w1 = 1, 
                    w2 = 1, K = K.two), covariate = c(tail(unlist(unique(data[c(x.two, 
                    low.freq.two)])[x.two]), K.two), NA), K = K.two))
          }
          returns <- unlist(data[y])
          if (gamma == TRUE) {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"] - 
                    par["gamma"]/2, alpha = par["alpha"], beta = par["beta"], 
                    gamma = par["gamma"], as.numeric(na.exclude((returns - 
                      par["mu"])/sqrt(tau))), g0 = g_zero))
          }
          else {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"], 
                    alpha = par["alpha"], beta = par["beta"], gamma = 0, 
                    as.numeric(na.exclude((returns - par["mu"])/sqrt(tau))), 
                    g0 = g_zero))
          }
          if ((var.ratio.freq %in% c("date", "low.freq")) == FALSE) {
              df.fitted <- cbind(data[c("date", y, low.freq, x, 
                  var.ratio.freq)], g = g, tau = tau)
          }
          else {
              df.fitted <- cbind(data[c("date", y, low.freq, x)], 
                  g = g, tau = tau)
          }
          df.fitted$residuals <- unlist((df.fitted[y] - par["mu"])/sqrt(df.fitted$g * 
              df.fitted$tau))
      }
      if (K > 1) {
          if (gamma == TRUE) {
              if (weighting == "beta.restricted" & is.null(K.two) == 
                  TRUE) {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"] - p["gamma"]/2, 
                      alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                      m = p["m"], theta = p["theta"], w1 = 1, w2 = p["w2"], 
                      g_zero = g_zero, K = K)
                  }
                  par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    gamma = 0.04, m = 0, theta = 0, w2 = 3)
                  ui.opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 0), 
                    c(0, 0, 0, 0, 0, 0, 1), c(0, 1, 0, 0, 0, 0, 
                      0), c(0, 0, 1, 0, 0, 0, 0))
                  ci.opt <- c(-0.99999999, 1, 0, 0)
              }
              if (weighting == "beta.restricted" & is.null(K.two) == 
                  FALSE) {
                  if (K.two == 1) {
                    lf <- function(p) {
                      llh_mf(df = df_llh, y = ret, x = covariate, 
                        low.freq = low.freq, mu = p["mu"], omega = 1 - 
                          p["alpha"] - p["beta"] - p["gamma"]/2, 
                        alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                        m = p["m"], theta = p["theta"], w1 = 1, 
                        w2 = p["w2"], g_zero = g_zero, K = K, x.two = covariate.two, 
                        K.two = 1, low.freq.two = low.freq.two, 
                        theta.two = p["theta.two"], w1.two = 1, 
                        w2.two = 1)
                    }
                    par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                      gamma = 0.04, m = 0, theta = 0, w2 = 3, theta.two = 0)
                    ui.opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 0, 
                      0), c(0, 0, 0, 0, 0, 0, 1, 0), c(0, 1, 0, 
                      0, 0, 0, 0, 0), c(0, 0, 1, 0, 0, 0, 0, 0))
                    ci.opt <- c(-0.99999999, 1, 0, 0)
                  }
                  if (K.two > 1) {
                    if (weighting.two == "beta.restricted") {
                      lf <- function(p) {
                        llh_mf(df = df_llh, y = ret, x = covariate, 
                          low.freq = low.freq, mu = p["mu"], omega = 1 - 
                            p["alpha"] - p["beta"] - p["gamma"]/2, 
                          alpha = p["alpha"], beta = p["beta"], 
                          gamma = p["gamma"], m = p["m"], theta = p["theta"], 
                          w1 = 1, w2 = p["w2"], g_zero = g_zero, 
                          K = K, x.two = covariate.two, K.two = K.two, 
                          low.freq.two = low.freq.two, theta.two = p["theta.two"], 
                          w1.two = 1, w2.two = p["w2.two"])
                      }
                      par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                        gamma = 0.04, m = 0, theta = 0, w2 = 3, 
                        theta.two = 0, w2.two = 3)
                      ui.opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 
                        0, 0, 0), c(0, 0, 0, 0, 0, 0, 1, 0, 0), 
                        c(0, 1, 0, 0, 0, 0, 0, 0, 0), c(0, 0, 1, 
                          0, 0, 0, 0, 0, 0), c(0, 0, 0, 0, 0, 0, 
                          0, 0, 1))
                      ci.opt <- c(-0.99999999, 1, 0, 0, 1)
                    }
                    if (weighting.two != "beta.restricted") {
                      stop("Weighting scheme for second variable can only be beta.restricted.")
                    }
                  }
              }
              if (weighting == "beta.unrestricted" & is.null(K.two) == 
                  TRUE) {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"] - p["gamma"]/2, 
                      alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                      m = p["m"], theta = p["theta"], w1 = p["w1"], 
                      w2 = p["w2"], g_zero = g_zero, K = K)
                  }
                  par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    gamma = 0.04, m = 0, theta = 0, w1 = 1.0000001, 
                    w2 = 3)
                  ui.opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 0, 0), 
                    c(0, 0, 0, 0, 0, 0, 1, 0), c(0, 0, 0, 0, 0, 
                      0, 0, 1), c(0, 1, 0, 0, 0, 0, 0, 0), c(0, 
                      0, 1, 0, 0, 0, 0, 0))
                  ci.opt <- c(-0.99999999, 1, 1, 0, 0)
              }
              if (weighting == "beta.unrestricted" & is.null(weighting.two) == 
                  FALSE) {
                  if (weighting.two == "beta.restricted") {
                    lf <- function(p) {
                      llh_mf(df = df_llh, y = ret, x = covariate, 
                        low.freq = low.freq, mu = p["mu"], omega = 1 - 
                          p["alpha"] - p["beta"] - p["gamma"]/2, 
                        alpha = p["alpha"], beta = p["beta"], gamma = p["gamma"], 
                        m = p["m"], theta = p["theta"], w1 = p["w1"], 
                        w2 = p["w2"], g_zero = g_zero, K = K, x.two = covariate.two, 
                        K.two = K.two, low.freq.two = low.freq.two, 
                        theta.two = p["theta.two"], w1.two = 1, 
                        w2.two = p["w2.two"])
                    }
                    par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                      gamma = 0.04, m = 0, theta = 0, w1 = 1.00000001, 
                      w2 = 3, theta.two = 0, w2.two = 3)
                    ui.opt <- rbind(c(0, -1, -1, -1/2, 0, 0, 0, 
                      0, 0, 0), c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0), 
                      c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0), c(0, 1, 
                        0, 0, 0, 0, 0, 0, 0, 0), c(0, 0, 1, 0, 
                        0, 0, 0, 0, 0, 0), c(0, 0, 0, 0, 0, 0, 
                        0, 0, 0, 1))
                    ci.opt <- c(-0.99999999, 1, 1, 0, 0, 1)
                  }
              }
          }
          if (gamma == FALSE) {
              if (weighting == "beta.restricted") {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"], alpha = p["alpha"], 
                      beta = p["beta"], gamma = 0, m = p["m"], 
                      theta = p["theta"], w1 = 1, w2 = p["w2"], 
                      g_zero = g_zero, K = K)
                  }
                  par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    m = 0, theta = 0, w2 = 3)
                  ui.opt <- rbind(c(0, -1, -1, 0, 0, 0), c(0, 0, 
                    0, 0, 0, 1), c(0, 1, 0, 0, 0, 0), c(0, 0, 1, 
                    0, 0, 0))
                  ci.opt <- c(-0.99999999, 1, 0, 0)
              }
              if (weighting == "beta.unrestricted") {
                  lf <- function(p) {
                    llh_mf(df = df_llh, y = ret, x = covariate, 
                      low.freq = low.freq, mu = p["mu"], omega = 1 - 
                        p["alpha"] - p["beta"], alpha = p["alpha"], 
                      beta = p["beta"], gamma = 0, m = p["m"], 
                      theta = p["theta"], w1 = p["w1"], w2 = p["w2"], 
                      g_zero = g_zero, K = K)
                  }
                  par.start <- c(mu = 0, alpha = 0.02, beta = 0.85, 
                    m = 0, theta = 0, w1 = 1.00000001, w2 = 3)
                  ui.opt <- rbind(c(0, -1, -1, 0, 0, 0, 0), c(0, 
                    0, 0, 0, 0, 1, 0), c(0, 0, 0, 0, 0, 0, 1), 
                    c(0, 1, 0, 0, 0, 0, 0), c(0, 0, 1, 0, 0, 0, 
                      0))
                  ci.opt <- c(-0.99999999, 1, 1, 0, 0)
              }
          }
          if (is.null(control$par.start) == FALSE) {
              par.start <- control$par.start
          }
          p.e.nlminb <- constrOptim(theta = par.start, f = function(theta) {
              sum(lf(theta))
          }, grad = NULL, ui = ui.opt, ci = ci.opt, hessian = FALSE)
          p.e.nlminb$value <- -p.e.nlminb$value
          if (multi.start == TRUE && gamma == TRUE) {
              p.e.nlminb.two <- try({
                  suppressWarnings(optim(par = p.e.nlminb$par, 
                    fn = function(theta) {
                      if (is.na(sum(lf(theta))) == TRUE | theta["alpha"] < 
                        0 | theta["alpha"] + theta["beta"] + theta["gamma"]/2 >= 
                        1 | theta["w2"] < 1) {
                        NA
                      }
                      else {
                        sum(lf(theta))
                      }
                    }, method = "BFGS"))
              }, silent = TRUE)
              if (class(p.e.nlminb.two) != "try-error" && -p.e.nlminb.two$value > 
                  p.e.nlminb$value) {
                  p.e.nlminb <- p.e.nlminb.two
                  p.e.nlminb$value <- -p.e.nlminb$value
              }
              par.max.lik.nr <- try({
                  maxLik(logLik = function(x) -lf(x), start = par.start, 
                    method = "NR")
              }, silent = TRUE)
              if (class(par.max.lik.nr) != "try-error" && par.max.lik.nr$maximum > 
                  p.e.nlminb$value && par.max.lik.nr$estimate["w2"] >= 
                  1 && par.max.lik.nr$estimate["alpha"] + par.max.lik.nr$estimate["beta"] + 
                  par.max.lik.nr$estimate["gamma"]/2 < 1 && par.max.lik.nr$estimate["alpha"] >= 
                  0 && par.max.lik.nr$estimate["beta"] >= 0) {
                  p.e.nlminb$par <- par.max.lik.nr$estimate
                  p.e.nlminb$value <- par.max.lik.nr$maximum
              }
              par.max.lik.nm <- try({
                  maxLik(logLik = function(x) -lf(x), start = par.start, 
                    method = "NM")
              }, silent = TRUE)
              if (class(par.max.lik.nm) != "try-error" && par.max.lik.nm$maximum > 
                  p.e.nlminb$value && par.max.lik.nm$estimate["w2"] >= 
                  1 && par.max.lik.nm$estimate["alpha"] + par.max.lik.nm$estimate["beta"] + 
                  par.max.lik.nm$estimate["gamma"]/2 < 1 && par.max.lik.nm$estimate["alpha"] >= 
                  0 && par.max.lik.nm$estimate["beta"] >= 0) {
                  p.e.nlminb$par <- par.max.lik.nm$estimate
                  p.e.nlminb$value <- par.max.lik.nm$maximum
              }
              p.e.nlminb.three <- try({
                  suppressWarnings(optim(par = par.start, fn = function(theta) {
                    if (is.na(sum(lf(theta))) == TRUE | theta["alpha"] < 
                      0 | theta["alpha"] + theta["beta"] + theta["gamma"]/2 >= 
                      1 | theta["w2"] < 1) {
                      NA
                    }
                    else {
                      sum(lf(theta))
                    }
                  }, method = "BFGS"))
              }, silent = TRUE)
              if (class(p.e.nlminb.three) != "try-error" && -p.e.nlminb.three$value > 
                  p.e.nlminb$value) {
                  p.e.nlminb <- p.e.nlminb.three
                  p.e.nlminb$value <- -p.e.nlminb$value
              }
          }
          if (multi.start == TRUE && gamma == FALSE) {
              p.e.nlminb.two <- try({
                  suppressWarnings(optim(par = p.e.nlminb$par, 
                    fn = function(theta) {
                      if (is.na(sum(lf(theta))) == TRUE | theta["alpha"] < 
                        0 | theta["alpha"] + theta["beta"] >= 1 | 
                        theta["w2"] < 1) {
                        NA
                      }
                      else {
                        sum(lf(theta))
                      }
                    }, method = "BFGS"))
              }, silent = TRUE)
              if (class(p.e.nlminb.two) != "try-error" && -p.e.nlminb.two$value > 
                  p.e.nlminb$value) {
                  p.e.nlminb <- p.e.nlminb.two
                  p.e.nlminb$value <- -p.e.nlminb$value
              }
              par.max.lik.nr <- try({
                  maxLik(logLik = function(x) -lf(x), start = par.start, 
                    method = "NR")
              }, silent = TRUE)
              if (class(par.max.lik.nr) != "try-error" && par.max.lik.nr$maximum > 
                  p.e.nlminb$value && par.max.lik.nr$estimate["w2"] >= 
                  1 && par.max.lik.nr$estimate["alpha"] + par.max.lik.nr$estimate["beta"] < 
                  1 && par.max.lik.nr$estimate["alpha"] >= 0 && 
                  par.max.lik.nr$estimate["beta"] >= 0) {
                  p.e.nlminb$par <- par.max.lik.nr$estimate
                  p.e.nlminb$value <- par.max.lik.nr$maximum
              }
              par.max.lik.nm <- try({
                  maxLik(logLik = function(x) -lf(x), start = par.start, 
                    method = "NM")
              }, silent = TRUE)
              if (class(par.max.lik.nm) != "try-error" && par.max.lik.nm$maximum > 
                  p.e.nlminb$value && par.max.lik.nm$estimate["w2"] >= 
                  1 && par.max.lik.nm$estimate["alpha"] + par.max.lik.nm$estimate["beta"] < 
                  1 && par.max.lik.nm$estimate["alpha"] >= 0 && 
                  par.max.lik.nm$estimate["beta"] >= 0) {
                  p.e.nlminb$par <- par.max.lik.nm$estimate
                  p.e.nlminb$value <- par.max.lik.nm$maximum
              }
              p.e.nlminb.three <- try({
                  suppressWarnings(optim(par = par.start, fn = function(theta) {
                    if (is.na(sum(lf(theta))) == TRUE | theta["alpha"] < 
                      0 | theta["alpha"] + theta["beta"] >= 1 | 
                      theta["w2"] < 1) {
                      NA
                    }
                    else {
                      sum(lf(theta))
                    }
                  }, method = "BFGS"))
              }, silent = TRUE)
              if (class(p.e.nlminb.three) != "try-error" && -p.e.nlminb.three$value > 
                  p.e.nlminb$value) {
                  p.e.nlminb <- p.e.nlminb.three
                  p.e.nlminb$value <- -p.e.nlminb$value
              }
          }
          par <- p.e.nlminb$par
          if (weighting == "beta.restricted") {
              if (is.null(x.two) == FALSE) {
                  if (K.two > 1) {
                    tau <- calculate_tau_mf(df = data, x = covariate, 
                      low.freq = low.freq, w1 = 1, w2 = par["w2"], 
                      theta = par["theta"], m = par["m"], K = K, 
                      x.two = covariate.two, K.two = K.two, theta.two = par["theta.two"], 
                      low.freq.two = low.freq.two, w1.two = 1, 
                      w2.two = par["w2.two"])$tau
                  }
                  else {
                    tau <- calculate_tau_mf(df = data, x = covariate, 
                      low.freq = low.freq, w1 = 1, w2 = par["w2"], 
                      theta = par["theta"], m = par["m"], K = K, 
                      x.two = covariate.two, K.two = K.two, theta.two = par["theta.two"], 
                      low.freq.two = low.freq.two, w1.two = 1, 
                      w2.two = 1)$tau
                  }
              }
              else {
                  tau <- calculate_tau_mf(df = data, x = covariate, 
                    low.freq = low.freq, w1 = 1, w2 = par["w2"], 
                    theta = par["theta"], m = par["m"], K = K)$tau
              }
              tau_forecast <- exp(sum_tau_fcts(m = par["m"], i = K + 
                  1, theta = par["theta"], phivar = calculate_phi(w1 = 1, 
                  w2 = par["w2"], K = K), covariate = c(tail(unlist(unique(data[c(x, 
                  low.freq)])[x]), K), NA), K = K))
              if (is.null(x.two) == FALSE) {
                  if (K.two > 1) {
                    tau_forecast <- tau_forecast * exp(sum_tau_fcts(m = 0, 
                      i = K.two + 1, theta = par["theta.two"], 
                      phivar = calculate_phi(w1 = 1, w2 = par["w2.two"], 
                        K = K.two), covariate = c(tail(unlist(unique(data[c(x.two, 
                        low.freq.two)])[x.two]), K.two), NA), K = K.two))
                  }
                  else {
                    tau_forecast <- tau_forecast * exp(sum_tau_fcts(m = 0, 
                      i = K.two + 1, theta = par["theta.two"], 
                      phivar = calculate_phi(w1 = 1, w2 = 1, K = K.two), 
                      covariate = c(tail(unlist(unique(data[c(x.two, 
                        low.freq.two)])[x.two]), K.two), NA), K = K.two))
                  }
              }
          }
          if (weighting == "beta.unrestricted") {
              if (is.null(x.two) == FALSE) {
                  tau <- calculate_tau_mf(df = data, x = covariate, 
                    low.freq = low.freq, w1 = par["w1"], w2 = par["w2"], 
                    theta = par["theta"], m = par["m"], K = K, 
                    x.two = covariate.two, K.two = K.two, theta.two = par["theta.two"], 
                    low.freq.two = low.freq.two, w1.two = 1, w2.two = par["w2.two"])$tau
              }
              else {
                  tau <- calculate_tau_mf(df = data, x = covariate, 
                    low.freq = low.freq, w1 = par["w1"], w2 = par["w2"], 
                    theta = par["theta"], m = par["m"], K = K)$tau
              }
              tau_forecast <- exp(sum_tau_fcts(m = par["m"], i = K + 
                  1, theta = par["theta"], phivar = calculate_phi(w1 = par["w1"], 
                  w2 = par["w2"], K = K), covariate = c(tail(unlist(unique(data[c(x, 
                  low.freq)])[x]), K), NA), K = K))
              if (is.null(x.two) == FALSE) {
                  tau_forecast <- tau_forecast * exp(sum_tau_fcts(m = 0, 
                    i = K.two + 1, theta = par["theta.two"], phivar = calculate_phi(w1 = 1, 
                      w2 = par["w2.two"], K = K.two), covariate = c(tail(unlist(unique(data[c(x.two, 
                      low.freq.two)])[x.two]), K.two), NA), K = K.two))
              }
          }
          returns <- unlist(data[y])
          if (gamma == TRUE) {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"] - 
                    par["gamma"]/2, alpha = par["alpha"], beta = par["beta"], 
                    gamma = par["gamma"], as.numeric(na.exclude((returns - 
                      par["mu"])/sqrt(tau))), g0 = g_zero))
          }
          else {
              g <- c(rep(NA, times = sum(is.na((returns - par["mu"])/sqrt(tau)))), 
                  calculate_g(omega = 1 - par["alpha"] - par["beta"], 
                    alpha = par["alpha"], beta = par["beta"], gamma = 0, 
                    as.numeric(na.exclude((returns - par["mu"])/sqrt(tau))), 
                    g0 = g_zero))
          }
          if ((var.ratio.freq %in% c("date", low.freq)) == FALSE) {
              if (is.null(x.two) == TRUE) {
                  df.fitted <- cbind(data[c("date", y, low.freq, 
                    x, var.ratio.freq)], g = g, tau = tau)
              }
              else {
                  df.fitted <- cbind(data[c("date", y, low.freq, 
                    x, low.freq.two, x.two, var.ratio.freq)], g = g, 
                    tau = tau)
              }
          }
          else {
              if (is.null(x.two) == TRUE) {
                  df.fitted <- cbind(data[c("date", y, low.freq, 
                    x)], g = g, tau = tau)
              }
              else {
                  df.fitted <- cbind(data[c("date", y, low.freq, 
                    x, low.freq.two, x.two)], g = g, tau = tau)
              }
          }
          df.fitted$residuals <- unlist((df.fitted[y] - par["mu"])/sqrt(df.fitted$g * 
              df.fitted$tau))
      }
      df.fitted$date <- as.Date(date_backup)
      inv_hessian <- try({
          solve(-suppressWarnings(hessian(x = par, func = function(theta) {
              if (is.na(sum(lf(theta))) == TRUE) {
                  0
              }
              else {
                  -sum(lf(theta))
              }
          })))
      }, silent = TRUE)
      opg.std.err <- try({
          sqrt(diag(solve(crossprod(jacobian(func = function(theta) -lf(theta), 
              x = par)))))
      }, silent = TRUE)
      if (class(inv_hessian) == "try-error") {
          warning("Inverting the OPG matrix failed. No OPG standard errors calculated.")
          opg.std.err <- NA
      }
      opg.std.err <- opg.std.err * sqrt((mean(df.fitted$residuals^4, 
          na.rm = TRUE) - 1)/2)
      if (class(inv_hessian) == "try-error") {
          warning("Inverting the Hessian matrix failed. No robust standard errors calculated. Possible workaround: Multiply returns by 100.")
          rob.std.err <- NA
      }
      else {
          rob.std.err <- sqrt(diag(inv_hessian %*% crossprod(jacobian(func = lf, 
              x = par)) %*% inv_hessian))
      }
      output <- list(par = par, std.err = rob.std.err, broom.mgarch = data.frame(term = names(par), 
          estimate = par, rob.std.err = rob.std.err, p.value = 2 * 
              (1 - pnorm(unlist(abs(par/rob.std.err)))), opg.std.err = opg.std.err, 
          opg.p.value = 2 * (1 - pnorm(unlist(abs(par/opg.std.err))))), 
          tau = tau, g = g, df.fitted = df.fitted, K = K, weighting.scheme = weighting, 
          llh = p.e.nlminb$value, bic = log(sum(!is.na(tau))) * 
              length(par) - 2 * (p.e.nlminb$value), y = y, optim = p.e.nlminb)
      if (is.null(x.two) == FALSE) {
          output$K.two <- K.two
          output$weighting.scheme.two <- weighting.two
      }
      if (K == 0) {
          output$tau.forecast <- exp(par["m"])
      }
      if (K > 0) {
          output$variance.ratio <- 100 * var(log(aggregate(df.fitted$tau, 
              by = df.fitted[var.ratio.freq], FUN = mean)[, 2]), 
              na.rm = TRUE)/var(log(aggregate(df.fitted$tau * df.fitted$g, 
              by = df.fitted[var.ratio.freq], FUN = mean)[, 2]), 
              na.rm = TRUE)
          output$tau.forecast <- tau_forecast
          if (weighting == "beta.restricted") {
              output$est.weighting <- calculate_phi(1, w2 = par["w2"], 
                  K = K)
          }
          if (weighting == "beta.unrestricted") {
              output$est.weighting <- calculate_phi(w1 = par["w1"], 
                  w2 = par["w2"], K = K)
          }
          if (is.null(x.two) == FALSE) {
              if (K.two > 1) {
                  output$est.weighting.two <- calculate_phi(w1 = 1, 
                    w2 = par["w2.two"], K = K.two)
              }
          }
      }
      class(output) <- "mfGARCH"
      output
  }
  <bytecode: 0x3d47d48>
  <environment: namespace:mfGARCH>
   --- function search by body ---
  Function fit_mfgarch in namespace mfGARCH has this body.
   ----------- END OF FAILURE REPORT -------------- 
  Fatal error: the condition has length > 1