R version 4.0.5 (2021-03-31) -- "Shake and Throw"
Copyright (C) 2021 The R Foundation for Statistical Computing
Platform: i386-w64-mingw32/i386 (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(testthat)
> library(OmicsMarkeR)
Warning message:
Package 'OmicsMarkeR' is deprecated and will be removed from
  Bioconductor version 3.13 
> 
> test_check("OmicsMarkeR")
solo last variable ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
OmicsMarkeR
 --- call from context --- 
bagging.wrapper(X = trainX, Y = trainY, method = method, bags = bags, 
    f = f, aggregation.metric = aggregation.metric, k.folds = k.folds, 
    repeats = repeats, res = resolution, tuning.grid = tuning.grid, 
    optimize = optimize, optimize.resample = optimize.resample, 
    metric = metric, model.features = model.features, verbose = verbose, 
    allowParallel = allowParallel, theDots = theDots)
 --- call from argument --- 
if (class(features[[j]]) != "data.frame") {
    features[[j]] <- data.frame(features[[j]])
}
 --- R stacktrace ---
where 1: bagging.wrapper(X = trainX, Y = trainY, method = method, bags = bags, 
    f = f, aggregation.metric = aggregation.metric, k.folds = k.folds, 
    repeats = repeats, res = resolution, tuning.grid = tuning.grid, 
    optimize = optimize, optimize.resample = optimize.resample, 
    metric = metric, model.features = model.features, verbose = verbose, 
    allowParallel = allowParallel, theDots = theDots)
where 2: fs.ensembl.stability(vars, groups, method = c("svm", "plsda"), 
    f = 10, k = 3, bags = 3, stability.metric = "canberra", k.folds = 3, 
    verbose = "none")
where 3: withCallingHandlers(expr, warning = function(w) if (inherits(w, 
    classes)) tryInvokeRestart("muffleWarning"))
where 4 at test_fs.ensembl.stability.R#39: suppressWarnings(fs.ensembl.stability(vars, groups, method = c("svm", 
    "plsda"), f = 10, k = 3, bags = 3, stability.metric = "canberra", 
    k.folds = 3, verbose = "none"))
where 5: eval(code, test_env)
where 6: eval(code, test_env)
where 7: 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 8: doTryCatch(return(expr), name, parentenv, handler)
where 9: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 10: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 11: doTryCatch(return(expr), name, parentenv, handler)
where 12: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 13: tryCatchList(expr, classes, parentenv, handlers)
where 14: 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 15: test_code(NULL, exprs, env)
where 16: source_file(path, child_env(env), wrap = wrap)
where 17: FUN(X[[i]], ...)
where 18: lapply(test_paths, test_one_file, env = env, wrap = wrap)
where 19: force(code)
where 20: doWithOneRestart(return(expr), restart)
where 21: withOneRestart(expr, restarts[[1L]])
where 22: withRestarts(testthat_abort_reporter = function() NULL, force(code))
where 23: with_reporter(reporters$multi, lapply(test_paths, test_one_file, 
    env = env, wrap = wrap))
where 24: test_files(test_dir = test_dir, test_package = test_package, 
    test_paths = test_paths, load_helpers = load_helpers, reporter = reporter, 
    env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package)
where 25: test_files(test_dir = path, test_paths = test_paths, test_package = package, 
    reporter = reporter, load_helpers = load_helpers, env = env, 
    stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package, parallel = parallel)
where 26: test_dir("testthat", package = package, reporter = reporter, 
    ..., load_package = "installed")
where 27: test_check("OmicsMarkeR")

 --- value of length: 2 type: logical ---
[1] TRUE TRUE
 --- function from context --- 
