Running ‘test.etmCIF.R’ [3s/3s]
  Running ‘tests.etm.R’ [4s/5s]
Running the tests in ‘tests/test.etmCIF.R’ failed.
Complete output:
  > ### test file for etmCIF.
  > ### Really simple tests and comparison with etm
  > 
  > old <- options(digits = 5)
  > 
  > require(etm)
  Loading required package: etm
  > 
  > if (!require(survival, quietly = TRUE)) {
  +     print("The following tests require the 'survival' package")
  + } else {
  + 
  +     data(abortion)
  + 
  +     from <- rep(0, nrow(abortion))
  +     to <- abortion$cause
  +     entry <- abortion$entry
  +     exit <- abortion$exit
  +     id <- 1:nrow(abortion)
  +     data <- data.frame(id, from, to, entry, exit, group = abortion$group)
  + 
  +     ## Computation of the CIFs with etm
  +     tra <- matrix(FALSE, 4, 4)
  +     tra[1, 2:4] <- TRUE
  + 
  +     cif.control <- etm(data[data$group == 0, ], c("0", "1", "2", "3"),
  +                        tra, NULL, 0)
  +     cif.exposed <- etm(data[data$group == 1, ], c("0", "1", "2", "3"),
  +                        tra, NULL, 0)
  + 
  + 
  +     ## Computation of the CIFs with etmCIF
  +     netm <- etmCIF(Surv(entry, exit, cause != 0) ~ group, abortion,
  +                    etype = cause, failcode = 3)
  + 
  + ### let's do some comparisons :-)
  + 
  +     all.equal(trprob(cif.control, "0 3"), netm[[1]]$est["0", "3", ])
  +     all.equal(trprob(cif.control, "0 2"), netm[[1]]$est["0", "2", ])
  +     all.equal(trprob(cif.control, "0 1"), netm[[1]]$est["0", "1", ])
  + 
  +     all.equal(trprob(cif.exposed, "0 3"), netm[[2]]$est["0", "3", ])
  +     all.equal(trprob(cif.exposed, "0 2"), netm[[2]]$est["0", "2", ])
  +     all.equal(trprob(cif.exposed, "0 1"), netm[[2]]$est["0", "1", ])
  + 
  + 
  +     all.equal(trcov(cif.control, "0 3"), netm[[1]]$cov["0 3", "0 3", ])
  +     all.equal(trcov(cif.control, "0 2"), netm[[1]]$cov["0 2", "0 2", ])
  +     all.equal(trcov(cif.control, "0 1"), netm[[1]]$cov["0 1", "0 1", ])
  + 
  +     all.equal(trcov(cif.exposed, "0 3"), netm[[2]]$cov["0 3", "0 3", ])
  +     all.equal(trcov(cif.exposed, "0 2"), netm[[2]]$cov["0 2", "0 2", ])
  +     all.equal(trcov(cif.exposed, "0 1"), netm[[2]]$cov["0 1", "0 1", ])
  + 
  + 
  +     netm
  + 
  +     ## test on the summary
  +     snetm <- summary(netm)
  + 
  +     snetm
  + 
  +     all.equal(unname(trprob(cif.control, "0 3")), snetm[[1]][[3]]$P)
  +     all.equal(unname(trprob(cif.control, "0 2")), snetm[[1]][[2]]$P)
  +     all.equal(unname(trprob(cif.control, "0 1")), snetm[[1]][[1]]$P)
  + 
  +     all.equal(unname(trprob(cif.exposed, "0 3")), snetm[[2]][[3]]$P)
  +     all.equal(unname(trprob(cif.exposed, "0 2")), snetm[[2]][[2]]$P)
  +     all.equal(unname(trprob(cif.exposed, "0 1")), snetm[[2]][[1]]$P)
  + 
  +     scif.control <- summary(cif.control, ci.fun = "cloglog")
  +     scif.exposed <- summary(cif.exposed, ci.fun = "cloglog")
  + 
  +     all.equal(scif.control[[4]]$lower, snetm[[1]][[3]]$lower)
  +     all.equal(scif.control[[4]]$upper, snetm[[1]][[3]]$upper)
  + 
  +     all.equal(scif.exposed[[4]]$lower, snetm[[2]][[3]]$lower)
  +     all.equal(scif.exposed[[4]]$upper, snetm[[2]][[3]]$upper)
  + }
  Error in object$n.risk[, trs.sep[i, 1]] : subscript out of bounds
  Calls: summary ... summary -> summary.etm -> ci.transfo -> lapply -> FUN
  Execution halted
