Running 'aareg.R' [3s]
  Comparing 'aareg.Rout' to 'aareg.Rout.save' ... OK
  Running 'anova.R' [2s]
  Comparing 'anova.Rout' to 'anova.Rout.save' ... OK
  Running 'bladder.R' [3s]
  Comparing 'bladder.Rout' to 'bladder.Rout.save' ... OK
  Running 'book1.R' [3s]
  Comparing 'book1.Rout' to 'book1.Rout.save' ... OK
  Running 'book2.R' [3s]
  Comparing 'book2.Rout' to 'book2.Rout.save' ... OK
  Running 'book3.R' [3s]
  Comparing 'book3.Rout' to 'book3.Rout.save' ... OK
  Running 'book4.R' [3s]
  Comparing 'book4.Rout' to 'book4.Rout.save' ... OK
  Running 'book5.R' [3s]
  Comparing 'book5.Rout' to 'book5.Rout.save' ... OK
  Running 'book6.R' [3s]
  Comparing 'book6.Rout' to 'book6.Rout.save' ... OK
  Running 'book7.R' [4s]
  Comparing 'book7.Rout' to 'book7.Rout.save' ... OK
  Running 'cancer.R' [5s]
  Comparing 'cancer.Rout' to 'cancer.Rout.save' ... OK
  Running 'clogit.R' [3s]
  Comparing 'clogit.Rout' to 'clogit.Rout.save' ... OK
  Running 'concordance.R' [3s]
  Comparing 'concordance.Rout' to 'concordance.Rout.save' ... OK
  Running 'concordance2.R' [15s]
  Comparing 'concordance2.Rout' to 'concordance2.Rout.save' ... OK
  Running 'concordance3.R' [3s]
  Comparing 'concordance3.Rout' to 'concordance3.Rout.save' ... OK
  Running 'counting.R' [2s]
  Comparing 'counting.Rout' to 'counting.Rout.save' ... OK
  Running 'coxsurv.R' [3s]
  Comparing 'coxsurv.Rout' to 'coxsurv.Rout.save' ... OK
  Running 'coxsurv2.R' [3s]
  Comparing 'coxsurv2.Rout' to 'coxsurv2.Rout.save' ... OK
  Running 'coxsurv3.R' [3s]
  Comparing 'coxsurv3.Rout' to 'coxsurv3.Rout.save' ... OK
  Running 'coxsurv4.R' [3s]
  Comparing 'coxsurv4.Rout' to 'coxsurv4.Rout.save' ... OK
  Running 'coxsurv5.R' [3s]
  Running 'detail.R' [3s]
  Comparing 'detail.Rout' to 'detail.Rout.save' ... OK
  Running 'difftest.R' [3s]
  Comparing 'difftest.Rout' to 'difftest.Rout.save' ... OK
  Running 'doaml.R' [3s]
  Comparing 'doaml.Rout' to 'doaml.Rout.save' ... OK
  Running 'doweight.R' [3s]
  Comparing 'doweight.Rout' to 'doweight.Rout.save' ... OK
  Running 'expected.R' [3s]
  Comparing 'expected.Rout' to 'expected.Rout.save' ... OK
  Running 'expected2.R' [3s]
  Comparing 'expected2.Rout' to 'expected2.Rout.save' ... OK
  Running 'factor.R' [3s]
  Comparing 'factor.Rout' to 'factor.Rout.save' ... OK
  Running 'factor2.R' [3s]
  Comparing 'factor2.Rout' to 'factor2.Rout.save' ... OK
  Running 'finegray.R' [3s]
  Comparing 'finegray.Rout' to 'finegray.Rout.save' ... OK
  Running 'fr_cancer.R' [3s]
  Comparing 'fr_cancer.Rout' to 'fr_cancer.Rout.save' ... OK
  Running 'fr_kidney.R' [3s]
  Comparing 'fr_kidney.Rout' to 'fr_kidney.Rout.save' ... OK
  Running 'fr_lung.R' [3s]
  Comparing 'fr_lung.Rout' to 'fr_lung.Rout.save' ... OK
  Running 'fr_ovarian.R' [2s]
  Comparing 'fr_ovarian.Rout' to 'fr_ovarian.Rout.save' ... OK
  Running 'fr_rat1.R' [2s]
  Comparing 'fr_rat1.Rout' to 'fr_rat1.Rout.save' ... OK
  Running 'fr_resid.R' [3s]
  Comparing 'fr_resid.Rout' to 'fr_resid.Rout.save' ... OK
  Running 'fr_simple.R' [3s]
  Comparing 'fr_simple.Rout' to 'fr_simple.Rout.save' ... OK
  Running 'frailty.R' [3s]
  Comparing 'frailty.Rout' to 'frailty.Rout.save' ... OK
  Running 'frank.R' [2s]
  Comparing 'frank.Rout' to 'frank.Rout.save' ... OK
  Running 'infcox.R' [2s]
  Comparing 'infcox.Rout' to 'infcox.Rout.save' ... OK
  Running 'jasa.R' [3s]
  Comparing 'jasa.Rout' to 'jasa.Rout.save' ... OK
  Running 'model.matrix.R' [3s]
  Comparing 'model.matrix.Rout' to 'model.matrix.Rout.save' ... OK
  Running 'mstate.R' [3s]
  Comparing 'mstate.Rout' to 'mstate.Rout.save' ... OK
  Running 'multi2.R' [3s]
  Comparing 'multi2.Rout' to 'multi2.Rout.save' ... OK
  Running 'multistate.R' [4s]
  Comparing 'multistate.Rout' to 'multistate.Rout.save' ... OK
  Running 'nested.R' [2s]
  Comparing 'nested.Rout' to 'nested.Rout.save' ... OK
  Running 'ovarian.R' [3s]
  Comparing 'ovarian.Rout' to 'ovarian.Rout.save' ... OK
  Running 'overlap.R' [3s]
  Comparing 'overlap.Rout' to 'overlap.Rout.save' ... OK
  Running 'prednew.R' [3s]
  Comparing 'prednew.Rout' to 'prednew.Rout.save' ... OK
  Running 'pspline.R' [3s]
  Comparing 'pspline.Rout' to 'pspline.Rout.save' ... OK
  Running 'pyear.R' [3s]
  Comparing 'pyear.Rout' to 'pyear.Rout.save' ... OK
  Running 'quantile.R' [3s]
  Comparing 'quantile.Rout' to 'quantile.Rout.save' ... OK
  Running 'r_donnell.R' [4s]
  Comparing 'r_donnell.Rout' to 'r_donnell.Rout.save' ... OK
  Running 'r_lung.R' [3s]
  Comparing 'r_lung.Rout' to 'r_lung.Rout.save' ... OK
  Running 'r_peterson.R' [3s]
  Comparing 'r_peterson.Rout' to 'r_peterson.Rout.save' ... OK
  Running 'r_resid.R' [3s]
  Comparing 'r_resid.Rout' to 'r_resid.Rout.save' ... OK
  Running 'r_sas.R' [8s]
  Comparing 'r_sas.Rout' to 'r_sas.Rout.save' ... OK
  Running 'r_scale.R' [3s]
  Comparing 'r_scale.Rout' to 'r_scale.Rout.save' ... OK
  Running 'r_stanford.R' [3s]
  Comparing 'r_stanford.Rout' to 'r_stanford.Rout.save' ... OK
  Running 'r_strata.R' [3s]
  Comparing 'r_strata.Rout' to 'r_strata.Rout.save' ... OK
  Running 'r_tdist.R' [2s]
  Comparing 'r_tdist.Rout' to 'r_tdist.Rout.save' ... OK
  Running 'r_user.R' [3s]
  Comparing 'r_user.Rout' to 'r_user.Rout.save' ... OK
  Running 'ratetable.R' [3s]
  Comparing 'ratetable.Rout' to 'ratetable.Rout.save' ... OK
  Running 'singtest.R' [3s]
  Comparing 'singtest.Rout' to 'singtest.Rout.save' ... OK
  Running 'strata2.R' [3s]
  Comparing 'strata2.Rout' to 'strata2.Rout.save' ... OK
  Running 'stratatest.R' [3s]
  Comparing 'stratatest.Rout' to 'stratatest.Rout.save' ... OK
  Running 'summary_survfit.R' [3s]
  Comparing 'summary_survfit.Rout' to 'summary_survfit.Rout.save' ... OK
  Running 'surv.R' [2s]
  Comparing 'surv.Rout' to 'surv.Rout.save' ... OK
  Running 'survSplit.R' [2s]
  Comparing 'survSplit.Rout' to 'survSplit.Rout.save' ... OK
  Running 'survcheck.R' [2s]
  Comparing 'survcheck.Rout' to 'survcheck.Rout.save' ... OK
  Running 'survfit1.R' [3s]
  Comparing 'survfit1.Rout' to 'survfit1.Rout.save' ... OK
  Running 'survfit2.R' [3s]
  Comparing 'survfit2.Rout' to 'survfit2.Rout.save' ... OK
  Running 'survreg1.R' [3s]
  Comparing 'survreg1.Rout' to 'survreg1.Rout.save' ... OK
  Running 'survreg2.R' [4s]
  Comparing 'survreg2.Rout' to 'survreg2.Rout.save' ... OK
  Running 'survtest.R' [2s]
  Comparing 'survtest.Rout' to 'survtest.Rout.save' ... OK
  Running 'testci.R' [3s]
  Comparing 'testci.Rout' to 'testci.Rout.save' ... OK
  Running 'testci2.R' [3s]
  Comparing 'testci2.Rout' to 'testci2.Rout.save' ... OK
  Running 'testnull.R' [3s]
  Comparing 'testnull.Rout' to 'testnull.Rout.save' ... OK
  Running 'testreg.R' [3s]
  Comparing 'testreg.Rout' to 'testreg.Rout.save' ... OK
  Running 'tiedtime.R' [2s]
  Comparing 'tiedtime.Rout' to 'tiedtime.Rout.save' ... OK
  Running 'tmerge.R' [2s]
  Comparing 'tmerge.Rout' to 'tmerge.Rout.save' ... OK
  Running 'tmerge2.R' [2s]
  Comparing 'tmerge2.Rout' to 'tmerge2.Rout.save' ... OK
  Running 'tmerge3.R' [3s]
  Comparing 'tmerge3.Rout' to 'tmerge3.Rout.save' ... OK
  Running 'tt.R' [3s]
  Comparing 'tt.Rout' to 'tt.Rout.save' ... OK
  Running 'turnbull.R' [3s]
  Comparing 'turnbull.Rout' to 'turnbull.Rout.save' ... OK
  Running 'update.R' [2s]
  Comparing 'update.Rout' to 'update.Rout.save' ... OK
  Running 'yates0.R' [1s]
  Comparing 'yates0.Rout' to 'yates0.Rout.save' ... OK
  Running 'yates1.R' [3s]
  Comparing 'yates1.Rout' to 'yates1.Rout.save' ... OK
  Running 'yates2.R' [3s]
  Running 'zph.R' [3s]
  Comparing 'zph.Rout' to 'zph.Rout.save' ... OK