function (X, Y, method, bags, f, aggregation.metric, k.folds, 
    repeats, res, tuning.grid, optimize, optimize.resample, metric, 
    model.features, allowParallel, verbose, theDots) 
{
    rownames(X) <- NULL
    var.names <- colnames(X)
    nr <- nrow(X)
    nc <- ncol(X)
    num.group = nlevels(Y)
    grp.levs <- levels(Y)
    trainVars.list <- vector("list", bags)
    trainGroup.list <- vector("list", bags)
    if (optimize == TRUE & optimize.resample == TRUE) {
        resample.tunes <- vector("list", bags)
        names(resample.tunes) <- paste("Bag", 1:bags, sep = ".")
    }
    else {
        resample.tunes <- NULL
    }
    for (i in 1:bags) {
        boot = sample(nr, nr, replace = TRUE)
        trainVars <- X[boot, ]
        trainGroup <- Y[boot]
        trainVars.list[[i]] <- trainVars
        trainGroup.list[[i]] <- trainGroup
        trainData <- as.data.frame(trainVars)
        trainData$.classes <- trainGroup
        rownames(trainData) <- NULL
        if (optimize == TRUE) {
            if (optimize.resample == TRUE) {
                tuned.methods <- optimize.model(trainVars = trainVars, 
                  trainGroup = trainGroup, method = method, k.folds = k.folds, 
                  repeats = repeats, res = res, grid = tuning.grid, 
                  metric = metric, allowParallel = allowParallel, 
                  verbose = verbose, theDots = theDots)
                if (i == 1) {
                  finalModel <- tuned.methods$finalModel
                }
                else {
                  finalModel <- append(finalModel, tuned.methods$finalModel)
                }
                names(tuned.methods$bestTune) = method
                resample.tunes[[i]] <- tuned.methods$bestTune
            }
            else {
                if (i == 1) {
                  tuned.methods <- optimize.model(trainVars = trainVars, 
                    trainGroup = trainGroup, method = method, 
                    k.folds = k.folds, repeats = repeats, res = res, 
                    grid = tuning.grid, metric = metric, allowParallel = allowParallel, 
                    verbose = verbose, theDots = theDots)
                  finalModel <- tuned.methods$finalModel
                  names(tuned.methods$bestTune) <- method
                }
                else {
                  tmp <- vector("list", length(method))
                  names(tmp) <- method
                  for (d in seq(along = method)) {
                    tmp[[d]] <- training(data = trainData, method = method[d], 
                      tuneValue = tuned.methods$bestTune[[d]], 
                      obsLevels = grp.levs, theDots = theDots)$fit
                  }
                  finalModel <- append(finalModel, tmp)
                }
            }
        }
        else {
            names(theDots) <- paste(".", names(theDots), sep = "")
            args.seq <- sequester(theDots, method)
            names(theDots) <- sub(".", "", names(theDots))
            moreDots <- theDots[!names(theDots) %in% args.seq$pnames]
            if (length(moreDots) == 0) {
                moreDots <- NULL
            }
            finalModel <- vector("list", length(method))
            for (q in seq(along = method)) {
                finalModel[[q]] <- training(data = trainData, 
                  method = method[q], tuneValue = args.seq$parameters[[q]], 
                  obsLevels = grp.levs, theDots = moreDots)
            }
        }
    }
    method.names <- unlist(lapply(method, FUN = function(x) paste(c(rep(x, 
        bags)), seq(bags), sep = ".")))
    names(finalModel) <- paste(method, rep(seq(bags), each = length(method)), 
        sep = ".")
    finalModel <- finalModel[match(method.names, names(finalModel))]
    features <- vector("list", length(method))
    names(features) <- tolower(method)
    for (j in seq(along = method)) {
        mydata <- vector("list", bags)
        if (method[j] == "pam") {
            for (t in 1:bags) {
                mydata[[t]] <- list(x = t(trainVars.list[[t]]), 
                  y = factor(trainGroup.list[[t]]), geneid = as.character(colnames(trainVars.list[[t]])))
            }
        }
        else {
            for (t in 1:bags) {
                mydata[[t]] <- trainVars.list[[t]]
            }
        }
        if (j == 1) {
            start <- 1
            end <- bags
        }
        if (method[j] == "svm" | method[j] == "pam" | method[j] == 
            "glmnet") {
            bt <- vector("list", bags)
            for (l in seq(bags)) {
                if (optimize == TRUE) {
                  if (optimize.resample == FALSE) {
                    bt[[l]] <- tuned.methods$bestTune[[j]]
                  }
                  else {
                    bt[[l]] <- tuned.methods$bestTune[[l]]
                  }
                }
            }
        }
        else {
            bt <- vector("list", bags)
        }
        if (method[j] == "plsda") {
            cc <- vector("list", bags)
            for (c in seq(bags)) {
                if (optimize == TRUE) {
                  if (optimize.resample == FALSE) {
                    cc[[c]] <- tuned.methods$bestTune[[j]]
                  }
                  else {
                    cc[[c]] <- tuned.methods$bestTune[[c]]
                  }
                }
            }
        }
        finalModel.bag <- finalModel[start:end]
        tmp <- vector("list", bags)
        for (s in seq(bags)) {
            tmp[[s]] <- extract.features(x = finalModel.bag[s], 
                dat = mydata[[s]], grp = trainGroup.list[[s]], 
                bestTune = bt[[s]], model.features = FALSE, method = method[j], 
                f = NULL, comp.catch = cc)
        }
        if (method[j] == "glmnet") {
            features[[j]] <- data.frame(do.call("cbind", unlist(unlist(tmp, 
                recursive = FALSE), recursive = FALSE)))
        }
        else {
            features[[j]] <- do.call("cbind", unlist(tmp, recursive = FALSE))
            if (class(features[[j]]) != "data.frame") {
                features[[j]] <- data.frame(features[[j]])
            }
        }
        rownames(features[[j]]) <- colnames(X)
        start <- start + bags
        end <- end + bags
    }
    features.num <- lapply(features, FUN = function(z) {
        sapply(z, FUN = function(x) as.numeric(as.character(x)))
    })
    features.num <- lapply(features.num, function(x) {
        rownames(x) <- var.names
        return(x)
    })
    agg <- lapply(features.num, FUN = function(x) {
        aggregation(efs = x, metric = aggregation.metric, f = f)
    })
    ensemble.results <- list(Methods = method, ensemble.results = agg, 
        Number.Bags = bags, Agg.metric = aggregation.metric, 
        Number.features = f)
    out <- list(results = ensemble.results, bestTunes = resample.tunes)
    out
}
<bytecode: 0x0a5ba3c0>
<environment: namespace:OmicsMarkeR>
 --- function search by body ---
