R Under development (unstable) (2024-11-28 r87392 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

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.

> ## ===== Resp class =====
> ## -- Test utils & settings
> source("test_util.R")
> .run_test <- identical(Sys.getenv("NOT_CRAN"), "true")
> oldopt <- options(digits = 4)
> set.seed(100)
> 
> library("tramME")
Loading required package: tram
Loading required package: mlt
Loading required package: basefun
Loading required package: variables
Loading required package: mvtnorm
> library("survival")
> 
> dat <- data.frame(x1 = c(100, 1:10, NA, NA), x2 = c(100, 2:10, NA, 11, NA),
+                   x3 = c(NA, NA, 0:10))
> dat$r <- with(dat, Resp(x1, x2, x3))
> 
> with(dat, chkid(Resp(x1, x2), Surv(x1, x2, type = "interval2")))
> 
> chkid(length(dat$r), 13L)
> chkid(dat[1:3, ]$r, dat$r[1:3])
> chkid(is.na(dat$r), c(rep(FALSE, 12), TRUE))
> 
> mf <- model.frame(r ~ 1, data = dat, na.action = na.omit)
> chkid(nrow(mf), 12L)
> 
> m1 <- CoxphME(Resp(x1, x2) ~ 1, data = dat, nofit = TRUE)
> chkid(inherits(d1 <- m1$data[[1]], "Surv"), TRUE)
> m2 <- CoxphME(Resp(x1, x2, x3) ~ 1, data = dat, nofit = TRUE,
+               support = c(0, 20))
> ## NOTE: support is needed otherwise mlt throws an error (Report to Torsten?)
> chkid(inherits(d2 <- m2$data[[1]], "Resp"), TRUE)
> chkid(nrow(d1), nrow(d2))
> chkerr(CoxphME(Resp(x1, x2, x3) ~ 1, data = dat, support = c(0, 20),
+                nofit = TRUE, na.action = na.fail))
> ## FIXME: wrong error message?!
> 
> ## === setting bounds
> dat$r2 <- with(dat, Resp(x1, x2, x3, bounds = c(0, Inf)))
> chkid(print(dat$r[-12]), print(dat$r2[-12]))
 [1] {100}             {( 1,   2]}       {( 2,   3]| >  0} {( 3,   4]| >  1}
 [5] {( 4,   5]| >  2} {( 5,   6]| >  3} {( 6,   7]| >  4} {( 7,   8]| >  5}
 [9] {( 8,   9]| >  6} {( 9,  10]| >  7} {(10, Inf]| >  8} {(NA,  NA]| > 10}
 [1] {100}             {( 1,   2]}       {( 2,   3]| >  0} {( 3,   4]| >  1}
 [5] {( 4,   5]| >  2} {( 5,   6]| >  3} {( 6,   7]| >  4} {( 7,   8]| >  5}
 [9] {( 8,   9]| >  6} {( 9,  10]| >  7} {(10, Inf]| >  8} {(NA,  NA]| > 10}
> chkid(identical(print(dat$r[12]), print(dat$r2[12])), FALSE)
[1] {(-Inf, 11]| > 9}
[1] {(0, 11]| > 9}
> 
> ## === adjust in priniting
> chkid(identical(print(R(dat$r2)), print(dat$r2)), FALSE)
 [1] {100}                         {(1.00e+00,   2]}            
 [3] {(2.00e+00,   3]| > 1.49e-08} {(3.00e+00,   4]| > 1.00e+00}
 [5] {(4.00e+00,   5]| > 2.00e+00} {(5.00e+00,   6]| > 3.00e+00}
 [7] {(6.00e+00,   7]| > 4.00e+00} {(7.00e+00,   8]| > 5.00e+00}
 [9] {(8.00e+00,   9]| > 6.00e+00} {(9.00e+00,  10]| > 7.00e+00}
[11] {(1.00e+01, Inf]| > 8.00e+00} {(1.49e-08,  11]| > 9.00e+00}
[13] {(      NA,  NA]| > 1.00e+01}
 [1] {100}             {( 1,   2]}       {( 2,   3]| >  0} {( 3,   4]| >  1}
 [5] {( 4,   5]| >  2} {( 5,   6]| >  3} {( 6,   7]| >  4} {( 7,   8]| >  5}
 [9] {( 8,   9]| >  6} {( 9,  10]| >  7} {(10, Inf]| >  8} {( 0,  11]| >  9}
[13] {(NA,  NA]| > 10}
> ## but the saved values are adjusted
> chkid(all(unclass(dat$r2) > 0, na.rm = TRUE), TRUE)
> 
> summarize_tests()
==========================
Number of failed tests: 0
==========================
> 
> options(oldopt)
> 
> 
> proc.time()
   user  system elapsed 
   1.09    0.26    1.34