CRAN Package Check Results for Package mfGARCH

Last updated on 2019-11-26 00:51:57 CET.

Check Details

Version: 0.1.8
Check: tests
Result: ERROR
     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: 0x4c0bbf8>
     <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
Flavor: r-devel-linux-x86_64-debian-clang

Version: 0.1.8
Check: tests
Result: ERROR
     Running ‘testthat.R’ [3s/6s]
    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: 0x5618839968f8>
     <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
Flavor: r-devel-linux-x86_64-debian-gcc