Running ‘testthat.R’ [99s/105s]
Running the tests in ‘tests/testthat.R’ failed.
Complete output:
  > library(testthat)
  > library(survxai)
  Loading required package: prodlim
  Welcome to survxai (version: 0.2.0).
  Information about the package can be found in the GitHub repository: https://github.com/MI2DataLab/survxai
  > 
  > test_check("survxai")
  ── 1. Error: (unknown) (@test_plot_ceteris_paribus.R#3)  ───────────────────────
  arguments imply differing number of rows: 0, 138
  1: source("objects_for_tests.R") at testthat/test_plot_ceteris_paribus.R:3
  2: withVisible(eval(ei, envir))
  3: eval(ei, envir)
  4: eval(ei, envir)
  5: model_performance(surve_rf)
  6: tryCatch({
         p <- pec(explainer$model, data = data, splitMethod = "none", formula = reference_formula)
     }, error = function(e) {
         p <- pec(explainer, data = data, splitMethod = "none", formula = reference_formula, 
             reference = TRUE)
         return(p)
     })
  7: tryCatchList(expr, classes, parentenv, handlers)
  8: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  9: value[[3L]](cond)
  10: pec(explainer, data = data, splitMethod = "none", formula = reference_formula, reference = TRUE)
  ...
  17: predict(object, newdata = newdata, importance = "none")
  18: predict.rfsrc(object, newdata = newdata, importance = "none")
  19: generic.predict.rfsrc(object, newdata, ensemble = ensemble, m.target = m.target, 
         importance = importance, block.size = block.size, na.action = na.action, outcome = outcome, 
         proximity = proximity, forest.wt = forest.wt, ptn.count = ptn.count, distance = distance, 
         var.used = var.used, split.depth = split.depth, seed = seed, do.trace = do.trace, 
         membership = membership, statistics = statistics, ...)
  20: map.factor(xvar.newdata, xfactor)
  21: data.frame(mclapply(1:length(gfactor$factor), function(k) {
         ptk <- (colnames(gvar) == gfactor$factor[k])
         factor.k <- gfactor$levels[[k]][gvar[, ptk]]
         labels.k <- gfactor$levels[[k]][sort(unique(gvar[, ptk]))]
         gk <- factor(factor.k, labels = labels.k, levels = labels.k, exclude = NULL)
         if (length(setdiff(gfactor$levels[[k]], labels.k)) > 0) {
             gk <- factor(as.character(gk), levels = gfactor$levels[[k]])
         }
         gk
     }))
  22: as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
  23: as.data.frame.list(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
  24: do.call(data.frame, c(x, alis))
  25: (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, fix.empty.names = TRUE, 
         stringsAsFactors = default.stringsAsFactors()) 
     {
         data.row.names <- if (check.rows && is.null(row.names)) 
             function(current, new, i) {
                 if (is.character(current)) 
                     new <- as.character(new)
                 if (is.character(new)) 
                     current <- as.character(current)
                 if (anyDuplicated(new)) 
                     return(current)
                 if (is.null(current)) 
                     return(new)
                 if (all(current == new) || all(current == "")) 
                     return(new)
                 stop(gettextf("mismatch of row names in arguments of 'data.frame', item %d", 
                     i), domain = NA)
             }
         else function(current, new, i) {
             if (is.null(current)) {
                 if (anyDuplicated(new)) {
                     warning(gettextf("some row.names duplicated: %s --> row.names NOT used", 
                       paste(which(duplicated(new)), collapse = ",")), domain = NA)
                     current
                 }
                 else new
             }
             else current
         }
         object <- as.list(substitute(list(...)))[-1L]
         mirn <- missing(row.names)
         mrn <- is.null(row.names)
         x <- list(...)
         n <- length(x)
         if (n < 1L) {
             if (!mrn) {
                 if (is.object(row.names) || !is.integer(row.names)) 
                     row.names <- as.character(row.names)
                 if (anyNA(row.names)) 
                     stop("row names contain missing values")
                 if (anyDuplicated(row.names)) 
                     stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), 
                       collapse = ", ")), domain = NA)
             }
             else row.names <- integer()
             return(structure(list(), names = character(), row.names = row.names, class = "data.frame"))
         }
         vnames <- names(x)
         if (length(vnames) != n) 
             vnames <- character(n)
         no.vn <- !nzchar(vnames)
         vlist <- vnames <- as.list(vnames)
         nrows <- ncols <- integer(n)
         for (i in seq_len(n)) {
             xi <- if (is.character(x[[i]]) || is.list(x[[i]])) 
                 as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
             else as.data.frame(x[[i]], optional = TRUE)
             nrows[i] <- .row_names_info(xi)
             ncols[i] <- length(xi)
             namesi <- names(xi)
             if (ncols[i] > 1L) {
                 if (length(namesi) == 0L) 
                     namesi <- seq_len(ncols[i])
                 vnames[[i]] <- if (no.vn[i]) 
                     namesi
                 else paste(vnames[[i]], namesi, sep = ".")
             }
             else if (length(namesi)) {
                 vnames[[i]] <- namesi
             }
             else if (fix.empty.names && no.vn[[i]]) {
                 tmpname <- deparse(object[[i]], nlines = 1L)[1L]
                 if (substr(tmpname, 1L, 2L) == "I(") {
                     ntmpn <- nchar(tmpname, "c")
                     if (substr(tmpname, ntmpn, ntmpn) == ")") 
                       tmpname <- substr(tmpname, 3L, ntmpn - 1L)
                 }
                 vnames[[i]] <- tmpname
             }
             if (mirn && nrows[i] > 0L) {
                 rowsi <- attr(xi, "row.names")
                 if (any(nzchar(rowsi))) 
                     row.names <- data.row.names(row.names, rowsi, i)
             }
             nrows[i] <- abs(nrows[i])
             vlist[[i]] <- xi
         }
         nr <- max(nrows)
         for (i in seq_len(n)[nrows < nr]) {
             xi <- vlist[[i]]
             if (nrows[i] > 0L && (nr%%nrows[i] == 0L)) {
                 xi <- unclass(xi)
                 fixed <- TRUE
                 for (j in seq_along(xi)) {
                     xi1 <- xi[[j]]
                     if (is.vector(xi1) || is.factor(xi1)) 
                       xi[[j]] <- rep(xi1, length.out = nr)
                     else if (is.character(xi1) && inherits(xi1, "AsIs")) 
                       xi[[j]] <- structure(rep(xi1, length.out = nr), class = class(xi1))
                     else if (inherits(xi1, "Date") || inherits(xi1, "POSIXct")) 
                       xi[[j]] <- rep(xi1, length.out = nr)
                     else {
                       fixed <- FALSE
                       break
                     }
                 }
                 if (fixed) {
                     vlist[[i]] <- xi
                     next
                 }
             }
             stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), 
                 collapse = ", ")), domain = NA)
         }
         value <- unlist(vlist, recursive = FALSE, use.names = FALSE)
         vnames <- unlist(vnames[ncols > 0L])
         if (fix.empty.names && any(noname <- !nzchar(vnames))) 
             vnames[noname] <- paste0("Var.", seq_along(vnames))[noname]
         if (check.names) {
             if (fix.empty.names) 
                 vnames <- make.names(vnames, unique = TRUE)
             else {
                 nz <- nzchar(vnames)
                 vnames[nz] <- make.names(vnames[nz], unique = TRUE)
             }
         }
         names(value) <- vnames
         if (!mrn) {
             if (length(row.names) == 1L && nr != 1L) {
                 if (is.character(row.names)) 
                     row.names <- match(row.names, vnames, 0L)
                 if (length(row.names) != 1L || row.names < 1L || row.names > length(vnames)) 
                     stop("'row.names' should specify one of the variables")
                 i <- row.names
                 row.names <- value[[i]]
                 value <- value[-i]
             }
             else if (!is.null(row.names) && length(row.names) != nr) 
                 stop("row names supplied are of the wrong length")
         }
         else if (!is.null(row.names) && length(row.names) != nr) {
             warning("row names were found from a short variable and have been discarded")
             row.names <- NULL
         }
         class(value) <- "data.frame"
         if (is.null(row.names)) 
             attr(value, "row.names") <- .set_row_names(nr)
         else {
             if (is.object(row.names) || !is.integer(row.names)) 
                 row.names <- as.character(row.names)
             if (anyNA(row.names)) 
                 stop("row names contain missing values")
             if (anyDuplicated(row.names)) 
                 stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), 
                     collapse = ", ")), domain = NA)
             row.names(value) <- row.names
         }
         value
     })(NULL, structure(c(4L, 4L, 4L, 3L, 4L, 3L, 4L, 4L, 3L, 4L, 4L, 4L, 3L, 3L, 3L, 
     3L, 4L, 4L, 2L, 2L, 4L, 4L, 2L, 3L, 3L, 2L, 4L, 4L, 4L, 2L, 3L, 2L, 4L, 3L, 4L, 2L, 
     3L, 4L, 4L, 4L, 3L, 4L, 4L, 3L, 1L, 3L, 3L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 3L, 
     3L, 4L, 4L, 4L, 3L, 3L, 1L, 2L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 3L, 3L, 4L, 4L, 
     3L, 2L, 2L, 3L, 2L, 3L, 4L, 3L, 4L, 4L, 2L, 3L, 3L, 4L, 2L, 3L, 3L, 4L, 4L, 3L, 4L, 
     4L, 2L, 3L, 2L, 2L, 1L, 2L, 3L, 3L, 2L, 2L, 3L, 4L, 2L, 1L, 2L, 3L, 2L, 3L, 3L, 3L, 
     3L, 4L, 4L, 3L, 3L, 2L, 2L, 2L, 1L, 3L, 4L, 3L, 1L, 3L, 3L, 3L, 4L, 2L), .Label = c("1", 
     "2", "3", "4"), class = "factor"), check.names = FALSE, fix.empty.names = TRUE, stringsAsFactors = TRUE)
  26: stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), 
         collapse = ", ")), domain = NA)
  
  Model label:  coxph 
  Model class:  cph,rms,coxph 
  Data head  :
    sex bili stage
  2   1  1.1     3
  3   0  1.4     4
        contribution
  bili       10.103%
  stage       7.714%
  sex         1.069%
  Model performance for Brier Score method.
          time prediction error
  1  0.1397260          ~ 0.75%
  2  0.1945205          ~ 1.43%
  3  0.3589041          ~ 2.28%
  4  0.3835616          ~ 2.99%
  5  0.5232877          ~ 3.96%
  6  0.5424658          ~ 4.67%
  7  0.5917808          ~ 4.24%
  8  0.6109589          ~ 4.86%
  9  0.8931507          ~ 5.69%
  10 1.2602740           ~ 6.6%
            x         y value type label var
  1 0.1397260 0.9922858     1  pdp coxph sex
  2 0.1945205 0.9922858     1  pdp coxph sex
  3 0.3589041 0.9762765     1  pdp coxph sex
  4 0.3835616 0.9762765     1  pdp coxph sex
  5 0.5232877 0.9613915     1  pdp coxph sex
  6 0.5424658 0.9613915     1  pdp coxph sex
        y_hat new_x vname x_quant quant relative_quant label      time  class
  1 0.9978522     0   sex       0     0              0 coxph 0.1397260 factor
  2 0.9978522     0   sex       0     0              0 coxph 0.1945205 factor
  3 0.9927118     0   sex       0     0              0 coxph 0.3589041 factor
  4 0.9927118     0   sex       0     0              0 coxph 0.3835616 factor
  5 0.9870411     0   sex       0     0              0 coxph 0.5232877 factor
  6 0.9870411     0   sex       0     0              0 coxph 0.5424658 factor
  ── 2. Error: (unknown) (@test_surv_model_performance.R#3)  ─────────────────────
  arguments imply differing number of rows: 0, 138
  1: source("objects_for_tests.R") at testthat/test_surv_model_performance.R:3
  2: withVisible(eval(ei, envir))
  3: eval(ei, envir)
  4: eval(ei, envir)
  5: model_performance(surve_rf)
  6: tryCatch({
         p <- pec(explainer$model, data = data, splitMethod = "none", formula = reference_formula)
     }, error = function(e) {
         p <- pec(explainer, data = data, splitMethod = "none", formula = reference_formula, 
             reference = TRUE)
         return(p)
     })
  7: tryCatchList(expr, classes, parentenv, handlers)
  8: tryCatchOne(expr, names, parentenv, handlers[[1L]])
  9: value[[3L]](cond)
  10: pec(explainer, data = data, splitMethod = "none", formula = reference_formula, reference = TRUE)
  ...
  17: predict(object, newdata = newdata, importance = "none")
  18: predict.rfsrc(object, newdata = newdata, importance = "none")
  19: generic.predict.rfsrc(object, newdata, ensemble = ensemble, m.target = m.target, 
         importance = importance, block.size = block.size, na.action = na.action, outcome = outcome, 
         proximity = proximity, forest.wt = forest.wt, ptn.count = ptn.count, distance = distance, 
         var.used = var.used, split.depth = split.depth, seed = seed, do.trace = do.trace, 
         membership = membership, statistics = statistics, ...)
  20: map.factor(xvar.newdata, xfactor)
  21: data.frame(mclapply(1:length(gfactor$factor), function(k) {
         ptk <- (colnames(gvar) == gfactor$factor[k])
         factor.k <- gfactor$levels[[k]][gvar[, ptk]]
         labels.k <- gfactor$levels[[k]][sort(unique(gvar[, ptk]))]
         gk <- factor(factor.k, labels = labels.k, levels = labels.k, exclude = NULL)
         if (length(setdiff(gfactor$levels[[k]], labels.k)) > 0) {
             gk <- factor(as.character(gk), levels = gfactor$levels[[k]])
         }
         gk
     }))
  22: as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
  23: as.data.frame.list(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
  24: do.call(data.frame, c(x, alis))
  25: (function (..., row.names = NULL, check.rows = FALSE, check.names = TRUE, fix.empty.names = TRUE, 
         stringsAsFactors = default.stringsAsFactors()) 
     {
         data.row.names <- if (check.rows && is.null(row.names)) 
             function(current, new, i) {
                 if (is.character(current)) 
                     new <- as.character(new)
                 if (is.character(new)) 
                     current <- as.character(current)
                 if (anyDuplicated(new)) 
                     return(current)
                 if (is.null(current)) 
                     return(new)
                 if (all(current == new) || all(current == "")) 
                     return(new)
                 stop(gettextf("mismatch of row names in arguments of 'data.frame', item %d", 
                     i), domain = NA)
             }
         else function(current, new, i) {
             if (is.null(current)) {
                 if (anyDuplicated(new)) {
                     warning(gettextf("some row.names duplicated: %s --> row.names NOT used", 
                       paste(which(duplicated(new)), collapse = ",")), domain = NA)
                     current
                 }
                 else new
             }
             else current
         }
         object <- as.list(substitute(list(...)))[-1L]
         mirn <- missing(row.names)
         mrn <- is.null(row.names)
         x <- list(...)
         n <- length(x)
         if (n < 1L) {
             if (!mrn) {
                 if (is.object(row.names) || !is.integer(row.names)) 
                     row.names <- as.character(row.names)
                 if (anyNA(row.names)) 
                     stop("row names contain missing values")
                 if (anyDuplicated(row.names)) 
                     stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), 
                       collapse = ", ")), domain = NA)
             }
             else row.names <- integer()
             return(structure(list(), names = character(), row.names = row.names, class = "data.frame"))
         }
         vnames <- names(x)
         if (length(vnames) != n) 
             vnames <- character(n)
         no.vn <- !nzchar(vnames)
         vlist <- vnames <- as.list(vnames)
         nrows <- ncols <- integer(n)
         for (i in seq_len(n)) {
             xi <- if (is.character(x[[i]]) || is.list(x[[i]])) 
                 as.data.frame(x[[i]], optional = TRUE, stringsAsFactors = stringsAsFactors)
             else as.data.frame(x[[i]], optional = TRUE)
             nrows[i] <- .row_names_info(xi)
             ncols[i] <- length(xi)
             namesi <- names(xi)
             if (ncols[i] > 1L) {
                 if (length(namesi) == 0L) 
                     namesi <- seq_len(ncols[i])
                 vnames[[i]] <- if (no.vn[i]) 
                     namesi
                 else paste(vnames[[i]], namesi, sep = ".")
             }
             else if (length(namesi)) {
                 vnames[[i]] <- namesi
             }
             else if (fix.empty.names && no.vn[[i]]) {
                 tmpname <- deparse(object[[i]], nlines = 1L)[1L]
                 if (substr(tmpname, 1L, 2L) == "I(") {
                     ntmpn <- nchar(tmpname, "c")
                     if (substr(tmpname, ntmpn, ntmpn) == ")") 
                       tmpname <- substr(tmpname, 3L, ntmpn - 1L)
                 }
                 vnames[[i]] <- tmpname
             }
             if (mirn && nrows[i] > 0L) {
                 rowsi <- attr(xi, "row.names")
                 if (any(nzchar(rowsi))) 
                     row.names <- data.row.names(row.names, rowsi, i)
             }
             nrows[i] <- abs(nrows[i])
             vlist[[i]] <- xi
         }
         nr <- max(nrows)
         for (i in seq_len(n)[nrows < nr]) {
             xi <- vlist[[i]]
             if (nrows[i] > 0L && (nr%%nrows[i] == 0L)) {
                 xi <- unclass(xi)
                 fixed <- TRUE
                 for (j in seq_along(xi)) {
                     xi1 <- xi[[j]]
                     if (is.vector(xi1) || is.factor(xi1)) 
                       xi[[j]] <- rep(xi1, length.out = nr)
                     else if (is.character(xi1) && inherits(xi1, "AsIs")) 
                       xi[[j]] <- structure(rep(xi1, length.out = nr), class = class(xi1))
                     else if (inherits(xi1, "Date") || inherits(xi1, "POSIXct")) 
                       xi[[j]] <- rep(xi1, length.out = nr)
                     else {
                       fixed <- FALSE
                       break
                     }
                 }
                 if (fixed) {
                     vlist[[i]] <- xi
                     next
                 }
             }
             stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), 
                 collapse = ", ")), domain = NA)
         }
         value <- unlist(vlist, recursive = FALSE, use.names = FALSE)
         vnames <- unlist(vnames[ncols > 0L])
         if (fix.empty.names && any(noname <- !nzchar(vnames))) 
             vnames[noname] <- paste0("Var.", seq_along(vnames))[noname]
         if (check.names) {
             if (fix.empty.names) 
                 vnames <- make.names(vnames, unique = TRUE)
             else {
                 nz <- nzchar(vnames)
                 vnames[nz] <- make.names(vnames[nz], unique = TRUE)
             }
         }
         names(value) <- vnames
         if (!mrn) {
             if (length(row.names) == 1L && nr != 1L) {
                 if (is.character(row.names)) 
                     row.names <- match(row.names, vnames, 0L)
                 if (length(row.names) != 1L || row.names < 1L || row.names > length(vnames)) 
                     stop("'row.names' should specify one of the variables")
                 i <- row.names
                 row.names <- value[[i]]
                 value <- value[-i]
             }
             else if (!is.null(row.names) && length(row.names) != nr) 
                 stop("row names supplied are of the wrong length")
         }
         else if (!is.null(row.names) && length(row.names) != nr) {
             warning("row names were found from a short variable and have been discarded")
             row.names <- NULL
         }
         class(value) <- "data.frame"
         if (is.null(row.names)) 
             attr(value, "row.names") <- .set_row_names(nr)
         else {
             if (is.object(row.names) || !is.integer(row.names)) 
                 row.names <- as.character(row.names)
             if (anyNA(row.names)) 
                 stop("row names contain missing values")
             if (anyDuplicated(row.names)) 
                 stop(gettextf("duplicate row.names: %s", paste(unique(row.names[duplicated(row.names)]), 
                     collapse = ", ")), domain = NA)
             row.names(value) <- row.names
         }
         value
     })(NULL, structure(c(4L, 4L, 4L, 3L, 4L, 3L, 4L, 4L, 3L, 4L, 4L, 4L, 3L, 3L, 3L, 
     3L, 4L, 4L, 2L, 2L, 4L, 4L, 2L, 3L, 3L, 2L, 4L, 4L, 4L, 2L, 3L, 2L, 4L, 3L, 4L, 2L, 
     3L, 4L, 4L, 4L, 3L, 4L, 4L, 3L, 1L, 3L, 3L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 3L, 
     3L, 4L, 4L, 4L, 3L, 3L, 1L, 2L, 4L, 4L, 3L, 3L, 3L, 3L, 3L, 4L, 4L, 3L, 3L, 4L, 4L, 
     3L, 2L, 2L, 3L, 2L, 3L, 4L, 3L, 4L, 4L, 2L, 3L, 3L, 4L, 2L, 3L, 3L, 4L, 4L, 3L, 4L, 
     4L, 2L, 3L, 2L, 2L, 1L, 2L, 3L, 3L, 2L, 2L, 3L, 4L, 2L, 1L, 2L, 3L, 2L, 3L, 3L, 3L, 
     3L, 4L, 4L, 3L, 3L, 2L, 2L, 2L, 1L, 3L, 4L, 3L, 1L, 3L, 3L, 3L, 4L, 2L), .Label = c("1", 
     "2", "3", "4"), class = "factor"), check.names = FALSE, fix.empty.names = TRUE, stringsAsFactors = TRUE)
  26: stop(gettextf("arguments imply differing number of rows: %s", paste(unique(nrows), 
         collapse = ", ")), domain = NA)
  
  ══ testthat results  ═══════════════════════════════════════════════════════════
  OK: 34 SKIPPED: 0 FAILED: 2
  1. Error: (unknown) (@test_plot_ceteris_paribus.R#3) 
  2. Error: (unknown) (@test_surv_model_performance.R#3) 
  
  Error: testthat unit tests failed
  Execution halted