Function bagging.wrapper in namespace OmicsMarkeR has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1

R version 4.0.5 (2021-03-31) -- "Shake and Throw"
Copyright (C) 2021 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> library(testthat)
> library(OmicsMarkeR)
Warning message:
Package 'OmicsMarkeR' is deprecated and will be removed from
  Bioconductor version 3.13 
> 
> test_check("OmicsMarkeR")
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
OmicsMarkeR
 --- call from context --- 
bagging.wrapper(X = trainX, Y = trainY, method = method, bags = bags, 
    f = f, aggregation.metric = aggregation.metric, k.folds = k.folds, 
    repeats = repeats, res = resolution, tuning.grid = tuning.grid, 
    optimize = optimize, optimize.resample = optimize.resample, 
    metric = metric, model.features = model.features, verbose = verbose, 
    allowParallel = allowParallel, theDots = theDots)
 --- call from argument --- 
if (class(features[[j]]) != "data.frame") {
    features[[j]] <- data.frame(features[[j]])
}
 --- R stacktrace ---
where 1: bagging.wrapper(X = trainX, Y = trainY, method = method, bags = bags, 
    f = f, aggregation.metric = aggregation.metric, k.folds = k.folds, 
    repeats = repeats, res = resolution, tuning.grid = tuning.grid, 
    optimize = optimize, optimize.resample = optimize.resample, 
    metric = metric, model.features = model.features, verbose = verbose, 
    allowParallel = allowParallel, theDots = theDots)
where 2: fs.ensembl.stability(vars, groups, method = c("svm", "plsda"), 
    f = 10, k = 3, bags = 3, stability.metric = "canberra", k.folds = 3, 
    verbose = "none")
where 3: withCallingHandlers(expr, warning = function(w) if (inherits(w, 
    classes)) tryInvokeRestart("muffleWarning"))
where 4 at test_fs.ensembl.stability.R#39: suppressWarnings(fs.ensembl.stability(vars, groups, method = c("svm", 
    "plsda"), f = 10, k = 3, bags = 3, stability.metric = "canberra", 
    k.folds = 3, verbose = "none"))
