This page was generated on 2020-10-17 11:57:28 -0400 (Sat, 17 Oct 2020).
##############################################################################
##############################################################################
###
### Running command:
###
### C:\Users\biocbuild\bbs-3.11-bioc\R\bin\R.exe CMD check --force-multiarch --install=check:Prize.install-out.txt --library=C:\Users\biocbuild\bbs-3.11-bioc\R\library --no-vignettes --timings Prize_1.18.0.tar.gz
###
##############################################################################
##############################################################################
* using log directory 'C:/Users/biocbuild/bbs-3.11-bioc/meat/Prize.Rcheck'
* using R version 4.0.3 (2020-10-10)
* using platform: x86_64-w64-mingw32 (64-bit)
* using session charset: ISO8859-1
* using option '--no-vignettes'
* checking for file 'Prize/DESCRIPTION' ... OK
* checking extension type ... Package
* this is package 'Prize' version '1.18.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 whether package 'Prize' 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
* loading checks for arch 'i386'
** 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
* loading checks for arch 'x64'
** 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 files in 'vignettes' ... OK
* checking examples ...
** running examples for arch 'i386' ... ERROR
Running examples in 'Prize-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: AIJ
> ### Title: Aggregated individual judgements (AIJ) slot
> ### Aliases: AIJ aij Aij AIJ,ANY-method
>
> ### ** Examples
>
> mat <- matrix(nrow = 4, ncol = 1, data = NA)
> mat[,1] <- c(system.file('extdata','ind1.tsv',package = 'Prize'),
+ system.file('extdata','ind2.tsv',package = 'Prize'),
+ system.file('extdata','ind3.tsv',package = 'Prize'),
+ system.file('extdata','ind4.tsv',package = 'Prize'))
> rownames(mat) <- c('ind1','ind2','ind3', 'ind4')
> colnames(mat) <- c('individual_judgement')
>
> # non-weighted aggregation
> res <- gaggregate(srcfile = mat, method = 'geometric', simulation = 500)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
Prize
--- call from context ---
gaggregate(srcfile = mat, method = "geometric", simulation = 500)
--- call from argument ---
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
judge <- dim(x)[1]
ICRname <- as.character(rownames(x))
if (dim(x)[2] > 1 && !all(is.na(x[, 2]))) {
weights <- as.numeric(x[, 2])
if (sum(as.numeric(weights)) != 1) {
stop("Weights must add up to 1.")
}
}
else {
weights <- NULL
}
tmp <- list()
if (file.exists(as.character(x[1, 1]))) {
file <- read.delim(as.character(x[1, 1]), sep = "\t",
header = TRUE, row.names = 1)
nRow <- dim(file)[1]
nCol <- dim(file)[2]
rname <- rownames(file)
cname <- colnames(file)
}
else {
stop(paste(as.character(x[1, 1]), " is missing.", sep = ""))
}
message(paste("Reading individual judgements.", sep = ""))
for (i in seq_len(judge)) {
if (file.exists(as.character(x[i, 1]))) {
file <- read.delim(as.character(x[i, 1]), sep = "\t",
header = TRUE, row.names = 1)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (dim(file)[1] != dim(file)[2]) {
stop(paste(as.character(x[i, 1]), "is not a square/triangular matrix.",
sep = " "))
}
if (!is.numeric(as.matrix(file))) {
stop(paste(as.character(x[i, 1]), "is not a numeric matrix.",
sep = " "))
}
if (dim(file)[1] != nRow || dim(file)[2] != nCol) {
stop("Judgement matrices has different number of rows or columns.")
}
if (!all(rownames(file) == rname)) {
stop("Judgement matrices have different orders.")
}
if (all(is.na(file[upper.tri(file)])) || all(is.na(file[lower.tri(file)]))) {
out <- ahmatrix(file)
file <- as.matrix(out@ahp_matrix)
}
tmp <- append(tmp, list(file))
}
else {
stop(paste(as.character(x[i, 1]), " is missing.",
sep = ""))
}
}
} else {
stop("'srcfile' must be a matrix/datafram that include the path to individual judgement matrices (PCM) and their weights (optional).")
}
--- R stacktrace ---
where 1: gaggregate(srcfile = mat, method = "geometric", simulation = 500)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (srcfile, method = "geometric", simulation = 500)
{
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
judge <- dim(x)[1]
ICRname <- as.character(rownames(x))
if (dim(x)[2] > 1 && !all(is.na(x[, 2]))) {
weights <- as.numeric(x[, 2])
if (sum(as.numeric(weights)) != 1) {
stop("Weights must add up to 1.")
}
}
else {
weights <- NULL
}
tmp <- list()
if (file.exists(as.character(x[1, 1]))) {
file <- read.delim(as.character(x[1, 1]), sep = "\t",
header = TRUE, row.names = 1)
nRow <- dim(file)[1]
nCol <- dim(file)[2]
rname <- rownames(file)
cname <- colnames(file)
}
else {
stop(paste(as.character(x[1, 1]), " is missing.",
sep = ""))
}
message(paste("Reading individual judgements.", sep = ""))
for (i in seq_len(judge)) {
if (file.exists(as.character(x[i, 1]))) {
file <- read.delim(as.character(x[i, 1]), sep = "\t",
header = TRUE, row.names = 1)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (dim(file)[1] != dim(file)[2]) {
stop(paste(as.character(x[i, 1]), "is not a square/triangular matrix.",
sep = " "))
}
if (!is.numeric(as.matrix(file))) {
stop(paste(as.character(x[i, 1]), "is not a numeric matrix.",
sep = " "))
}
if (dim(file)[1] != nRow || dim(file)[2] != nCol) {
stop("Judgement matrices has different number of rows or columns.")
}
if (!all(rownames(file) == rname)) {
stop("Judgement matrices have different orders.")
}
if (all(is.na(file[upper.tri(file)])) || all(is.na(file[lower.tri(file)]))) {
out <- ahmatrix(file)
file <- as.matrix(out@ahp_matrix)
}
tmp <- append(tmp, list(file))
}
else {
stop(paste(as.character(x[i, 1]), " is missing.",
sep = ""))
}
}
}
else {
stop("'srcfile' must be a matrix/datafram that include the path to individual judgement matrices (PCM) and their weights (optional).")
}
x <- tmp
if (method == "geometric") {
message(paste("Aggregating individual judgements with geometric mean (AIJ).",
sep = " "))
if (is.null(weights)) {
tmp <- x[[1]]
iahp <- ahp(x[[1]], simulation = simulation)
CR <- iahp@saaty_inconsistency
IW <- iahp@weight
for (i in seq(from = 2, to = judge)) {
tmp <- tmp * x[[i]]
iahp <- ahp(x[[i]], simulation = simulation)
CR <- append(CR, iahp@saaty_inconsistency)
IW <- rbind(IW, iahp@weight)
}
gmean <- tmp^(1/judge)
names(CR) <- names(x)
IW = rbind(IW, ahp(gmean, simulation = simulation)@weight)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
else {
tmp <- x[[1]]^weights[1]
iahp <- ahp(x[[1]], simulation = simulation)
CR <- iahp@saaty_inconsistency
IW <- iahp@weight
for (i in seq(from = 2, to = judge)) {
tmp <- tmp * (x[[i]]^weights[i])
iahp <- ahp(x[[i]], simulation = simulation)
CR <- append(CR, iahp@saaty_inconsistency)
IW <- rbind(IW, iahp@weight)
}
gmean <- tmp
names(CR) <- ICRname
IW = rbind(IW, ahp(gmean, simulation = simulation)@weight)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
rmean <- gmean
names(CR) <- ICRname
message(paste("Computing group consistency ratio (GCR).",
sep = ""))
GCR <- numeric()
group_consistency_ratio <- numeric()
if (simulation > 0) {
GCR <- ahp(rmean, simulation = simulation)
group_consistency_ratio <- GCR@saaty_inconsistency
}
message(paste("Computing consensus index (CI).", sep = ""))
consensus_measure <- numeric()
for (i in seq_len(judge)) {
GCI <- 0
for (j in seq_len(nRow)) {
for (k in seq_len(nRow)) {
GCI <- GCI + (rmean[j, k] * x[[i]][k, j])
}
}
GCI <- GCI/(nRow^2)
consensus_measure <- append(consensus_measure, GCI)
}
names(consensus_measure) <- ICRname
return(new("geoAggreg", AIJ = rmean, GCR = group_consistency_ratio,
CI = consensus_measure, ICR = CR, IP = IW))
}
else if (method == "arithmetic") {
message(paste("Aggregating individual priorities with arithmetic mean (AIP).",
sep = " "))
if (is.null(weights)) {
temp <- ahp(x[[1]], simulation = simulation)
tmp <- temp@weight
CR <- temp@saaty_inconsistency
IW <- temp@weight
for (i in seq(from = 2, to = judge)) {
temp <- ahp(x[[i]], simulation = simulation)
tmp <- tmp + (temp@weight)
CR <- append(CR, temp@saaty_inconsistency)
IW <- rbind(IW, temp@weight)
}
tmp <- tmp/judge
amean <- tmp
names(CR) <- ICRname
IW <- rbind(IW, amean)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
else {
temp <- ahp(x[[1]], simulation = simulation)
tmp <- temp@weight
CR <- temp@saaty_inconsistency
IW <- temp@weight
tmp <- tmp * weights[1]
for (i in seq(from = 2, to = judge)) {
temp <- ahp(x[[i]], simulation = simulation)
tmp <- tmp + (temp@weight * weights[i])
CR <- append(CR, temp@saaty_inconsistency)
IW <- rbind(IW, temp@weight)
}
amean <- tmp
names(CR) <- ICRname
IW <- rbind(IW, amean)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
rmean <- amean
names(CR) <- ICRname
return(new("ariAggreg", AIP = rmean, ICR = CR, IP = IW))
}
else {
stop("Please choose one of the following methods: geometric, arithmetic")
}
}
<bytecode: 0x05df8fe0>
<environment: namespace:Prize>
--- function search by body ---
Function gaggregate in namespace Prize has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
** running examples for arch 'x64' ... ERROR
Running examples in 'Prize-Ex.R' failed
The error most likely occurred in:
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: AIJ
> ### Title: Aggregated individual judgements (AIJ) slot
> ### Aliases: AIJ aij Aij AIJ,ANY-method
>
> ### ** Examples
>
> mat <- matrix(nrow = 4, ncol = 1, data = NA)
> mat[,1] <- c(system.file('extdata','ind1.tsv',package = 'Prize'),
+ system.file('extdata','ind2.tsv',package = 'Prize'),
+ system.file('extdata','ind3.tsv',package = 'Prize'),
+ system.file('extdata','ind4.tsv',package = 'Prize'))
> rownames(mat) <- c('ind1','ind2','ind3', 'ind4')
> colnames(mat) <- c('individual_judgement')
>
> # non-weighted aggregation
> res <- gaggregate(srcfile = mat, method = 'geometric', simulation = 500)
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
Prize
--- call from context ---
gaggregate(srcfile = mat, method = "geometric", simulation = 500)
--- call from argument ---
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
judge <- dim(x)[1]
ICRname <- as.character(rownames(x))
if (dim(x)[2] > 1 && !all(is.na(x[, 2]))) {
weights <- as.numeric(x[, 2])
if (sum(as.numeric(weights)) != 1) {
stop("Weights must add up to 1.")
}
}
else {
weights <- NULL
}
tmp <- list()
if (file.exists(as.character(x[1, 1]))) {
file <- read.delim(as.character(x[1, 1]), sep = "\t",
header = TRUE, row.names = 1)
nRow <- dim(file)[1]
nCol <- dim(file)[2]
rname <- rownames(file)
cname <- colnames(file)
}
else {
stop(paste(as.character(x[1, 1]), " is missing.", sep = ""))
}
message(paste("Reading individual judgements.", sep = ""))
for (i in seq_len(judge)) {
if (file.exists(as.character(x[i, 1]))) {
file <- read.delim(as.character(x[i, 1]), sep = "\t",
header = TRUE, row.names = 1)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (dim(file)[1] != dim(file)[2]) {
stop(paste(as.character(x[i, 1]), "is not a square/triangular matrix.",
sep = " "))
}
if (!is.numeric(as.matrix(file))) {
stop(paste(as.character(x[i, 1]), "is not a numeric matrix.",
sep = " "))
}
if (dim(file)[1] != nRow || dim(file)[2] != nCol) {
stop("Judgement matrices has different number of rows or columns.")
}
if (!all(rownames(file) == rname)) {
stop("Judgement matrices have different orders.")
}
if (all(is.na(file[upper.tri(file)])) || all(is.na(file[lower.tri(file)]))) {
out <- ahmatrix(file)
file <- as.matrix(out@ahp_matrix)
}
tmp <- append(tmp, list(file))
}
else {
stop(paste(as.character(x[i, 1]), " is missing.",
sep = ""))
}
}
} else {
stop("'srcfile' must be a matrix/datafram that include the path to individual judgement matrices (PCM) and their weights (optional).")
}
--- R stacktrace ---
where 1: gaggregate(srcfile = mat, method = "geometric", simulation = 500)
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (srcfile, method = "geometric", simulation = 500)
{
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
judge <- dim(x)[1]
ICRname <- as.character(rownames(x))
if (dim(x)[2] > 1 && !all(is.na(x[, 2]))) {
weights <- as.numeric(x[, 2])
if (sum(as.numeric(weights)) != 1) {
stop("Weights must add up to 1.")
}
}
else {
weights <- NULL
}
tmp <- list()
if (file.exists(as.character(x[1, 1]))) {
file <- read.delim(as.character(x[1, 1]), sep = "\t",
header = TRUE, row.names = 1)
nRow <- dim(file)[1]
nCol <- dim(file)[2]
rname <- rownames(file)
cname <- colnames(file)
}
else {
stop(paste(as.character(x[1, 1]), " is missing.",
sep = ""))
}
message(paste("Reading individual judgements.", sep = ""))
for (i in seq_len(judge)) {
if (file.exists(as.character(x[i, 1]))) {
file <- read.delim(as.character(x[i, 1]), sep = "\t",
header = TRUE, row.names = 1)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (dim(file)[1] != dim(file)[2]) {
stop(paste(as.character(x[i, 1]), "is not a square/triangular matrix.",
sep = " "))
}
if (!is.numeric(as.matrix(file))) {
stop(paste(as.character(x[i, 1]), "is not a numeric matrix.",
sep = " "))
}
if (dim(file)[1] != nRow || dim(file)[2] != nCol) {
stop("Judgement matrices has different number of rows or columns.")
}
if (!all(rownames(file) == rname)) {
stop("Judgement matrices have different orders.")
}
if (all(is.na(file[upper.tri(file)])) || all(is.na(file[lower.tri(file)]))) {
out <- ahmatrix(file)
file <- as.matrix(out@ahp_matrix)
}
tmp <- append(tmp, list(file))
}
else {
stop(paste(as.character(x[i, 1]), " is missing.",
sep = ""))
}
}
}
else {
stop("'srcfile' must be a matrix/datafram that include the path to individual judgement matrices (PCM) and their weights (optional).")
}
x <- tmp
if (method == "geometric") {
message(paste("Aggregating individual judgements with geometric mean (AIJ).",
sep = " "))
if (is.null(weights)) {
tmp <- x[[1]]
iahp <- ahp(x[[1]], simulation = simulation)
CR <- iahp@saaty_inconsistency
IW <- iahp@weight
for (i in seq(from = 2, to = judge)) {
tmp <- tmp * x[[i]]
iahp <- ahp(x[[i]], simulation = simulation)
CR <- append(CR, iahp@saaty_inconsistency)
IW <- rbind(IW, iahp@weight)
}
gmean <- tmp^(1/judge)
names(CR) <- names(x)
IW = rbind(IW, ahp(gmean, simulation = simulation)@weight)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
else {
tmp <- x[[1]]^weights[1]
iahp <- ahp(x[[1]], simulation = simulation)
CR <- iahp@saaty_inconsistency
IW <- iahp@weight
for (i in seq(from = 2, to = judge)) {
tmp <- tmp * (x[[i]]^weights[i])
iahp <- ahp(x[[i]], simulation = simulation)
CR <- append(CR, iahp@saaty_inconsistency)
IW <- rbind(IW, iahp@weight)
}
gmean <- tmp
names(CR) <- ICRname
IW = rbind(IW, ahp(gmean, simulation = simulation)@weight)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
rmean <- gmean
names(CR) <- ICRname
message(paste("Computing group consistency ratio (GCR).",
sep = ""))
GCR <- numeric()
group_consistency_ratio <- numeric()
if (simulation > 0) {
GCR <- ahp(rmean, simulation = simulation)
group_consistency_ratio <- GCR@saaty_inconsistency
}
message(paste("Computing consensus index (CI).", sep = ""))
consensus_measure <- numeric()
for (i in seq_len(judge)) {
GCI <- 0
for (j in seq_len(nRow)) {
for (k in seq_len(nRow)) {
GCI <- GCI + (rmean[j, k] * x[[i]][k, j])
}
}
GCI <- GCI/(nRow^2)
consensus_measure <- append(consensus_measure, GCI)
}
names(consensus_measure) <- ICRname
return(new("geoAggreg", AIJ = rmean, GCR = group_consistency_ratio,
CI = consensus_measure, ICR = CR, IP = IW))
}
else if (method == "arithmetic") {
message(paste("Aggregating individual priorities with arithmetic mean (AIP).",
sep = " "))
if (is.null(weights)) {
temp <- ahp(x[[1]], simulation = simulation)
tmp <- temp@weight
CR <- temp@saaty_inconsistency
IW <- temp@weight
for (i in seq(from = 2, to = judge)) {
temp <- ahp(x[[i]], simulation = simulation)
tmp <- tmp + (temp@weight)
CR <- append(CR, temp@saaty_inconsistency)
IW <- rbind(IW, temp@weight)
}
tmp <- tmp/judge
amean <- tmp
names(CR) <- ICRname
IW <- rbind(IW, amean)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
else {
temp <- ahp(x[[1]], simulation = simulation)
tmp <- temp@weight
CR <- temp@saaty_inconsistency
IW <- temp@weight
tmp <- tmp * weights[1]
for (i in seq(from = 2, to = judge)) {
temp <- ahp(x[[i]], simulation = simulation)
tmp <- tmp + (temp@weight * weights[i])
CR <- append(CR, temp@saaty_inconsistency)
IW <- rbind(IW, temp@weight)
}
amean <- tmp
names(CR) <- ICRname
IW <- rbind(IW, amean)
rownames(IW) <- append(rownames(srcfile), "Group judgement")
}
rmean <- amean
names(CR) <- ICRname
return(new("ariAggreg", AIP = rmean, ICR = CR, IP = IW))
}
else {
stop("Please choose one of the following methods: geometric, arithmetic")
}
}
<bytecode: 0x000000000a93b328>
<environment: namespace:Prize>
--- function search by body ---
Function gaggregate in namespace Prize has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
* checking for unstated dependencies in 'tests' ... OK
* checking tests ...
** running tests for arch 'i386' ...
Running 'runTests.R'
ERROR
Running the tests in 'tests/runTests.R' failed.
Last 13 lines of output:
tmp[lower.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
return(new("ahmatrixObj", ahp_matrix = x))
}
<bytecode: 0x03c7cb88>
<environment: namespace:Prize>
--- function search by body ---
Function ahmatrix in namespace Prize has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
** running tests for arch 'x64' ...
Running 'runTests.R'
ERROR
Running the tests in 'tests/runTests.R' failed.
Last 13 lines of output:
tmp[lower.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
return(new("ahmatrixObj", ahp_matrix = x))
}
<bytecode: 0x0000000007e25490>
<environment: namespace:Prize>
--- function search by body ---
Function ahmatrix in namespace Prize 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: 4 ERRORs
See
'C:/Users/biocbuild/bbs-3.11-bioc/meat/Prize.Rcheck/00check.log'
for details.
Prize.Rcheck/tests_i386/runTests.Rout.fail
R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out"
Copyright (C) 2020 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.
> BiocGenerics:::testPackage("Prize")
Loading required package: shape
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
Prize
--- call from context ---
ahmatrix(ahmat)
--- call from argument ---
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
} else {
if (file.exists(srcfile)) {
x <- read.delim(srcfile, sep = "\t", header = TRUE, row.names = 1)
}
else {
stop("\"srcfile\" is missing.")
}
}
--- R stacktrace ---
where 1: ahmatrix(ahmat)
where 2: func()
where 3: system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest)
where 4: doTryCatch(return(expr), name, parentenv, handler)
where 5: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 6: tryCatchList(expr, classes, parentenv, handlers)
where 7: tryCatch(expr, error = function(e) {
call <- conditionCall(e)
if (!is.null(call)) {
if (identical(call[[1L]], quote(doTryCatch)))
call <- sys.call(-4L)
dcall <- deparse(call)[1L]
prefix <- paste("Error in", dcall, ": ")
LONG <- 75L
sm <- strsplit(conditionMessage(e), "\n")[[1L]]
w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")
if (is.na(w))
w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],
type = "b")
if (w > LONG)
prefix <- paste0(prefix, "\n ")
}
else prefix <- "Error : "
msg <- paste0(prefix, conditionMessage(e), "\n")
.Internal(seterrmessage(msg[1L]))
if (!silent && isTRUE(getOption("show.error.messages"))) {
cat(msg, file = outFile)
.Internal(printDeferredWarnings())
}
invisible(structure(msg, class = "try-error", condition = e))
})
where 8: try(system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest))
where 9: .executeTestCase(funcName, envir = sandbox, setUpFunc = .setUp,
tearDownFunc = .tearDown)
where 10: .sourceTestFile(testFile, testSuite$testFuncRegexp)
where 11: RUnit::runTestSuite(suite)
where 12: BiocGenerics:::testPackage("Prize")
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (x)
{
srcfile <- x
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
}
else {
if (file.exists(srcfile)) {
x <- read.delim(srcfile, sep = "\t", header = TRUE,
row.names = 1)
}
else {
stop("\"srcfile\" is missing.")
}
}
x <- as.matrix(x)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (all(is.na(x[upper.tri(x)]))) {
lower <- TRUE
upper <- FALSE
x[upper.tri(x, diag = TRUE)] = 0
}
else if (all(is.na(x[lower.tri(x)]))) {
upper <- TRUE
lower <- FALSE
x[lower.tri(x, diag = TRUE)] = 0
}
else {
stop("\"srcfile\" is not a triangular matrix.")
}
if (length(which(x == Inf, arr.ind = TRUE)) > 0 || length(which(is.na(x) ==
TRUE, arr.ind = TRUE)) > 0) {
stop("infinite or missing values in the triangular matrix")
}
if (upper == TRUE) {
x[lower.tri(x)] <- 0
tmp <- t(1/(x))
tmp[upper.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
if (lower == TRUE) {
x[upper.tri(x)] <- 0
tmp <- t(1/(x))
tmp[lower.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
return(new("ahmatrixObj", ahp_matrix = x))
}
<bytecode: 0x03c7cb88>
<environment: namespace:Prize>
--- function search by body ---
Function ahmatrix in namespace Prize has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
|
Prize.Rcheck/tests_x64/runTests.Rout.fail
R version 4.0.3 (2020-10-10) -- "Bunny-Wunnies Freak Out"
Copyright (C) 2020 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.
> BiocGenerics:::testPackage("Prize")
Loading required package: shape
----------- FAILURE REPORT --------------
--- failure: the condition has length > 1 ---
--- srcref ---
:
--- package (from environment) ---
Prize
--- call from context ---
ahmatrix(ahmat)
--- call from argument ---
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
} else {
if (file.exists(srcfile)) {
x <- read.delim(srcfile, sep = "\t", header = TRUE, row.names = 1)
}
else {
stop("\"srcfile\" is missing.")
}
}
--- R stacktrace ---
where 1: ahmatrix(ahmat)
where 2: func()
where 3: system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest)
where 4: doTryCatch(return(expr), name, parentenv, handler)
where 5: tryCatchOne(expr, names, parentenv, handlers[[1L]])
where 6: tryCatchList(expr, classes, parentenv, handlers)
where 7: tryCatch(expr, error = function(e) {
call <- conditionCall(e)
if (!is.null(call)) {
if (identical(call[[1L]], quote(doTryCatch)))
call <- sys.call(-4L)
dcall <- deparse(call)[1L]
prefix <- paste("Error in", dcall, ": ")
LONG <- 75L
sm <- strsplit(conditionMessage(e), "\n")[[1L]]
w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w")
if (is.na(w))
w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L],
type = "b")
if (w > LONG)
prefix <- paste0(prefix, "\n ")
}
else prefix <- "Error : "
msg <- paste0(prefix, conditionMessage(e), "\n")
.Internal(seterrmessage(msg[1L]))
if (!silent && isTRUE(getOption("show.error.messages"))) {
cat(msg, file = outFile)
.Internal(printDeferredWarnings())
}
invisible(structure(msg, class = "try-error", condition = e))
})
where 8: try(system.time(func(), gcFirst = RUnitEnv$.gcBeforeTest))
where 9: .executeTestCase(funcName, envir = sandbox, setUpFunc = .setUp,
tearDownFunc = .tearDown)
where 10: .sourceTestFile(testFile, testSuite$testFuncRegexp)
where 11: RUnit::runTestSuite(suite)
where 12: BiocGenerics:::testPackage("Prize")
--- value of length: 2 type: logical ---
[1] TRUE FALSE
--- function from context ---
function (x)
{
srcfile <- x
if (class(srcfile) %in% c("matrix", "data.frame")) {
x <- as.matrix(srcfile)
}
else {
if (file.exists(srcfile)) {
x <- read.delim(srcfile, sep = "\t", header = TRUE,
row.names = 1)
}
else {
stop("\"srcfile\" is missing.")
}
}
x <- as.matrix(x)
if (length(which(x == 0, arr.ind = TRUE)) > 0) {
stop("Zero is not allowed in the matrix, infinite values are being created in the square matrix.")
}
if (all(is.na(x[upper.tri(x)]))) {
lower <- TRUE
upper <- FALSE
x[upper.tri(x, diag = TRUE)] = 0
}
else if (all(is.na(x[lower.tri(x)]))) {
upper <- TRUE
lower <- FALSE
x[lower.tri(x, diag = TRUE)] = 0
}
else {
stop("\"srcfile\" is not a triangular matrix.")
}
if (length(which(x == Inf, arr.ind = TRUE)) > 0 || length(which(is.na(x) ==
TRUE, arr.ind = TRUE)) > 0) {
stop("infinite or missing values in the triangular matrix")
}
if (upper == TRUE) {
x[lower.tri(x)] <- 0
tmp <- t(1/(x))
tmp[upper.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
if (lower == TRUE) {
x[upper.tri(x)] <- 0
tmp <- t(1/(x))
tmp[lower.tri(tmp)] <- 0
tmp[!is.finite(tmp)] <- 0
x <- x + tmp
diag(x) <- 1
x <- as.matrix(x)
}
return(new("ahmatrixObj", ahp_matrix = x))
}
<bytecode: 0x0000000007e25490>
<environment: namespace:Prize>
--- function search by body ---
Function ahmatrix in namespace Prize has this body.
----------- END OF FAILURE REPORT --------------
Fatal error: the condition has length > 1
|