Running the tests in 'tests/coxsurv5.R' failed.
Complete output:
  > library(survival)
  > aeq <- function(x, y) all.equal(as.vector(x), as.vector(y))
  > # 
  > # Compute the hazard functions for a multi-state Cox model
  > #
  > coxhaz <- function(y, id, risk, wt) {
  +     # y should be a multi-state survival
  +     if (!inherits(y, "Surv") || attr(y, "type") != "mcounting")
  +         stop("invalid response")
  + 
  +     n <- nrow(y)
  +     if (missing(id) || length(id) !=n) stop("invalid id")
  +      
  +     if (missing(wt)) wt <- rep(1.0, n)
  +     else if (length(wt) !=n || any(wt <=0)) stop("invalid wt")
  + 
  +     # get the current state, and the list of transtions
  +     #  transitions to censor don't count
  +     mcheck <- survcheck(y~1, id= id)
  +     states <- mcheck$states
  +     nstate <- length(states)
  +     istate <- mcheck$istate
  + 
  +     event <- y[,3] > 0
  +     temp <- attr(y, 'states')[y[event,3]]
  +     tmat <- table(y[event,2], from=istate[event], to=temp)
  +     tmat2 <- tapply(wt[event], list(y[event,2], from=mcheck$istate[event],
  +                                     to=temp), sum)
  +     tmat2 <- ifelse(is.na(tmat2), 0, tmat2)
  + 
  + 
  +     # Hazards can be done one at a time.  For each of them the risk
  +     #  weight vector for the subjects can be different.
  +     # First organized the material as a 2 dim matrix
  +     temp <- apply(tmat, 2:3, sum)
  +     keep <- which(temp>0)
  +     from <- states[row(temp)[keep]]
  +     hlab <- outer(rownames(temp), colnames(temp), paste, sep=':')[keep]
  +     nhaz <- length(keep)
  +     nevent <- matrix(tmat2, nrow(tmat2))[,keep]
  +     dtime <- sort(unique(y[event,2]))
  +     ntime <- length(dtime)
  + 
  +     if (missing(risk)) risk <- matrix(1, nrow=n, ncol=nhaz)
  +     if (!is.matrix(risk) || nrow(risk) != n || ncol(risk) != nhaz)
  +         stop("invalid risk matrix")
  +     risk <- risk * wt
  + 
  +     # get the weighted at risk at each time
  +     wtrisk <- matrix(, length(dtime), nhaz)
  +     statematch <- outer(istate, from, function(x, y) x==y)
  +     risk <- ifelse(statematch, risk, 0)
  +     for (i in 1:ntime) {
  +         atrisk <- (y[,1]< dtime[i] & y[,2] >= dtime[i])
  +         wtrisk[i,] <- colSums(risk[atrisk,, drop=FALSE]) 
  +     }
  + 
  +     haz <- nevent/ifelse(wtrisk==0, 1, wtrisk)   # avoid 0/0
  +     chaz<- apply(haz, 2, cumsum)
  +     
  +     list(time=dtime, nrisk=wtrisk, nevent=nevent,
  +          haz=haz, cumhaz=chaz, states=states)
  + }
  > 
  > mtest <- data.frame(id= c(1, 1, 1,  2,  3,  4, 4, 4,  5, 5),
  +                     t1= c(0, 4, 9,  0,  2,  0, 2, 8,  1, 3),
  +                     t2= c(4, 9, 10, 5,  9,  2, 8, 9,  3, 11),
  +                     state= c(1, 2,  1, 2,  3,  1, 3, 0,  2,  0),
  +                     x = c(0, 0,  0, 1,  1,  0, 0, 0,  2,  2))
  > mtest$state <- factor(mtest$state, 0:3, c("censor", "a", "b", "c"))
  > 
  > # True results
  > #
  > #time       at risk               events
  > #         entry  a   b  c        
  > #
  > #2        1245                   4 -> a
  > #3        1235   4               5 -> b
  > #4        123    4   5           1 -> a
  > #5         23    14  5           2 -> b, exits
  > #8         3     14  5           4 -> c
  > #9         3     1   5  4        1->b, 3->c & exit, 4 censored
  > #10                  15          1->a, exit
  > #11                   5          censor
  > 
  > # with all coefficients =0 
  > check1 <- coxhaz(Surv(mtest$t1, mtest$t2, mtest$state), mtest$id)
  > fit1 <- survfit(Surv(t1, t2, state) ~1, mtest, id=id)
  > aeq(check1$cumhaz, fit1$cumhaz[match(check1$time, fit1$time),])
  [1] TRUE
  > 
  > dummy <- data.frame(x=1:2)
  > cox0 <-  coxph(Surv(t1, t2, state) ~x, iter=0, mtest, id=id)
  > cfit0 <- survfit(cox0, newdata=dummy)
  > indx <- match(check1$time, cfit0$time)
  > aeq(check1$cumhaz, cfit0$cumhaz[indx,1,])
  [1] TRUE
  > aeq(check1$cumhaz, cfit0$cumhaz[indx,2,])
  [1] TRUE
  > 
  > # a fixed coefficient
  > mfit <- coxph(Surv(t1, t2, state) ~x, iter=0, mtest, id=id,
  +               init= log(1:6))
  > msurv <- survfit(mfit, newdata=list(x=0:1))
  > mrisk <- exp(outer(mtest$x, log(1:6), '*'))  # hazards for each transition
  > check2 <- with(mtest, coxhaz(Surv(t1, t2, state), id=id, risk=mrisk))
  > aeq(check2$cumhaz, msurv$cumhaz[indx,1,])
  [1] TRUE
  > 
  > # a different predicted x multiplies each column of the cumulative hazard
  > aeq(check2$cumhaz %*% diag(1:6), msurv$cumhaz[indx,2,]) 
  [1] TRUE
  > 
  > if (FALSE) {
  +     # this graph is very useful
  +     temp <- survcheck(Surv(t1, t2, state) ~1, mtest, id=id)
  +     plot(c(0,11), c(1,5.1), type='n', xlab="Time", ylab= "Subject")
  +     with(mtest, segments(t1+.1, id, t2, id, col=as.numeric(temp$istate)))
  +     event <- subset(mtest, state!='censor')
  +     text(event$t2, event$id+.2, as.character(event$state))
  + }
  >          
  > 
  > # slight change, add a few censored subjects
  > #  all the events happen on even numbered days
  > test2 <- data.frame(id= c(1, 1, 1,  2,  3,  4, 4, 4,  5, 5,
  +                           6, 7, 8,  9),
  +                     t1= c(0, 8, 18,  0,  4,  0, 4, 16,  2, 6,
  +                           0, 0, 7,  8),
  +                     t2= c(8, 18, 20, 10,  18,  4, 16, 18,  6, 22,
  +                           5, 10,  10, 15),
  +                     state= c(1, 2,  1, 2,  3,  1, 3, 0,  2,  0,0,0,0,0),
  +                     x = c(0, 0,  0, 1,  1,  0, 0, 0,  2,  2, 1, 1, 2, 0))
  > test2$state <- factor(test2$state, 0:3, c("censor", "a", "b", "c"))
  > 
  > if (FALSE) {
  +     # this graph is very useful
  +     temp <- survcheck(Surv(t1, t2, state) ~1, test2, id=id)
  +     plot(c(0,22), c(1,9.1), type='n', xlab="Time", ylab= "Subject")
  +     with(test2, segments(t1+.1, id, t2, id, col=as.numeric(temp$istate)))
  +     event <- subset(test2, state!='censor')
  +     text(event$t2, event$id+.2, as.character(event$state))
  + }
  > 
  > # s0 to a, cumhaz of 1/6 (t=4) + 1/5 (t=8)
  > #  b to a, cumhaz of 1/2 at 20
  > # s0 to b, cumhaz of 1/5 at 6, +1/5 at 10
  > #  a to b, cumhaz of 1/1 at 18
  > # s0 to c, cumhaz of 1/1 at 18
  > #  a to c, cumhaz of 1/2 at 16
  > time2 <-     c(4,5,6,8,10,15,16,18,20, 22)
  > chaz2 <- matrix(0, nrow=10, ncol=6,
  +             dimnames=list(time2, c("1:2", "1:3", "1:3", "2:3", "1:4", "2:4")))
  > chaz2['4',1] <- 1/6; chaz2['8',1] <- 1/5
  > chaz2['20',2] <- 1/2
  > chaz2['6', 3] <- 1/5; chaz2['10', 3] <- 1/5
  > chaz2['18',4:5] <- 1
  > chaz2['16', 6] <- 1/2
  > chaz2 <- apply(chaz2, 2, cumsum)
  >  
  > 
  > cox3 <- coxph(Surv(t1, t2, state) ~x, id=id, test2, iter=0)  # no weights
  > csurv3 <- survfit(cox3, newdata=data.frame(x=0:1))
  > aeq(csurv3$time, time2)
  [1] TRUE
  > aeq(csurv3$cumhaz[,1,], chaz2)
  [1] TRUE
  > aeq(csurv3$cumhaz[,2,], chaz2)
  [1] TRUE
  > check3 <- with(test2, coxhaz(Surv(t1, t2, state), id=id))
  > indx3 <- match(check3$time, csurv3$time)
  > aeq(check3$cumhaz, chaz2[indx3,])  # a check on the coxhaz function above
  [1] TRUE
  > 
  > cox4 <- coxph(Surv(t1,t2, state) ~ x, id=id, test2, 
  +                      init=log(1:6), iter=0)
  > csurv4 <- survfit(cox4, newdata=data.frame(x=0:1))
  Error in temp[indx1, indx2[indx2 > 0]] <- mcheck$transitions[, indx2 >  : 
    NAs are not allowed in subscripted assignments
  Calls: survfit -> survfit.coxphms -> survfitCI
  Execution halted