where 5: eval(code, test_env)
where 6: eval(code, test_env)
where 7: 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 8: doTryCatch(return(expr), name, parentenv, handler)
where 9: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 10: tryCatchList(expr, names[-nh], parentenv, handlers[-nh])
where 11: doTryCatch(return(expr), name, parentenv, handler)
where 12: tryCatchOne(tryCatchList(expr, names[-nh], parentenv, handlers[-nh]), 
    names[nh], parentenv, handlers[[nh]])
where 13: tryCatchList(expr, classes, parentenv, handlers)
where 14: 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 15: test_code(NULL, exprs, env)
where 16: source_file(path, child_env(env), wrap = wrap)
where 17: FUN(X[[i]], ...)
where 18: lapply(test_paths, test_one_file, env = env, wrap = wrap)
where 19: force(code)
where 20: doWithOneRestart(return(expr), restart)
where 21: withOneRestart(expr, restarts[[1L]])
where 22: withRestarts(testthat_abort_reporter = function() NULL, force(code))
where 23: with_reporter(reporters$multi, lapply(test_paths, test_one_file, 
    env = env, wrap = wrap))
where 24: test_files(test_dir = test_dir, test_package = test_package, 
    test_paths = test_paths, load_helpers = load_helpers, reporter = reporter, 
    env = env, stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package)
where 25: test_files(test_dir = path, test_paths = test_paths, test_package = package, 
    reporter = reporter, load_helpers = load_helpers, env = env, 
    stop_on_failure = stop_on_failure, stop_on_warning = stop_on_warning, 
    wrap = wrap, load_package = load_package, parallel = parallel)
where 26: test_dir("testthat", package = package, reporter = reporter, 
    ..., load_package = "installed")
where 27: test_check("OmicsMarkeR")

 --- value of length: 2 type: logical ---
[1] TRUE TRUE
 --- function from context --- 
