Running examples in ‘trinROC-Ex.R’ failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: roc.eda
> ### Title: Exploratory data analysis for a three-class ROC marker
> ### Aliases: roc.eda
> 
> ### ** Examples
> 
> data(krebs)
> 
> # empirical EDA:
> roc.eda(dat = krebs[,c(1,5)], type = "e", plotVUS = FALSE)

 Data overview of empirical ROC Classifier 
--------------------------------------------------------------------- 

 Applied test: Bootstrap test 
 Significance level: 0.05
 Alternative hypothesis: two.sided
--------------------------------------------------------------------- 
 data: healthy, intermediate and diseased

 Boot statistic: 1.5 ,  Boot p.value: 0.13365 

 empirical VUS: 0.283 
--------------------------------------------------------------------- 
> 
> # equal data input via:
> x <- with(krebs, krebs[trueClass=="healthy", 5])
> y <- with(krebs, krebs[trueClass=="intermediate", 5])
> z <- with(krebs, krebs[trueClass=="diseased", 5])
> ## Not run: 
> ##D    roc.eda(x, y, z, type = "e", sep.dens = TRUE)
> ## End(Not run)
> 
> data(cancer)
> # trinormal EDA:
> roc.eda(dat = cancer[,c(1,10)], type = "trin", plotVUS = FALSE)
 ----------- FAILURE REPORT -------------- 
 --- failure: the condition has length > 1 ---
 --- srcref --- 
: 
 --- package (from environment) --- 
trinROC
 --- call from context --- 
trinROC.test(x, y, z, conf.level = conf.level)
 --- call from argument --- 
if (class(try(solve(covariance), silent = T)) != "matrix") {
    chi2 <- 0
    print("matrix is not invertible. Conclude complete alikeness.")
} else {
    test <- t(c(A1 - A2, B1 - B2, C1 - C2, D1 - D2)) %*% solve(covariance) %*% 
        c(A1 - A2, B1 - B2, C1 - C2, D1 - D2)
    chi2 <- as.numeric(test)
}
 --- R stacktrace ---
where 1: trinROC.test(x, y, z, conf.level = conf.level)
where 2: withCallingHandlers(expr, warning = function(w) invokeRestart("muffleWarning"))
where 3: suppressWarnings(trinROC.test(x, y, z, conf.level = conf.level))
where 4: roc.eda(dat = cancer[, c(1, 10)], type = "trin", plotVUS = FALSE)

 --- value of length: 2 type: logical ---
[1] FALSE  TRUE
 --- function from context --- 
