Running ‘test-AUC.R’
  Running ‘test-BinomialRegression.R’ [9s/11s]
  Running ‘test-BrierScore.R’
  Running ‘test-CauseSpecificCoxRegression.R’
  Running ‘test-FineGrayRegression.R’
  Running ‘test-ate.R’ [11s/12s]
  Running ‘test-boxplotScore.R’
  Running ‘test-confidenceBand_vs_timereg.R’
  Running ‘test-iidCox.R’
  Running ‘test-phreg.R’
  Running ‘test-predictCSC_vs_mstate.R’ [17s/20s]
  Running ‘test-predictCox-CSC.R’
  Running ‘test-predictCox.R’
  Running ‘test-predictCox_vs_basehaz.R’
  Running ‘test-predictCox_vs_timereg.R’ [9s/11s]
  Running ‘test-predictRisk-TD.R’
  Running ‘test-predictRisk.R’
  Running ‘test-score.R’
Running the tests in ‘tests/test-AUC.R’ failed.
Complete output:
  > library(testthat)
  > context("Prediction error")
  > # {{{ "AUC censored data: order"
  > test_that("AUC censored data: order",{
  +     library(riskRegression)
  +     library(survival)
  +     library(prodlim)
  +     data(Melanoma)
  +     setDT(Melanoma)
  +     setkey(Melanoma,age)
  +     fit <- coxph(Surv(time,status!=0)~invasion+epicel+logthick,data=Melanoma,x=TRUE)
  +     a <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="marginal",metric="Auc")
  +     A <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="cox",metric="Auc")
  +     setkey(Melanoma,logthick)
  +     b <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="marginal",metric="Auc")
  +     B <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="cox",metric="Auc")
  +     a$call <- b$call <- A$call <- B$call <- NULL
  +     expect_equal(A,B)
  +     expect_equal(a,b)
  + })
  Error: Test failed: 'AUC censored data: order'
  * SETLENGTH() cannot be applied to an ALTVEC object.
  1: Score(list(fit), data = Melanoma, Surv(time, status != 0) ~ invasion + epicel + logthick, 
         cens.model = "marginal", metric = "Auc")
  2: Score.list(list(fit), data = Melanoma, Surv(time, status != 0) ~ invasion + epicel + 
         logthick, cens.model = "marginal", metric = "Auc")
  3: computePerformance(DT, N = N, se.fit = se.fit, conservative = conservative, cens.model, 
         multi.split.test = multi.split.test, keep.residuals = keep.residuals, keep.vcov = keep.vcov)
  4: do.call(paste(m, response.type, sep = "."), input)
  5: AUC.survival(DT = structure(list(ID = c(1L, 1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L, 5L, 6L, 
     6L, 7L, 7L, 8L, 8L, 9L, 9L, 10L, 10L, 11L, 11L, 12L, 12L, 13L, 13L, 14L, 14L, 15L, 
     15L, 16L, 16L, 17L, 17L, 18L, 18L, 19L, 19L, 20L, 20L, 21L, 21L, 22L, 22L, 23L, 23L, 
     24L, 24L, 25L, 25L, 26L, 26L, 27L, 27L, 28L, 28L, 29L, 29L, 30L, 30L, 31L, 31L, 32L, 
     32L, 33L
  Execution halted
Running the tests in ‘tests/test-BrierScore.R’ failed.
Complete output:
  > library(testthat)
  > context("Prediction error")
  > # {{{ "Brier score censored data order"
  > test_that("Brier score censored data order",{
  +     library(riskRegression)
  +     library(survival)
  +     library(prodlim)
  +     data(Melanoma)
  +     setDT(Melanoma)
  +     fit <- coxph(Surv(time,status!=0)~invasion+epicel+logthick,data=Melanoma,x=TRUE)
  +     ## many ties in Melanoma
  +     setkey(Melanoma,age)
  +     a <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="marginal",metric="Brier")
  +     A <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="cox",metric="Brier")
  +     setkey(Melanoma,logthick)
  +     b <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="marginal",metric="Brier")
  +     B <- Score(list(fit),data=Melanoma,Surv(time,status!=0)~invasion+epicel+logthick,cens.model="cox",metric="Brier")
  +     a$call <- b$call <- A$call <- B$call <- NULL
  +     ## expect_error(expect_equal(a,b,tolerance = .002))
  +     expect_equal(a,b,tolerance = .02)
  +     expect_equal(A,B,tolerance=.02)
  + })
  Error: Test failed: 'Brier score censored data order'
  * SETLENGTH() cannot be applied to an ALTVEC object.
  1: Score(list(fit), data = Melanoma, Surv(time, status != 0) ~ invasion + epicel + logthick, 
         cens.model = "marginal", metric = "Brier")
  2: Score.list(list(fit), data = Melanoma, Surv(time, status != 0) ~ invasion + epicel + 
         logthick, cens.model = "marginal", metric = "Brier")
  3: computePerformance(DT, N = N, se.fit = se.fit, conservative = conservative, cens.model, 
         multi.split.test = multi.split.test, keep.residuals = keep.residuals, keep.vcov = keep.vcov)
  4: do.call(paste(m, response.type, sep = "."), input)
  5: Brier.survival(DT = structure(list(ID = c(1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 
     11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L, 23L, 24L, 25L, 26L, 27L, 
     28L, 29L, 30L, 31L, 32L, 33L, 34L, 35L, 36L, 37L, 38L, 39L, 40L, 41L, 42L, 43L, 44L, 
     45L, 46L, 47L, 48L, 49L, 50L, 51L, 52L, 53L, 54L, 55L, 56L, 57L, 58L, 59L, 60L, 61L, 
  Execution halted
Running the tests in ‘tests/test-ate.R’ failed.
Complete output:
  > library(riskRegression)
  Loading required package: data.table
  Loading required package: ggplot2
  Loading required package: prodlim
  > library(testthat)
  > library(survival)
  > require(rms)
  Loading required package: rms
  Loading required package: Hmisc
  Loading required package: lattice
  Loading required package: Formula
  
  Attaching package: 'Hmisc'
  
  The following object is masked from 'package:testthat':
  
      describe
  
  The following objects are masked from 'package:base':
  
      format.pval, units
  
  Loading required package: SparseM
  
  Attaching package: 'SparseM'
  
  The following object is masked from 'package:base':
  
      backsolve
  
  > require(survival)
  > context("Ate checks")
  >                                         # {{{ header with data  
  > set.seed(10)
  > n <- 5e1
  > dtS <- sampleData(n,outcome="survival")
  > dtS$time <- round(dtS$time,1)
  > dtS$X1 <- factor(rbinom(n, prob = c(0.3,0.4) , size = 2), labels = paste0("T",0:2))
  > handler <- if (Sys.info()["sysname"] == "Windows") "foreach" else "mclapply"
  > verbose <- FALSE
  >                                         # }}}
  >                                         # {{{ G formula: coxph, cph, sequential, one and several time points
  > test_that("G formula: coxph, cph, bootstrap sequential, one and several time points",{
  +     fit.cph <- cph(Surv(time,event)~ X1+X2,data=dtS,y=TRUE,x=TRUE)
  +     ate.1a <- ate(fit.cph,data = dtS, treatment = "X1", contrasts = NULL,seed=3, bootci.method = "quantile",
  +                   times = 1, handler=handler, B = 2, y = TRUE, mc.cores=1,verbose=verbose)
  +     ate.1b <- ate(fit.cph, data = dtS, treatment = "X1", contrasts = NULL,seed=3, bootci.method = "quantile",
  +                   times = 1:2, B = 2, y = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  +     fit.coxph <- coxph(Surv(time,event)~ X1+X2,data=dtS,y=TRUE,x=TRUE)
  +     ate.2a <- ate(fit.coxph,data = dtS, treatment = "X1", contrasts = NULL,seed=3, bootci.method = "quantile",
  +                   times = 1, B = 2, y = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  +     ate.2b <- ate(fit.coxph, data = dtS, treatment = "X1", contrasts = NULL,seed=3, bootci.method = "quantile",
  +                   times = 1:2, B = 2, y = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  + 
  +     attr(ate.2a,"class") <- "NULL"
  +     attr(ate.2b,"class") <- "NULL"
  +     attr(ate.1a,"class") <- "NULL"
  +     attr(ate.1b,"class") <- "NULL"
  +     expect_equal(ate.1a,ate.2a,tolerance = .00001)
  +     expect_equal(ate.1b,ate.2b,tolerance = .00001)
  + 
  +     ## quantile(ate.1a$boot$t[,1], 0.025) 
  +     expect_equal(ate.1a$meanRisk$meanRiskBoot,
  +                  c(0.04778180, 0.03383714, 0.03132013), tol = 1e-6)
  +     expect_equal(ate.1a$meanRisk$se,
  +                  c(0.02308268, 0.03008728, 0.02586185), tol = 1e-6)
  +     expect_equal(ate.1a$meanRisk$lower,
  +                  c(0.03227598, 0.01362597, 0.01394739), tol = 1e-6)
  +     expect_equal(ate.1a$meanRisk$upper,
  +                  c(0.06328763, 0.05404831, 0.04869286), tol = 1e-6)
  +     
  +     expect_equal(ate.1a$riskComparison$diffMeanBoot,
  +                  c(0.013944664, 0.016461677, 0.002517013), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$diff.se,
  +                  c(0.007004595, 0.002779170, 0.004225425), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$diff.lower,
  +                  c(0.0092393173, 0.0145947658, -0.0003214227), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$diff.upper,
  +                  c(0.018650011, 0.018328589, 0.005355449), tol = 1e-6)
  +     ## expect_equal(ate.1a$riskComparison$diff.p.value,
  +     ## c(4.650420e-02, 3.156692e-09, 5.513872e-01), tol = 1e-6)
  +   
  +     expect_equal(ate.1a$riskComparison$ratioMeanBoot,
  +                  c(1.833739, 1.853041, 1.037422), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$ratio.se,
  +                  c(0.9483519, 0.7931128, 0.1040106), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$ratio.lower,
  +                  c(1.1966818, 1.3202665, 0.9675527), tol = 1e-6)
  +     expect_equal(ate.1a$riskComparison$ratio.upper,
  +                  c(2.470795, 2.385816, 1.107291), tol = 1e-6)
  +     ## expect_equal(ate.1a$riskComparison$ratio.p.value,
  +                  ## c(5.316164e-02, 1.946959e-02, 1.976976e-23), tol = 1e-6)
  + 
  + })
  >                                         # }}}
  >                                         # {{{ Cox model - fully stratified
  > test_that("G formula: coxph, cph, fully stratified",{
  +     fit <- cph(formula = Surv(time,event)~ strat(X1),data=dtS,y=TRUE,x=TRUE)
  +     ate2 <- ate(fit, data = dtS, treatment = "X1", contrasts = NULL, seed = 3,
  +                 times = 1:2, B = 2, y = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  +     ## one time point
  +     fit <- coxph(Surv(time,event)~ strata(X1),data=dtS,y=TRUE,x=TRUE)
  +     ate1 <- ate(fit,data = dtS, treatment = "X1", contrasts = NULL, seed = 3,
  +         times = 1, B = 2, y = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  + })
  > # }}}
  > # {{{ Cox model - compare to explicit computation
  > test_that("Cox model - compare to explicit computation",{
  +     set.seed(10)
  +     n <- 5e1
  +     dtS <- sampleData(n,outcome="survival")
  +     dtS$time <- round(dtS$time,1)
  +     dtS$X1 <- factor(rbinom(n, prob = c(0.3,0.4) , size = 2), labels = paste0("T",0:2))
  +     fit <- cph(formula = Surv(time,event)~ X1+X2,data=dtS,y=TRUE,x=TRUE)
  +     ## automatically
  +     ateFit <- ate(fit, data = dtS, treatment = "X1", contrasts = NULL,
  +                   times = 5:7, B = 0, se = TRUE, mc.cores=1,handler=handler,verbose=verbose)
  +     expect_equal(ateFit$meanRisk[ateFit$meanRisk$Treatment == "T0",lower],
  +                  c(0.2756147, 0.3220124, 0.3492926),
  +                  tol = 1e-6)
  +     expect_equal(ateFit$meanRisk[ateFit$meanRisk$Treatment == "T0",upper],
  +                  c(0.6513235, 0.7011545, 0.7276942),
  +                  tol = 1e-6)
  + })
  Error: Test failed: 'Cox model - compare to explicit computation'
  * SETLENGTH() cannot be applied to an ALTVEC object.
  1: ate(fit, data = dtS, treatment = "X1", contrasts = NULL, times = 5:7, B = 0, se = TRUE, 
         mc.cores = 1, handler = handler, verbose = verbose)
  2: calcSeATE(object, data = data, times = times, cause = cause, treatment = treatment, 
         contrasts = contrasts, n.contrasts = n.contrasts, levels = levels, n.times = n.times, 
         n.obs = n.obs, pointEstimate = pointEstimate, alpha = alpha, conf.level = conf.level, 
         se = se, band = band, nsim.band = nsim.band, store.iid = store.iid)
  3: mrisks[, `:=`(se, sdIF.treatment[.GRP, ]), by = "Treatment"]
  4: `[.data.table`(mrisks, , `:=`(se, sdIF.treatment[.GRP, ]), by = "Treatment")
  Execution halted
Running the tests in ‘tests/test-confidenceBand_vs_timereg.R’ failed.
Complete output:
  > library(timereg)
  Loading required package: survival
  > library(testthat)
  > library(riskRegression)
  Loading required package: data.table
  Loading required package: ggplot2
  Loading required package: prodlim
  > 
  > n.sim <- 500
  > # {{{ survival
  > 
  > # {{{ simulation
  > set.seed(10)
  > d <- sampleData(1e2, outcome = "survival")
  > newdata <- d[1:10,]
  > 
  > fit <- cox.aalen(Surv(time, event) ~ prop(X1) + prop(X2), data = d, max.timepoint.sim=NULL)
  > fit.coxph <- coxph(Surv(time, event) ~ X1 + X2, data = d, x = TRUE, y = TRUE)
  > 
  > object.design <- riskRegression:::coxDesign.coxph(fit.coxph)
  > times <- unique(sort(object.design[object.design$status==1,"stop"]))
  > # }}}
  > 
  > # {{{ compute quantile for confidence bands
  > resTimereg <- list()
  >     for(i in 1:NROW(newdata)){ # i <- 1
  +         set.seed(10)
  +         resTimereg[[i]] <- predict.timereg(fit,
  +                                            newdata = newdata[i,,drop=FALSE],
  +                                            times = fit$time.sim.resolution,
  +                                            resample.iid = 1,
  +                                            n.sim = n.sim)
  +     }
  > test_that("computation of the quantile for the confidence band of the cumhazard", {
  +     pred <- predictCox(fit.coxph,
  +                        newdata = newdata,
  +                        times = times,
  +                        se = TRUE,
  +                        iid = TRUE,
  +                        band = TRUE,
  +                        type = "cumhazard")
  +     set.seed(10)
  +     resRR <- riskRegression:::confBandCox(iid = pred$cumhazard.iid,
  +                                           se = pred$cumhazard.se,
  +                                           n.sim = n.sim, 
  +                                           conf.level = 0.95)
  + 
  + 
  +     
  +     ref <- unlist(lapply(resTimereg,"[[", "unif.band"))
  + 
  +     set.seed(10)
  +     predRR <- predictCox(fit.coxph,
  +                          newdata = newdata,
  +                          times = times,
  +                          se = TRUE,
  +                          band = TRUE,
  +                          nsim.band = n.sim,
  +                          type = c("cumhazard")
  +                          )
  +     expect_equal(predRR$quantile.band,ref)
  +     expect_equal(resRR,ref)
  +     #expect_equal(resRR,c(2.850666, 2.562949, 2.992631, 2.992631, 2.850666, 2.992631, 2.850666, 2.992631, 2.992631, 2.562949), tol = 1e-6)
  +     #expect_equal(predRR$quantile.band,c(2.850666, 2.562949, 2.992631, 2.992631, 2.850666, 2.992631, 2.850666, 2.992631, 2.992631, 2.562949), tol = 1e-6)
  + })
  > # }}}
  > 
  > # {{{ display
  > predRR <- predictCox(fit.coxph,
  +                      newdata = newdata[1,],
  +                      times = times,
  +                      se = TRUE,
  +                      band = TRUE,
  +                      nsim.band = 500,
  +                      type = c("cumhazard","survival")
  +                      )
  > 
  > dev.new()
  > plotRR <- autoplot(predRR, type = "survival", band = TRUE, ci = TRUE, plot = FALSE)
  Error in `[.data.table`(dtTempo, , `:=`((c("time", "original")), list(time = c(origin,  : 
    SETLENGTH() cannot be applied to an ALTVEC object.
  Calls: autoplot ... autoplot.predictCox -> predict2plot -> [ -> [.data.table
  Execution halted
Running the tests in ‘tests/test-predictCox-CSC.R’ failed.
Complete output:
  > ### test-predictCox-CSC.R --- 
  > #----------------------------------------------------------------------
  > ## author: Thomas Alexander Gerds
  > ## created: Jun  6 2016 (09:35) 
  > ## Version: 
  > ## last-updated: Mar 26 2018 (07:53) 
  > ##           By: Thomas Alexander Gerds
  > ##     Update #: 142
  > #----------------------------------------------------------------------
  > ## 
  > ### Commentary: 
  > ## 
  > ### Change Log:
  > #----------------------------------------------------------------------
  > ## 
  > ### Code:
  > library(riskRegression)
  Loading required package: data.table
  Loading required package: ggplot2
  Loading required package: prodlim
  > library(testthat)
  > library(rms)
  Loading required package: Hmisc
  Loading required package: lattice
  Loading required package: survival
  Loading required package: Formula
  
  Attaching package: 'Hmisc'
  
  The following object is masked from 'package:testthat':
  
      describe
  
  The following objects are masked from 'package:base':
  
      format.pval, units
  
  Loading required package: SparseM
  
  Attaching package: 'SparseM'
  
  The following object is masked from 'package:base':
  
      backsolve
  
  > library(survival)
  > library(mstate)
  > tmat <- trans.comprisk(2, names = c("0", "1", "2"))
  > 
  > context("Risk prediction")
  > cat("prediction before and after the last event \n")
  prediction before and after the last event 
  > 
  > data(Melanoma)
  > times1 <- unique(Melanoma$time)
  > times2 <- c(0,0.9*min(times1),times1*1.1)
  > dataset1 <- Melanoma[sample.int(n = nrow(Melanoma), size = 12),]
  > 
  > #### no strata
  > fit.coxph <- coxph(Surv(time,status == 1) ~ thick*age, data = Melanoma, y = TRUE, x = TRUE)
  > fit.cph <- cph(Surv(time,status == 1) ~ thick*age, data = Melanoma, y = TRUE, x = TRUE)
  > fit.CSC <- CSC(Hist(time,status) ~ thick*age, data = Melanoma, fitter = "cph")
  > 
  > # {{{ "Prediction with Cox model - NA after last event"
  > test_that("Prediction with Cox model - NA after last event",{
  +   test.times <- max(Melanoma$time) + c(-1e-1,0,1e-1)
  +   
  +   prediction <- predictCox(fit.coxph, type = c("hazard","cumhazard","survival"), times = test.times, newdata = Melanoma[1,,drop = FALSE])
  +   expect_equal(as.vector(is.na(prediction$hazard)), c(FALSE, FALSE, TRUE))
  +   expect_equal(as.vector(is.na(prediction$cumhazard)), c(FALSE, FALSE, TRUE))
  +   expect_equal(as.vector(is.na(prediction$survival)), c(FALSE, FALSE, TRUE))
  +   
  +   prediction <- predictCox(fit.cph, type = c("hazard","cumhazard","survival"), times = test.times, newdata = Melanoma[1,,drop = FALSE])
  +   expect_equal(as.vector(is.na(prediction$hazard)), c(FALSE, FALSE, TRUE))
  +   expect_equal(as.vector(is.na(prediction$cumhazard)), c(FALSE, FALSE, TRUE))
  +   expect_equal(as.vector(is.na(prediction$survival)), c(FALSE, FALSE, TRUE))
  + })
  > 
  > # }}}
  > 
  > # {{{ "Prediction with Cox model - no event before prediction time"
  > test_that("Prediction with Cox model - no event before prediction time",{
  +   test.times <- min(Melanoma$time)-1e-5
  +   
  +   prediction <- predictCox(fit.coxph, type = c("hazard","cumhazard","survival"), times = test.times, newdata = Melanoma[1,,drop = FALSE])
  +   expect_equal(as.double(prediction$hazard), 0)
  +   expect_equal(as.double(prediction$cumhazard), 0)
  +   expect_equal(as.double(prediction$survival), 1)
  +   
  +   prediction <- predictCox(fit.cph, type = c("hazard","cumhazard","survival"), times = test.times, newdata = Melanoma[1,,drop = FALSE])
  +   expect_equal(as.double(prediction$hazard), 0)
  +   expect_equal(as.double(prediction$cumhazard), 0)
  +   expect_equal(as.double(prediction$survival), 1)
  + })
  > 
  > # }}}
  > 
  > # {{{ "Prediction with CSC - NA after last event"
  > test_that("Prediction with CSC - NA after last event",{
  +   test.times <- max(Melanoma$time) + c(-1e-1,0,1e-1)
  +   
  +   prediction <- predict(fit.CSC, times = test.times, newdata = Melanoma[1,,drop = FALSE], cause = 1)
  +   expect_equal(as.vector(is.na(prediction$absRisk)), c(FALSE, FALSE, TRUE))
  + })
  > 
  > # }}}
  > 
  > # {{{ "Prediction with CSC - no event before prediction time"
  > test_that("Prediction with CSC - no event before prediction time",{
  +   test.times <- min(Melanoma$time)-1e-5
  +   
  +   prediction <- predict(fit.CSC, times = test.times, newdata = Melanoma[1,,drop = FALSE], cause = 1)
  +   expect_equal(as.double(prediction$absRisk), 0)
  + })
  > 
  > # }}}
  > 
  > # {{{ "Prediction - last event censored"
  > test_that("Prediction - last event censored",{
  +   nData <- length(Melanoma$event)
  +   
  +   fit.coxph <- coxph(Surv(time,status == 1) ~ thick*age, data = Melanoma, y = TRUE, x = TRUE)
  +   fit.cph <- cph(Surv(time,status == 1) ~ thick*age, data = Melanoma, y = TRUE, x = TRUE)
  +   fit.CSC <- CSC(Hist(time,status) ~ thick*age, data = Melanoma, fitter = "cph")
  + 
  +   vec.times <- sort(c(Melanoma$time, Melanoma$time+1/2))[c(1,10,50,80,125,400,409,410)]
  +   p1 <- predictCox(fit.coxph, times = vec.times, newdata = Melanoma[1:5,])
  +   p2 <- predictCox(fit.cph, times = vec.times, newdata = Melanoma[1:5,])
  +   p3 <- rbind(c(1,0.9901893,0.8210527,0.685011,0.5877866,0.3577521,0.3577521,NA),
  +               c(1,0.9969463,0.9406704,0.8892678,0.8480293,0.7269743,0.7269743,NA),
  +               c(1,0.9973169,0.9476885,0.9020417,0.8651891,0.7556985,0.7556985,NA),
  +               c(1,0.9946451,0.8981872,0.8138074,0.7487177,0.5713246,0.5713246,NA),
  +               c(1,0.9830808,0.7108797,0.5195539,0.3986327,0.1687930,0.1687930,NA)
  +               )
  +   # pec::predictSurvProb(fit.coxph, times = vec.times, newdata = Melanoma[1:5,])            
  +   # predictSurvProb automatically sort the results
  +   
  +   expect_equal(p1,p2, tolerance = 1e-4)
  +   expect_equal(p1$survival, unname(p3), tolerance = 1e-7)
  + 
  +   survLast <- p1$survival[,6]
  +   survLastM1 <- p1$survival[,7]
  +   expect_equal(unname(survLast-survLastM1==0), rep(TRUE, 5)) # check that survival decrease at the last time
  + })
  > 
  > nData <- length(Melanoma$event)
  > Melanoma2 <- Melanoma
  > Melanoma2$status[nData] <- 1
  > 
  > # }}}
  > 
  > # {{{ "Prediction - last event is a death"
  > test_that("Prediction - last event is a death",{
  +     fit.coxph <- coxph(Surv(time,status == 1) ~ thick*age, data = Melanoma2, y = TRUE, x = TRUE)
  +     fit.cph <- cph(Surv(time,status == 1) ~ thick*age, data = Melanoma2, y = TRUE, x = TRUE)
  +     fit.CSC <- CSC(Hist(time,status) ~ thick*age, data = Melanoma2, fitter = "cph")
  +   
  +     vec.times <- sort(c(Melanoma$time, Melanoma$time+1/2))[c(1,10,50,80,125,400,409,410)]
  +     p1 <- predictCox(fit.coxph, times = vec.times, newdata = Melanoma[1:5,])
  +     p2 <- predictCox(fit.cph, times = vec.times, newdata = Melanoma[1:5,])
  +     p3 <-  rbind(c(1, 0.9901893, 0.8210527, 0.6850110, 0.5877866, 0.3577521, 0.020881916, NA),
  +                  c(1, 0.9969463, 0.9406704, 0.8892678, 0.8480293, 0.7269743, 0.301151229, NA),
  +                  c(1, 0.9973169, 0.9476885, 0.9020417, 0.8651891, 0.7556985, 0.348439663, NA),
  +                  c(1, 0.9946451, 0.8981872, 0.8138074, 0.7487177, 0.5713246, 0.121605930, NA),
  +                  c(1, 0.9830808, 0.7108797, 0.5195539, 0.3986327, 0.1687930, 0.001235699, NA)
  +                  )
  +     #pec::predictSurvProb(fit.coxph, times = vec.times, newdata = Melanoma[1:5,])
  +     # predictSurvProb automatically sort the results
  +   
  +   expect_equal(p1,p2, tolerance = 1e-4)
  +   expect_equal(p1$survival, unname(p3), tolerance = 1e-7)
  +   
  +   survLast <- p1$survival[,7]
  +   survLastM1 <- p1$survival[,6]
  +   expect_equal(unname(survLast-survLastM1<0), rep(TRUE, 5)) # check that survival decrease at the last time
  + })
  > 
  > #### strata
  > fit.coxph <- coxph(Surv(time,status == 1) ~ thick + strata(invasion) + strata(ici), data = Melanoma, y = TRUE, x = TRUE)
  > fit.cph <- cph(Surv(time,status == 1) ~ thick + strat(invasion) + strat(ici), data = Melanoma, y = TRUE, x = TRUE)
  > fit.CSC <- CSC(Hist(time,status) ~ thick + strat(invasion) + strat(ici), data = Melanoma, fitter = "cph")
  > 
  > # take one observation from each strata
  > data.test <- data.table(Melanoma)[, .SD[1], by = c("invasion", "ici")]
  > setkeyv(data.test, c("invasion","ici"))
  > 
  > # identify the last event time for each strata
  > epsilon <- min(diff(unique(fit.coxph$y[,"time"])))/10
  > pred.coxph <- predictCox(fit.coxph, keep.strata = TRUE, keep.times = TRUE)
  > baseHazStrata <- as.data.table(pred.coxph[c("time","hazard","cumhazard","strata","survival")])
  > dt.times <- baseHazStrata[, .(beforeLastTime = time[.N]-epsilon, LastTime = time[.N], afterLastTime = time[.N]+epsilon), by = strata]
  Error in `[.data.table`(baseHazStrata, , .(beforeLastTime = time[.N] -  : 
    SETLENGTH() cannot be applied to an ALTVEC object.
  Calls: [ -> [.data.table
  Execution halted
Running the tests in ‘tests/test-predictRisk.R’ failed.
Complete output:
  > ### test-predictRisk.R --- 
  > #----------------------------------------------------------------------
  > ## Author: Thomas Alexander Gerds
  > ## Created: Aug 10 2017 (08:56) 
  > ## Version: 
  > ## Last-Updated: Mar 26 2018 (08:04) 
  > ##           By: Thomas Alexander Gerds
  > ##     Update #: 14
  > #----------------------------------------------------------------------
  > ## 
  > ### Commentary: 
  > ## 
  > ### Change Log:
  > #----------------------------------------------------------------------
  > ## 
  > ### Code:
  > library(riskRegression)
  Loading required package: data.table
  Loading required package: ggplot2
  Loading required package: prodlim
  > library(testthat)
  > library(rms)
  Loading required package: Hmisc
  Loading required package: lattice
  Loading required package: survival
  Loading required package: Formula
  
  Attaching package: 'Hmisc'
  
  The following object is masked from 'package:testthat':
  
      describe
  
  The following objects are masked from 'package:base':
  
      format.pval, units
  
  Loading required package: SparseM
  
  Attaching package: 'SparseM'
  
  The following object is masked from 'package:base':
  
      backsolve
  
  > library(survival)
  > library(randomForestSRC)
  
   randomForestSRC 2.5.1 
   
   Type rfsrc.news() to see new features, changes, and bug fixes. 
   
  
  
  Attaching package: 'randomForestSRC'
  
  The following object is masked from 'package:Hmisc':
  
      impute
  
  > library(ggplot2)
  > 
  > # {{{ missing data
  > test_that("Additional arguments: example with imputation of missing data", {
  +     data(pbc,package="survival")
  +     set.seed(10)
  +     forest <- rfsrc(Surv(time,status)~chol+age+sex,data=pbc,ntree=10,nsplit=10)
  +     ## no specification
  +     expect_error(Score(list(forest),formula=Hist(time,status)~1,data=pbc,conf.int=FALSE,metrics="brier",cens.model="km"))
  +     ## correct specification
  +     expect_output(print(Score(list(forest),formula=Hist(time,status)~1,data=pbc,conf.int=FALSE,metrics="brier",cens.model="km",predictRisk.args=list("rfsrc"=list(na.action="na.impute")))))
  +     ## wrong specification
  +     expect_error(print(Score(list(forest),formula=Hist(time,status)~1,data=pbc,conf.int=FALSE,metrics="brier",cens.model="km",predictRisk.args=list("randomForestSRC"=list(na.action="na.impute")))))
  + })
  Error: Test failed: 'Additional arguments: example with imputation of missing data'
  * SETLENGTH() cannot be applied to an ALTVEC object.
  1: expect_output(print(Score(list(forest), formula = Hist(time, status) ~ 1, data = pbc, 
         conf.int = FALSE, metrics = "brier", cens.model = "km", predictRisk.args = list(rfsrc = list(na.action = "na.impute")))))
  2: quasi_capture(enquo(object), capture_output, label = label)
  3: capture(act$val <- eval_bare(get_expr(quo), get_env(quo)))
  4: capture_output_lines(code, print, width = width)
  5: eval_with_output(code, print = print, width = width)
  6: withr::with_output_sink(temp, withVisible(code))
  7: force(code)
  8: withVisible(code)
  9: eval_bare(get_expr(quo), get_env(quo))
  10: print(Score(list(forest), formula = Hist(time, status) ~ 1, data = pbc, conf.int = FALSE, 
         metrics = "brier", cens.model = "km", predictRisk.args = list(rfsrc = list(na.action = "na.impute"))))
  11: Score(list(forest), formula = Hist(time, status) ~ 1, data = pbc, conf.
  Execution halted
Running the tests in ‘tests/test-score.R’ failed.
Complete output:
  > ### test-Score.R --- 
  > #----------------------------------------------------------------------
  > ## author: Thomas Alexander Gerds
  > ## created: Jan  4 2016 (14:30) 
  > ## Version: 
  > ## last-updated: Apr 10 2018 (19:41) 
  > ##           By: Thomas Alexander Gerds
  > ##     Update #: 97
  > #----------------------------------------------------------------------
  > ## 
  > ### Commentary: 
  > ## 
  > ### Change Log:
  > #----------------------------------------------------------------------
  > ## 
  > ### Code:
  > library(testthat)
  > library(survival)
  > library(rms)
  Loading required package: Hmisc
  Loading required package: lattice
  Loading required package: Formula
  Loading required package: ggplot2
  
  Attaching package: 'Hmisc'
  
  The following object is masked from 'package:testthat':
  
      describe
  
  The following objects are masked from 'package:base':
  
      format.pval, units
  
  Loading required package: SparseM
  
  Attaching package: 'SparseM'
  
  The following object is masked from 'package:base':
  
      backsolve
  
  > library(pec)
  Loading required package: prodlim
  > library(riskRegression)
  Loading required package: data.table
  
  Attaching package: 'riskRegression'
  
  The following objects are masked from 'package:pec':
  
      ipcw, selectCox
  
  > library(pROC)
  Type 'citation("pROC")' for a citation.
  
  Attaching package: 'pROC'
  
  The following objects are masked from 'package:stats':
  
      cov, smooth, var
  
  > library(data.table)
  > library(Daim)
  Loading required package: parallel
  
  Attaching package: 'Daim'
  
  The following objects are masked from 'package:pROC':
  
      auc, roc
  
  > context("riskRegression")
  > 
  > # {{{ "R squared/IPA"
  > test_that("R squared/IPA", { 
  +     set.seed(112)
  +     d <- sampleData(112,outcome="binary")
  +     f1 <- glm(Y~X1+X5+X8,data=d, family="binomial")
  +     f2 <- glm(Y~X2+X6+X9+X10,data=d, family="binomial")
  +     r1 <- rsquared(f1,newdata=d)
  +     r2 <- IPA(f2,newdata=d)
  +     full <- Score(list(f1=f1,f2=f2),formula=Y~1,data=d,conf.int=TRUE,summary=c("RR"),plots="ROC")
  +     expect_equal(r1$IPA.gain[1],full$Brier$score[model=="f1",IPA])
  +     expect_equal(r2$IPA[2],full$Brier$score[model=="f2",IPA])
  + })
  Error: Test failed: 'R squared/IPA'
  * SETLENGTH() cannot be applied to an ALTVEC object.
  1: rsquared(f1, newdata = d)
  2: rsquared.glm(f1, newdata = d)
  3: Score(c(`Full model` = list(object), leaveOneOut), formula = formula, data = newdata, 
         contrasts = FALSE, conf.int = FALSE, metrics = "brier", summary = "rsquared", 
         ...)
  4: Score.list(c(`Full model` = list(object), leaveOneOut), formula = formula, data = newdata, 
         contrasts = FALSE, conf.int = FALSE, metrics = "brier", summary = "rsquared", 
         ...)
  5: computePerformance(DT, N = N, se.fit = se.fit, conservative = conservative, cens.model, 
         multi.split.test = multi.split.test, keep.residuals = keep.residuals, keep.vcov = keep.vcov)
  6: do.call(paste(m, response.type, sep = "."), input)
  7: Brier.binary(DT = structure(list(ID = c(1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 3L, 
     3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 7L, 7L, 
     7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L
  Execution halted