Running ‘test-AUC.R’ [4s/6s]
  Running ‘test-BinomialRegression.R’ [7s/9s]
  Running ‘test-BrierScore.R’ [7s/9s]
  Running ‘test-CauseSpecificCoxRegression.R’ [5s/8s]
  Running ‘test-FineGrayRegression.R’ [3s/4s]
  Running ‘test-ate.R’ [12s/22s]
  Running ‘test-boxplotScore.R’ [4s/5s]
  Running ‘test-confidenceBand_vs_timereg.R’ [8s/10s]
  Running ‘test-iidCox.R’ [4s/4s]
  Running ‘test-phreg.R’ [0s/1s]
  Running ‘test-predictCSC_vs_mstate.R’ [17s/19s]
  Running ‘test-predictCox-CSC.R’ [9s/10s]
  Running ‘test-predictCox.R’ [4s/5s]
  Running ‘test-predictCox_vs_basehaz.R’ [4s/5s]
Running the tests in ‘tests/test-predictCox_vs_basehaz.R’ failed.
Complete output:
  > ### test-predictCox-basehaz.R --- 
  > #----------------------------------------------------------------------
  > ## author: Brice Ozenne
  > ## created: sep  4 2017 (10:38) 
  > ## Version: 
  > ## last-updated: Mar 26 2018 (07:57) 
  > ##           By: Thomas Alexander Gerds
  > ##     Update #: 22
  > #----------------------------------------------------------------------
  > ## 
  > ### Commentary: 
  > ##
  > ## Compare the output of riskRegression:::predictCox with survival:::basehaz.
  > ## In particular check that they output the same results when centered = TRUE and centered = FALSE.
  > ## Also perform additional tests on the other argument of predictCox.
  > ## 
  > ### 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)
  > # {{{ 1- [predictCox] Check baseline hazard 
  > cat("Estimation of the baseline hazard \n")
  Estimation of the baseline hazard 
  > data(Melanoma)
  > # {{{ "baseline hazard - match basehaz results"
  > test_that("baseline hazard - match basehaz results",{
  +   fit.coxph <- coxph(Surv(time,status == 1) ~ thick + invasion + ici, data = Melanoma, y = TRUE, x = TRUE)
  +   fit.cph <- cph(Surv(time,status == 1) ~ thick + invasion + ici, data = Melanoma, y = TRUE, x = TRUE)
  +   
  +   expect_equal(predictCox(fit.coxph, centered = FALSE)$cumhazard, 
  +                basehaz(fit.coxph, centered = FALSE)$hazard, tolerance = 1e-8)
  +   expect_equal(predictCox(fit.coxph, centered = TRUE)$cumhazard, 
  +                basehaz(fit.coxph, centered = TRUE)$hazard, tolerance = 1e-8)
  +   expect_equal(predictCox(fit.cph)$cumhazard, 
  +                basehaz(fit.cph)$hazard, tolerance = 1e-8)
  +   
  +   ## possible differences due to different fit - coef(fit.coxph)-coef(fit.cph)
  +   expect_equal(predictCox(fit.cph),
  +                predictCox(fit.coxph, centered = TRUE), 
  +                tolerance = 100*max(abs(coef(fit.coxph)-coef(fit.cph))))
  + })
  > 
  > #### strata
  > 
  > # }}}
  > # {{{ "baseline hazard (strata) - order of the results"
  > test_that("baseline hazard (strata) - order of the results",{
  +   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)
  +   
  +   expect_equal(predictCox(fit.coxph, keep.strata = TRUE)$strata, 
  +                basehaz(fit.coxph)$strata)
  +   expect_equal(predictCox(fit.cph, keep.strata = TRUE)$strata, 
  +                basehaz(fit.cph)$strata)
  +   # expect_equal(as.numeric(predictCox(fit.coxph, keep.strata = TRUE)$strata), 
  +   #              as.numeric(predictCox(fit.cph, keep.strata = TRUE)$strata))
  + })
  > 
  > # }}}
  > # {{{ "baseline hazard (strata) - match basehaz results"
  > test_that("baseline hazard (strata) - match basehaz results",{
  +   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)
  +   
  +   expect_equal(predictCox(fit.coxph, centered = FALSE)$cumhazard, 
  +                basehaz(fit.coxph, centered = FALSE)$hazard, tolerance = 1e-8)
  +   expect_equal(predictCox(fit.cph)$cumhazard, 
  +                basehaz(fit.cph)$hazard)
  +   
  + })
  > 
  > # }}}
  > # }}}
  > # {{{ 2- [predictCox] Check baseline hazard with time varying variables
  > ## example from help(coxph)
  > 
  > test2 <- list(start=c(1,2,5,2,1,7,3,4,8,8), 
  +               stop=c(2,3,6,7,8,9,9,9,14,17), 
  +               event=c(1,1,1,1,1,1,1,0,0,0), 
  +               x=c(1,0,0,1,0,1,1,1,0,0)) 
  > 
  > # {{{ "baseline hazard (time varying) - match basehaz results"
  > test_that("baseline hazard (time varying) - match basehaz results",{
  +     fit.coxph <- coxph(Surv(start, stop, event) ~ x, data = test2, x = TRUE, y = TRUE)
  +     fit.cph <- cph(Surv(start, stop, event) ~ x, data = test2, x = TRUE, y = TRUE)
  + 
  +     expect_equal(predictCox(fit.coxph, centered = FALSE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = FALSE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.coxph, centered = TRUE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = TRUE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.cph)$cumhazard, 
  +                  basehaz(fit.cph)$hazard, tolerance = 1e-8)
  +   
  + })
  > 
  > test2.strata <- rbind(cbind(as.data.table(test2),S = 1),
  +                       cbind(as.data.table(test2),S = 2))
  > test2.strata$randomS <- rbinom(NROW(test2.strata),size = 1, prob = 1/2)
  > 
  > # }}}
  > # {{{ "baseline hazard (strata, time varying) - match basehaz results"
  > test_that("baseline hazard (strata, time varying) - match basehaz results",{
  +     fit.coxph <- coxph(Surv(start, stop, event) ~ strata(S) + x, data = test2.strata, x = TRUE, y = TRUE)
  +     fit.cph <- cph(Surv(start, stop, event) ~ strat(S) + x, data = test2.strata, x = TRUE, y = TRUE)
  + 
  +     expect_equal(predictCox(fit.coxph, centered = FALSE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = FALSE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.coxph, centered = TRUE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = TRUE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.cph)$cumhazard, 
  +                  basehaz(fit.cph)$hazard, tolerance = 1e-8)
  +     
  +     fit.coxph <- coxph(Surv(start, stop, event) ~ strata(randomS) + x, data = test2.strata, x = TRUE, y = TRUE)
  +     fit.cph <- cph(Surv(start, stop, event) ~ strat(randomS) + x, data = test2.strata, x = TRUE, y = TRUE)
  + 
  +     expect_equal(predictCox(fit.coxph, centered = FALSE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = FALSE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.coxph, centered = TRUE)$cumhazard, 
  +                  basehaz(fit.coxph, centered = TRUE)$hazard, tolerance = 1e-8)
  +     expect_equal(predictCox(fit.cph)$cumhazard, 
  +                  basehaz(fit.cph)$hazard, tolerance = 1e-8)
  + 
  + })
  Error: Test failed: 'baseline hazard (strata, time varying) - match basehaz results'
  * predictCox(fit.coxph, centered = FALSE)$cumhazard not equal to basehaz(fit.coxph, centered = FALSE)$hazard.
  8/10 mismatches (average diff: 23720)
  [3]  6.59e+09 - 6.59e+09 == -9.54e-07
  [4]  7.71e+09 - 7.71e+09 == -2.17e+04
  [5]  7.71e+09 - 7.71e+09 == -2.17e+04
  [6]  7.71e+09 - 7.71e+09 == -2.17e+04
  [7]  1.20e+10 - 1.20e+10 == -3.11e+04
  [8]  1.20e+10 - 1.20e+10 == -3.11e+04
  [9]  1.20e+10 - 1.20e+10 == -3.11e+04
  [10] 1.20e+10 - 1.20e+10 == -3.11e+04
  * predictCox(fit.coxph, centered = TRUE)$cumhazard not equal to basehaz(fit.coxph, centered = TRUE)$hazard.
  7/10 mismatches (average diff: 0.218)
  [4]  107509 - 107509 == 0.187
  [5]  107509 - 107509 == 0.187
  [6]  107509 - 107509 == 0.187
  [7]  167236 - 167236 == 0.241
  [8]  167236 - 167236 == 0.241
  [9]  167236 - 167236 == 0.241
  [10] 167236 - 167236 == 0.241
  Execution halted