function (x1, y1, z1, x2 = 0, y2 = 0, z2 = 0, dat = NULL, paired = FALSE, 
    conf.level = 0.95) 
{
    alternative <- "two.sided"
    if (!missing(conf.level) & (length(conf.level) != 1 | !is.finite(conf.level) | 
        conf.level < 0 | conf.level > 1)) 
        stop("'conf.level' must be a single number between 0 and 1")
    if (!is.null(dat)) {
        if (class(dat) != "data.frame" || class(dat[, 1]) != 
            "factor" | ncol(dat) <= 1) 
            stop("Data should be organized as a data frame with the group index factor at\n           the first column and marker measurements at the second and third column.")
        if (any(sapply(1:(ncol(dat) - 1), function(i) class(dat[, 
            i + 1]) != "numeric"))) {
            for (i in 1:(ncol(dat) - 1)) {
                if (class(dat[, i + 1]) != "numeric") 
                  dat[, (i + 1)] <- as.numeric(dat[, (i + 1)])
            }
            warning("Some measurements were not numeric. Forced to numeric.")
        }
        data.temp <- split(dat[, 2], dat[, 1], drop = FALSE)
        x1 <- data.temp[[1]]
        y1 <- data.temp[[2]]
        z1 <- data.temp[[3]]
        if (ncol(dat) > 2) {
            data.temp <- split(dat[, 3], dat[, 1], drop = FALSE)
            x2 <- data.temp[[1]]
            y2 <- data.temp[[2]]
            z2 <- data.temp[[3]]
        }
    }
    if (any(is.na(c(x1, x2)))) {
        warning("there are NA's in the healthy classes which are omitted.")
        if (paired) {
            delx <- complete.cases(cbind(x1, x2))
            x.1 <- x1[delx]
            x.2 <- x2[delx]
        }
        else {
            x.1 <- as.numeric(na.omit(x1))
            x.2 <- as.numeric(na.omit(x2))
        }
    }
    else {
        x.1 <- x1
        x.2 <- x2
    }
    if (any(is.na(c(y1, y2)))) {
        warning("there are NA's in the intermediate classes which are omitted.")
        if (paired) {
            dely <- complete.cases(cbind(y1, y2))
            y.1 <- y1[dely]
            y.2 <- y2[dely]
        }
        else {
            y.1 <- as.numeric(na.omit(y1))
            y.2 <- as.numeric(na.omit(y2))
        }
    }
    else {
        y.1 <- y1
        y.2 <- y2
    }
    if (any(is.na(c(z1, z2)))) {
        warning("there are NA's in the diseased classes which are omitted.")
        if (paired) {
            delz <- complete.cases(cbind(z1, z2))
            z.1 <- z1[delz]
            z.2 <- z2[delz]
        }
        else {
            z.1 <- as.numeric(na.omit(z1))
            z.2 <- as.numeric(na.omit(z2))
        }
    }
    else {
        z.1 <- z1
        z.2 <- z2
    }
    if (length(x.2) == 1 && length(y.2) == 1 && length(z.2) == 
        1) {
        twocurves <- FALSE
        method <- "Trinormal based ROC test for single classifier assessment"
        dname <- if (!is.null(dat)) {
            paste(c(levels(dat[, 1]), "of", names(dat)[2]), collapse = "  ")
        }
        else {
            paste(deparse(substitute(x1)), deparse(substitute(y1)), 
                "and", deparse(substitute(z1)))
        }
    }
    else {
        if ((paired) && (length(x.1) != length(x.2) || length(y.1) != 
            length(y.2) || length(z.1) != length(z.2))) 
            stop("The two test sets do not have equal size.")
        twocurves <- TRUE
        method <- "Trinormal based ROC test for comparison of two independent classifiers"
        dname <- if (!is.null(dat)) {
            paste(c(levels(dat[, 1]), "of", names(dat)[2], " and ", 
                levels(dat[, 1]), "of", names(dat)[3]), collapse = " ")
        }
        else {
            paste(deparse(substitute(x1)), deparse(substitute(y1)), 
                deparse(substitute(z1)), "and", deparse(substitute(x2)), 
                deparse(substitute(y2)), deparse(substitute(z2)))
        }
    }
    mux1 <- mean(x.1)
    sdx1 <- SD(x.1)
    muy1 <- mean(y.1)
    sdy1 <- SD(y.1)
    muz1 <- mean(z.1)
    sdz1 <- SD(z.1)
    nh1 <- length(x.1)
    nh2 <- length(x.2)
    n01 <- length(y.1)
    n02 <- length(y.2)
    nd1 <- length(z.1)
    nd2 <- length(z.2)
    if (nh1 < 2 || n01 < 2 || nd1 < 2) 
        stop("not enough observations (you need at least two observations in each class).")
    summary.dat <- data.frame(n = c(nh1, n01, nd1), mu = c(mux1, 
        muy1, muz1), sd = c(sdx1, sdy1, sdz1), row.names = c("healthy", 
        "intermediate", "diseased"))
    if (any(c(sdx1, sdy1, sdz1) < 10 * .Machine$double.eps * 
        abs(c(mux1, muy1, muz1)))) 
        stop("data of Classifier 1 is essentially constant")
    mux2 <- 0
    sdx2 <- 0
    muy2 <- 0
    sdy2 <- 0
    muz2 <- 0
    sdz2 <- 0
    if (twocurves) {
        mux2 <- mean(x.2)
        sdx2 <- SD(x.2)
        muy2 <- mean(y.2)
        sdy2 <- SD(y.2)
        muz2 <- mean(z.2)
        sdz2 <- SD(z.2)
        if (any(c(sdx2, sdy2, sdz2) < 10 * .Machine$double.eps * 
            abs(c(mux2, muy2, muz2)))) 
            stop("data of Classifier 2 is essentially constant")
        summary.dat2 <- data.frame(n = c(nh2, n02, nd2), mu = c(mux2, 
            muy2, muz2), sd = c(sdx2, sdy2, sdz2), row.names = c("healthy", 
            "intermediate", "diseased"))
        summary.dat <- list(Classifier1 = summary.dat, Classifier2 = summary.dat2)
    }
    rho.h <- 0
    rho.0 <- 0
    rho.d <- 0
    if (paired) {
        rho.h <- COV(x.1, x.2)/(sdx1 * sdx2)
        rho.0 <- COV(y.1, y.2)/(sdy1 * sdy2)
        rho.d <- COV(z.1, z.2)/(sdz1 * sdz2)
        method <- "Trinormal based ROC test for comparison of paired ROC surfaces"
    }
    A1 <- sdy1/sdx1
    B1 <- (mux1 - muy1)/sdx1
    C1 <- sdy1/sdz1
    D1 <- (muz1 - muy1)/sdz1
    A2 <- 1
    B2 <- 0
    C2 <- 1
    D2 <- 0
    if (twocurves) {
        A2 <- sdy2/sdx2
        B2 <- (mux2 - muy2)/sdx2
        C2 <- sdy2/sdz2
        D2 <- (muz2 - muy2)/sdz2
    }
    varA <- (A1^2/2) * (1/n01 + 1/nh1) + twocurves * ((A2^2/2) * 
        (1/n02 + 1/nh2)) - paired * (A1 * A2 * rho.0^2/n01 + 
        A1 * A2 * rho.h^2/nh1)
    varB <- A1^2/n01 + 1/nh1 + B1^2/(2 * nh1) + twocurves * (A2^2/n02 + 
        1/nh2 + B2^2/(2 * nh2)) - paired * 2 * (A1 * A2 * rho.0/n01 + 
        rho.h/nh1 + B1 * B2 * rho.h^2/(2 * nh1))
    varC <- (C1^2/2) * (1/nd1 + 1/n01) + twocurves * ((C2^2/2) * 
        (1/nd2 + 1/n02)) - paired * (C1 * C2 * rho.0^2/n01 + 
        C1 * C2 * rho.d^2/nd1)
    varD <- C1^2/n01 + 1/nd1 + D1^2/(2 * nd1) + twocurves * (C2^2/n02 + 
        1/nd2 + D2^2/(2 * nd2)) - paired * 2 * (C1 * C2 * rho.0/n01 + 
        rho.d/nd1 + D1 * D2 * rho.d^2/(2 * nd1))
    covAB <- A1 * B1/(2 * nh1) + twocurves * (A2 * B2/(2 * nh2)) - 
        paired * (A1 * B2 * rho.h^2/(2 * nh1) + A2 * B1 * rho.h^2/(2 * 
            nh1))
    covAC <- A1 * C1/(2 * n01) + twocurves * (A2 * C2/(2 * n02)) - 
        paired * (A1 * C2 * rho.0^2/(2 * n01) + A2 * C1 * rho.0^2/(2 * 
            n01))
    covAD <- 0
    covBC <- 0
    covBD <- A1 * C1/n01 + twocurves * (A2 * C2/n02) - paired * 
        (A1 * C2 * rho.0/n01 + A2 * C1 * rho.0/n01)
    covCD <- C1 * D1/(2 * nd1) + twocurves * (C2 * D2/(2 * nd2)) - 
        paired * (C2 * D1 * rho.d^2/(2 * nd1) + C1 * D2 * rho.d^2/(2 * 
            nd1))
    covariance <- matrix(c(varA, covAB, covAC, covAD, covAB, 
        varB, covBC, covBD, covAC, covBC, varC, covCD, covAD, 
        covBD, covCD, varD), 4, 4)
    if (class(try(solve(covariance), silent = T)) != "matrix") {
        chi2 <- 0
        print("matrix is not invertible. Conclude complete alikeness.")
    }
    else {
        test <- t(c(A1 - A2, B1 - B2, C1 - C2, D1 - D2)) %*% 
            solve(covariance) %*% c(A1 - A2, B1 - B2, C1 - C2, 
            D1 - D2)
        chi2 <- as.numeric(test)
    }
    vus.1 <- 0
    vus.2 <- 1/6
    dvus1 <- function(x) {
        pnorm(A1 * x - B1) * pnorm(-C1 * x + D1) * dnorm(x)
    }
    vus.1 <- integrate(dvus1, -Inf, Inf)$value
    if (twocurves) {
        dvus2 <- function(x) {
            pnorm(A2 * x - B2) * pnorm(-C2 * x + D2) * dnorm(x)
        }
        vus.2 <- integrate(dvus2, -Inf, Inf)$value
    }
    df <- 4
    names(df) <- "df"
    names(chi2) <- "Chi-Squared test"
    mekro.p <- pchisq(chi2, df, lower.tail = FALSE)
    cint <- c(0, qchisq(conf.level, df))
    attr(cint, "conf.level") <- conf.level
    param <- as.data.frame(matrix(c(vus.1, A1, B1, C1, D1), nrow = 1))
    colnames(param) <- c("VUS", "a", "b", "c", "d")
    rownames(param) <- "Classifier1:"
    if (twocurves) {
        param[2, ] <- c(vus.2, A2, B2, C2, D2)
        rownames(param)[2] <- "Classifier2:"
    }
    if (!is.null(dat)) {
        rownames(param)[1] <- names(dat)[2]
        if (class(summary.dat) == "list") 
            names(summary.dat)[1] <- names(dat)[2]
        if (ncol(dat) > 2) {
            rownames(param)[2] <- names(dat)[3]
            names(summary.dat)[2] <- names(dat)[3]
        }
    }
    null.value <- 0
    names(null.value) <- "a1-a2, b1-b1, c1-c2 and d1-d2"
    rval <- list(statistic = chi2, parameter = df, p.value = unname(mekro.p), 
        conf.int = NULL, estimate = param, null.value = null.value, 
        alternative = alternative, method = method, data.name = dname, 
        CovMat = covariance, Summary = summary.dat)
    class(rval) <- "htest"
    return(rval)
}
<bytecode: 0x55c1fc650ab0>
<environment: namespace:trinROC>
 --- function search by body ---
Function trinROC.test in namespace trinROC has this body.
 ----------- END OF FAILURE REPORT -------------- 
Fatal error: the condition has length > 1