##############################################################################
##############################################################################
###
### Running command:
###
### /home/biocbuild/bbs-3.11-bioc/R/bin/R CMD check --install=check:OmicsMarkeR.install-out.txt --library=/home/biocbuild/bbs-3.11-bioc/R/library --no-vignettes --timings OmicsMarkeR_1.20.0.tar.gz
###
##############################################################################
##############################################################################
* using log directory ‘/home/biocbuild/bbs-3.11-bioc/meat/OmicsMarkeR.Rcheck’
* using R version 4.0.3 (2020-10-10)
* using platform: x86_64-pc-linux-gnu (64-bit)
* using session charset: UTF-8
* using option ‘--no-vignettes’
* checking for file ‘OmicsMarkeR/DESCRIPTION’ ... OK
* this is package ‘OmicsMarkeR’ version ‘1.20.0’
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking for sufficient/correct file permissions ... OK
* checking whether package ‘OmicsMarkeR’ can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking ‘build’ directory ... OK
* checking DESCRIPTION meta-information ... OK
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... OK
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking installed files from ‘inst/doc’ ... OK
* checking files in ‘vignettes’ ... OK
* checking examples ... ERROR
Running examples in ‘OmicsMarkeR-Ex.R’ failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: fit.only.model
> ### Title: Fit Models without Feature Selection
> ### Aliases: fit.only.model
>
> ### ** Examples
>
> dat.discr <- create.discr.matrix(
+ create.corr.matrix(
+ create.random.matrix(nvar = 50,
+ nsamp = 100,
+ st.dev = 1,
+ perturb = 0.2)),
+ D = 10
+ )
solo last variable>
> vars <- dat.discr$discr.mat
> groups <- dat.discr$classes
>
> fit <- fit.only.model(X=vars,
+ Y=groups,
+ method="plsda",
+ p = 0.9)
randomForest 4.6-14
Type rfNews() to see new features/changes/bug fixes.
Loaded gbm 2.1.8
Loading required package: cluster
Loading required package: survival
Loading required package: Matrix
Loaded glmnet 4.0-2
Calculating Model Performance Statistics
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
OmicsMarkeR
--- call from context ---
prediction.metrics(finalModel = finalModel, method = method,
raw.data = raw.data, inTrain = inTrain, outTrain = outTrain,
features = NULL, bestTune = if (optimize) best.tunes else args.seq$parameters,
grp.levs = grp.levs, stability.metric = NULL)
--- call from argument ---
if (class(inTrain) == "list" & class(outTrain) == "list") {
inTrain.list <- rep(inTrain, length(method))
outTrain.list <- rep(outTrain, length(method))
} else {
inTrain.list <- rep(list(inTrain), length(finalModel))
outTrain.list <- rep(list(outTrain), length(finalModel))
}
--- R stacktrace ---
where 1: prediction.metrics(finalModel = finalModel, method = method,
raw.data = raw.data, inTrain = inTrain, outTrain = outTrain,
features = NULL, bestTune = if (optimize) best.tunes else args.seq$parameters,
grp.levs = grp.levs, stability.metric = NULL)
where 2: fit.only.model(X = vars, Y = groups, method = "plsda", p = 0.9)
--- value of length: 2 type: logical ---
[1] FALSE FALSE
--- function from context ---
function (finalModel, method, raw.data, inTrain, outTrain, features,
bestTune, grp.levs, stability.metric)
{
raw.data.vars <- raw.data[, !colnames(raw.data) %in% c(".classes")]
raw.data.grps <- raw.data[, colnames(raw.data) %in% c(".classes")]
if (class(inTrain) == "list" & class(outTrain) == "list") {
inTrain.list <- rep(inTrain, length(method))
outTrain.list <- rep(outTrain, length(method))
}
else {
inTrain.list <- rep(list(inTrain), length(finalModel))
outTrain.list <- rep(list(outTrain), length(finalModel))
}
if (length(bestTune) != length(finalModel)) {
tmp.mult <- length(finalModel)/length(bestTune)
bestTune <- rep(bestTune, tmp.mult)
names(bestTune) <- names(finalModel)
}
method.names <- unlist(lapply(method, FUN = function(x) {
c(rep(x, length(bestTune)/length(method)))
}))
bestTune <- bestTune[match(method.names, names(bestTune))]
finalModel <- finalModel[match(method.names, names(finalModel))]
if (is.null(features)) {
features <- vector("list", length(finalModel))
for (f in seq(length(finalModel))) {
features[[f]] <- colnames(raw.data.vars)
}
}
features <- features[match(method.names, names(features))]
predicted <- vector("list", length(finalModel))
names(predicted) <- names(finalModel)
for (e in seq(along = finalModel)) {
new.dat <- switch(names(finalModel[e]), svm = {
if (stability.metric %in% c("spearman", "canberra")) {
raw.data.vars[outTrain.list[[e]], , drop = FALSE]
} else {
raw.data.vars[outTrain.list[[e]], (names(raw.data.vars) %in%
features[[e]]), drop = FALSE]
}
}, glmnet = {
if (stability.metric %in% c("spearman", "canberra")) {
raw.data.vars[outTrain.list[[e]], , drop = FALSE]
} else {
raw.data.vars[outTrain.list[[e]], (names(raw.data.vars) %in%
features[[e]]), drop = FALSE]
}
}, pam = {
if (stability.metric %in% c("spearman", "canberra")) {
raw.data.vars[outTrain.list[[e]], , drop = FALSE]
} else {
raw.data.vars[outTrain.list[[e]], (names(raw.data.vars) %in%
features[[e]]), drop = FALSE]
}
}, plsda = , gbm = , rf = {
raw.data.vars[outTrain.list[[e]], , drop = FALSE]
}, )
predicted[[e]] <- predicting(method = names(finalModel)[e],
modelFit = finalModel[[e]], orig.data = raw.data,
indicies = inTrain.list[[e]], newdata = new.dat,
param = bestTune[[e]])
}
for (g in seq(along = finalModel)) {
predicted[[g]] <- factor(as.character(unlist(predicted[[g]])),
levels = grp.levs)
predicted[[g]] <- data.frame(pred = predicted[[g]], obs = raw.data.grps[outTrain.list[[g]]],
stringsAsFactors = FALSE)
}
method.vector <- rep(method, each = length(finalModel)/length(method))
perf.metrics <- mapply(predicted, FUN = function(x, y) perf.calc(x,
lev = grp.levs, model = y), y = method.vector, SIMPLIFY = FALSE)
cells <- lapply(predicted, function(x) flatTable(x$pred,
x$obs))
for (ind in seq(along = cells)) {
perf.metrics[[ind]] <- c(perf.metrics[[ind]], cells[[ind]])
}
final.metrics <- do.call("rbind", perf.metrics)
}
<bytecode: 0x55980cfa00d8>
<environment: namespace:OmicsMarkeR>
--- function search by body ---
Function prediction.metrics in namespace OmicsMarkeR has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
* checking for unstated dependencies in ‘tests’ ... OK
* checking tests ...
Running ‘testthat.R’
ERROR
Running the tests in ‘tests/testthat.R’ failed.
Last 13 lines of output:
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: 0x55768b2ab9c8>
<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
* checking for unstated dependencies in vignettes ... OK
* checking package vignettes in ‘inst/doc’ ... OK
* checking running R code from vignettes ... SKIPPED
* checking re-building of vignette outputs ... SKIPPED
* checking PDF version of manual ... OK
* DONE
Status: 2 ERRORs
See
‘/home/biocbuild/bbs-3.11-bioc/meat/OmicsMarkeR.Rcheck/00check.log’
for details.
R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out"
Copyright (C) 2020 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (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)
>
> 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 testthat/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, new.env(parent = env), chdir = TRUE, wrap = wrap)
where 17: force(code)
where 18: doWithOneRestart(return(expr), restart)
where 19: withOneRestart(expr, restarts[[1L]])
where 20: withRestarts(testthat_abort_reporter = function() NULL, force(code))
where 21: 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 22: FUN(X[[i]], ...)
where 23: lapply(paths, test_file, env = env, reporter = current_reporter,
start_end_reporter = FALSE, load_helpers = FALSE, wrap = wrap)
where 24: force(code)
where 25: doWithOneRestart(return(expr), restart)
where 26: withOneRestart(expr, restarts[[1L]])
where 27: withRestarts(testthat_abort_reporter = function() NULL, force(code))
where 28: 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 29: test_files(paths, reporter = reporter, env = env, stop_on_failure = stop_on_failure,
stop_on_warning = stop_on_warning, wrap = wrap)
where 30: 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 31: 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 32: 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: 0x55768b2ab9c8>
<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