Running the tests in ‘tests/tests.etm.R’ failed.
Complete output:
  > require(etm)
  Loading required package: etm
  > 
  > ## Print with a bit less precision to avoid lots of notes in the comparison
  > old <- options(digits = 4)
  > 
  > ### Simple test
  > 
  > time <- id <- 1:10
  > from <- rep(0, 10)
  > to <- rep(1, 10)
  > 
  > data1 <- data.frame(id, from, to, time)
  > tra1 <- matrix(FALSE, 2, 2)
  > tra1[1, 2] <- TRUE
  > 
  > etm1 <- etm(data1, c("0", "1"), tra1, NULL, 0)
  > 
  > all.equal(as.vector(trprob(etm1, "0 0")), cumprod((10:1 - 1) / (10:1)))
  [1] TRUE
  > 
  > etm1$cov["0 0", "0 0", ]
      1     2     3     4     5     6     7     8     9    10 
  0.009 0.016 0.021 0.024 0.025 0.024 0.021 0.016 0.009 0.000 
  > 
  > all.equal(etm1$cov["0 0", "0 0",], trcov(etm1, "0 0"))
  [1] TRUE
  > 
  > ### A simple test from AHR's author, where the first time is censored
  > if (!require(survival)) {
  +     stop("This test requires the survival package")
  + }
  Loading required package: survival
  > 
  > data <- data.frame(id=1:10, time=1:10, from=0, to=1, status=TRUE)
  > 
  > tra <- matrix(FALSE, nrow=2, ncol=2)
  > tra[1, 2] <- TRUE
  > 
  > data$to[1] <- "cens"
  > data$status[1] <- FALSE
  > 
  > fit.km <- survfit(Surv(time, status) ~ 1, data=data)
  > fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE)
  > 
  > all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE)
  [1] TRUE
  > 
  > data$to[2] <- "cens"
  > data$status[2] <- FALSE
  > 
  > fit.km <- survfit(Surv(time, status) ~ 1, data=data)
  > fit.etm <- etm(data, c("0","1"), tra, "cens", s=0, t="last", covariance=FALSE)
  > 
  > all.equal(fit.km$surv[data$status], fit.etm$est[1,1,], check.attributes = FALSE)
  [1] TRUE
  > 
  > ### a bit more complicated
  > 
  > time <- id <- 1:10
  > from <- rep(0, 10)
  > to <- rep(c(1, 2), 5)
  > data2 <- data.frame(id, from, to, time)
  > 
  > tra2 <- matrix(FALSE, 3, 3)
  > tra2[1, 2:3] <- TRUE
  > 
  > etm2 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
  > 
  > aa <- table(time, to)
  > 
  > cif1 <- cumsum(aa[, 1] / 10)
  > cif2 <- cumsum(aa[, 2] / 10)
  > surv <- cumprod((10:1 - 1) / (10:1))
  > 
  > all.equal(trprob(etm2, "0 1"), cif1)
  [1] TRUE
  > all.equal(trprob(etm2, "0 2"), cif2)
  [1] TRUE
  > all.equal(as.vector(trprob(etm2, "0 0")), surv)
  [1] TRUE
  > 
  > ## a test on id
  > data2$id <- letters[1:10]
  > 
  > etm3 <- etm(data2, c("0", "1", "2"), tra2, NULL, 0)
  > 
  > all.equal(trprob(etm2, "0 1"), trprob(etm3, "0 1"))
  [1] TRUE
  > all.equal(trprob(etm2, "0 2"), trprob(etm3, "0 2"))
  [1] TRUE
  > all.equal(trprob(etm2, "0 0"), trprob(etm3, "0 0"))
  [1] TRUE
  > 
  > 
  > ### Test on sir.cont
  > 
  > data(sir.cont)
  > 
  > ## Modification for patients entering and leaving a state
  > ## at the same date
  > ## Change on ventilation status is considered
  > ## to happen before end of hospital stay
  > sir.cont <- sir.cont[order(sir.cont$id, sir.cont$time), ]
  > for (i in 2:nrow(sir.cont)) {
  +     if (sir.cont$id[i]==sir.cont$id[i-1]) {
  +         if (sir.cont$time[i]==sir.cont$time[i-1]) {
  +             sir.cont$time[i-1] <- sir.cont$time[i-1] - 0.5
  +         }
  +     }
  + }
  > 
  > ### Computation of the transition probabilities
  > ## Possible transitions.
  > tra <- matrix(ncol=3,nrow=3,FALSE)
  > tra[1, 2:3] <- TRUE
  > tra[2, c(1, 3)] <- TRUE
  > 
  > ## etm
  > prob.sir <- etm(sir.cont, c("0", "1", "2"), tra, "cens", 1)
  > 
  > prob.sir
  Multistate model with 3 transient state(s)
   and 0 absorbing state(s)
  
  Possible transitions:
   from to
      0  1
      0  2
      1  0
      1  2
  
  Estimate of P(1, 183)
    0 1 2
  0 0 0 1
  1 0 0 1
  2 0 0 1
  
  > 
  > summ.sir <- summary(prob.sir)
  Error in object$n.risk[, trs.sep[i, 1]] : subscript out of bounds
  Calls: summary -> summary.etm -> ci.transfo -> lapply -> FUN
  Execution halted