function (X, Y, method, bags, f, aggregation.metric, k.folds, 
    repeats, res, tuning.grid, optimize, optimize.resample, metric, 
    model.features, allowParallel, verbose, theDots) 
{
    rownames(X) <- NULL
    var.names <- colnames(X)
    nr <- nrow(X)
    nc <- ncol(X)
    num.group = nlevels(Y)
    grp.levs <- levels(Y)
    trainVars.list <- vector("list", bags)
    trainGroup.list <- vector("list", bags)
    if (optimize == TRUE & optimize.resample == TRUE) {
        resample.tunes <- vector("list", bags)
        names(resample.tunes) <- paste("Bag", 1:bags, sep = ".")
    }
    else {
        resample.tunes <- NULL
    }
    for (i in 1:bags) {
        boot = sample(nr, nr, replace = TRUE)
        trainVars <- X[boot, ]
        trainGroup <- Y[boot]
        trainVars.list[[i]] <- trainVars
        trainGroup.list[[i]] <- trainGroup
        trainData <- as.data.frame(trainVars)
        trainData$.classes <- trainGroup
        rownames(trainData) <- NULL
        if (optimize == TRUE) {
            if (optimize.resample == TRUE) {
                tuned.methods <- optimize.model(trainVars = trainVars, 
                  trainGroup = trainGroup, method = method, k.folds = k.folds, 
                  repeats = repeats, res = res, grid = tuning.grid, 
                  metric = metric, allowParallel = allowParallel, 
                  verbose = verbose, theDots = theDots)
                if (i == 1) {
                  finalModel <- tuned.methods$finalModel
                }
                else {
                  finalModel <- append(finalModel, tuned.methods$finalModel)
                }
                names(tuned.methods$bestTune) = method
                resample.tunes[[i]] <- tuned.methods$bestTune
            }
            else {
                if (i == 1) {
                  tuned.methods <- optimize.model(trainVars = trainVars, 
                    trainGroup = trainGroup, method = method, 
                    k.folds = k.folds, repeats = repeats, res = res, 
                    grid = tuning.grid, metric = metric, allowParallel = allowParallel, 
                    verbose = verbose, theDots = theDots)
                  finalModel <- tuned.methods$finalModel
                  names(tuned.methods$bestTune) <- method
                }
                else {
                  tmp <- vector("list", length(method))
                  names(tmp) <- method
                  for (d in seq(along = method)) {
                    tmp[[d]] <- training(data = trainData, method = method[d], 
                      tuneValue = tuned.methods$bestTune[[d]], 
                      obsLevels = grp.levs, theDots = theDots)$fit
                  }
                  finalModel <- append(finalModel, tmp)
                }
            }
        }
        else {
            names(theDots) <- paste(".", names(theDots), sep = "")
            args.seq <- sequester(theDots, method)
            names(theDots) <- sub(".", "", names(theDots))
            moreDots <- theDots[!names(theDots) %in% args.seq$pnames]
            if (length(moreDots) == 0) {
                moreDots <- NULL
            }
            finalModel <- vector("list", length(method))
            for (q in seq(along = method)) {
                finalModel[[q]] <- training(data = trainData, 
                  method = method[q], tuneValue = args.seq$parameters[[q]], 
                  obsLevels = grp.levs, theDots = moreDots)
            }
        }
    }
    method.names <- unlist(lapply(method, FUN = function(x) paste(c(rep(x, 
        bags)), seq(bags), sep = ".")))
    names(finalModel) <- paste(method, rep(seq(bags), each = length(method)), 
        sep = ".")
    finalModel <- finalModel[match(method.names, names(finalModel))]
    features <- vector("list", length(method))
    names(features) <- tolower(method)
    for (j in seq(along = method)) {
        mydata <- vector("list", bags)
        if (method[j] == "pam") {
            for (t in 1:bags) {
                mydata[[t]] <- list(x = t(trainVars.list[[t]]), 
                  y = factor(trainGroup.list[[t]]), geneid = as.character(colnames(trainVars.list[[t]])))
            }
        }
        else {
            for (t in 1:bags) {
                mydata[[t]] <- trainVars.list[[t]]
            }
        }
        if (j == 1) {
            start <- 1
            end <- bags
        }
        if (method[j] == "svm" | method[j] == "pam" | method[j] == 
            "glmnet") {
            bt <- vector("list", bags)
            for (l in seq(bags)) {
                if (optimize == TRUE) {
                  if (optimize.resample == FALSE) {
                    bt[[l]] <- tuned.methods$bestTune[[j]]
                  }
                  else {
                    bt[[l]] <- tuned.methods$bestTune[[l]]
                  }
                }
            }
        }
        else {
            bt <- vector("list", bags)
        }
        if (method[j] == "plsda") {
            cc <- vector("list", bags)
            for (c in seq(bags)) {
                if (optimize == TRUE) {
                  if (optimize.resample == FALSE) {
                    cc[[c]] <- tuned.methods$bestTune[[j]]
                  }
                  else {
                    cc[[c]] <- tuned.methods$bestTune[[c]]
                  }
                }
            }
        }
        finalModel.bag <- finalModel[start:end]
        tmp <- vector("list", bags)
        for (s in seq(bags)) {
            tmp[[s]] <- extract.features(x = finalModel.bag[s], 
                dat = mydata[[s]], grp = trainGroup.list[[s]], 
                bestTune = bt[[s]], model.features = FALSE, method = method[j], 
                f = NULL, comp.catch = cc)
        }
        if (method[j] == "glmnet") {
            features[[j]] <- data.frame(do.call("cbind", unlist(unlist(tmp, 
                recursive = FALSE), recursive = FALSE)))
        }
        else {
            features[[j]] <- do.call("cbind", unlist(tmp, recursive = FALSE))
            if (class(features[[j]]) != "data.frame") {
                features[[j]] <- data.frame(features[[j]])
            }
        }
        rownames(features[[j]]) <- colnames(X)
        start <- start + bags
        end <- end + bags
    }
    features.num <- lapply(features, FUN = function(z) {
        sapply(z, FUN = function(x) as.numeric(as.character(x)))
    })
    features.num <- lapply(features.num, function(x) {
        rownames(x) <- var.names
        return(x)
    })
    agg <- lapply(features.num, FUN = function(x) {
        aggregation(efs = x, metric = aggregation.metric, f = f)
    })
    ensemble.results <- list(Methods = method, ensemble.results = agg, 
        Number.Bags = bags, Agg.metric = aggregation.metric, 
        Number.features = f)
    out <- list(results = ensemble.results, bestTunes = resample.tunes)
    out
}
<bytecode: 0x000000001055d698>
<environment: namespace:OmicsMarkeR>
 --- function search by body ---
Function bagging.wrapper in namespace OmicsMarkeR has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1