tests/testthat/test-initSurvival.R

In bozenne/BuyseTest: Generalized Pairwise Comparisons

if(FALSE){
    library(testthat)
    library(BuyseTest)
    library(data.table)
    library(prodlim)
}

context("Check computation")
BuyseTest.options(keep.survival = TRUE,
                  trace = 0,
                  precompute = FALSE,
                  method.inference = "none")

## does the same as prodlim:::predict.prodlim
## except continue the survival at 0 after last event if it is 0 at last event
predictPL2 <- function(object, times, ...){
    pred <- predict(object, times = times, ...)

    index.plus <- which(times>max(object$time))
    if( (length(index.plus)>0) && (utils::tail(object$surv,1) == 0) ){
        pred[index.plus] <- 0
    }

    return(pred)
}

## * No strata

## ** settings
dataT <- data.table(time = 1:5,
                    treatment = "T",
                    status1 = c(1,0,1,1,1),
                    status2 = c(1,0,1,1,1),
                    status3 = c(1,1,1,1,1))
dataC <- data.table(time = c(1:5-0.1,5,5),
                    treatment = "C",
                    status1 = c(1,1,0,1,0,0,0),
                    status2 = c(1,1,0,1,0,1,1),
                    status3 = c(1,1,1,1,1,1,1))
data <- rbind(dataC, dataT)
seqThreshold <- c(0,0.5,1.1)

## ** tests
for(iData in 1:3){ ## iData <- 1

    data[, status := .SD[[paste0("status",iData)]]]

    e.survC <- prodlim(Hist(time, status) ~ 1, data = data[treatment=="C"])
    e.survT <- prodlim(Hist(time, status) ~ 1, data = data[treatment=="T"])
    ## plot(e.survT)
    ## plot(e.survC)

    for(iThreshold in seqThreshold){ ## iThreshold <- 0
        
        ## *** Compute survival
        form <- as.formula(paste0("treatment ~ tte(time, status = status, threshold = ",iThreshold,")"))
        outBT <- BuyseTest(form, data = data) ## outBT <- BuyseTest(form, data = data, method.inference = "u-statistic")
        outSurv <- getSurvival(outBT, endpoint = 1, strata = 1, unlist = TRUE)

        if(iData==3){next} ## survival not used because no censoring
        
        ## *** Check at jump times
        test_that("initSurvival (jump times, no strata)",{
            ## correct jump times
            expect_equal(e.survC$time[e.survC$hazard>0],
                         outSurv$survJumpC[,"time"])
            expect_equal(e.survT$time[e.survT$hazard>0],
                         outSurv$survJumpT[,"time"])

            ## correct survival
            expect_equal(predictPL2(e.survC, times = outSurv$survJumpT[,"time"] + iThreshold),
                         outSurv$survJumpT[,"survival"])
            expect_equal(predictPL2(e.survT, times = outSurv$survJumpC[,"time"] + iThreshold),
                         outSurv$survJumpC[,"survival"])

            ## correct jumps in survival
            expect_equal(diff(predictPL2(e.survC, times = c(0,outSurv$survJumpC[,"time"]))),
                         outSurv$survJumpC[,"dSurvival"])
            expect_equal(diff(predictPL2(e.survT, times = c(0,outSurv$survJumpT[,"time"]))),
                         outSurv$survJumpT[,"dSurvival"])

            
        })
        
        ## *** Check at observation time
    
        test_that("initSurvival (observation times, no strata)",{
            ## correct time
            expect_equal(data[treatment=="C",time],
                         outSurv$survTimeC[,"time"])

            expect_equal(data[treatment=="T",time],
                         outSurv$survTimeT[,"time"])

            ## correct survival
            expect_equal(predictPL2(e.survC, times = data[treatment=="C",time] - outBT@threshold),
                         outSurv$survTimeC[,"survivalC-threshold"])
            expect_equal(predictPL2(e.survC, times = data[treatment=="C",time]),
                         outSurv$survTimeC[,"survivalC_0"])
            expect_equal(predictPL2(e.survC, times = data[treatment=="C",time] + iThreshold),
                         outSurv$survTimeC[,"survivalC+threshold"])

            expect_equal(predictPL2(e.survT, times = data[treatment=="C",time] - outBT@threshold),
                         outSurv$survTimeC[,"survivalT-threshold"])
            expect_equal(predictPL2(e.survT, times = data[treatment=="C",time]),
                         outSurv$survTimeC[,"survivalT_0"])
            expect_equal(predictPL2(e.survT, times = data[treatment=="C",time] + iThreshold),
                         outSurv$survTimeC[,"survivalT+threshold"])

            ## correct survival (treatment observation times)
            expect_equal(predictPL2(e.survC, times = data[treatment=="T",time] - outBT@threshold),
                         outSurv$survTimeT[,"survivalC-threshold"])
            expect_equal(predictPL2(e.survC, times = data[treatment=="T",time]),
                         outSurv$survTimeT[,"survivalC_0"])
            expect_equal(predictPL2(e.survC, times = data[treatment=="T",time] + iThreshold),
                         outSurv$survTimeT[,"survivalC+threshold"])

            expect_equal(predictPL2(e.survT, times = data[treatment=="T",time] - outBT@threshold),
                         outSurv$survTimeT[,"survivalT-threshold"])
            expect_equal(predictPL2(e.survT, times = data[treatment=="T",time]),
                         outSurv$survTimeT[,"survivalT_0"])
            expect_equal(predictPL2(e.survT, times = data[treatment=="T",time] + iThreshold),
                         outSurv$survTimeT[,"survivalT+threshold"])
        })
    
    }
}
    
## * With strata

## ** settings
threshold <- 0.001

dataT <- data.table(time = 1:5,
                    treatment = "T",
                    status = c(1,0,1,1,1)
                    )
dataC <- data.table(time = c(1:5-0.1,5,5),
                    treatment = "C",
                    status = c(1,1,0,1,0,0,0)
                    )
data <- rbind(dataC, dataT)
dataStrata <- rbind(cbind(data, strata = 1),
                    cbind(data, strata = 2)
                    )

## ** tests
outBT <- BuyseTest(treatment ~ tte(time, status = status) + strata,
                   data = dataStrata)
outSurv <- getSurvival(outBT, endpoint = 1, unlist = TRUE)

for(iStrata in 1:2){ ## iStrata <- 1
    iE.survC <- prodlim(Hist(time, status) ~ 1, data = dataStrata[treatment=="C" & strata == iStrata])
    iE.survT <- prodlim(Hist(time, status) ~ 1, data = dataStrata[treatment=="T" & strata == iStrata])

    ## *** Control at jump times
    test_that("initSurvival (jump times, strata)",{    
        ## correct jump times
        expect_equal(iE.survC$time[iE.survC$hazard>0],
                     outSurv$survJumpC[[iStrata]][,"time"])
        expect_equal(iE.survT$time[iE.survT$hazard>0],
                     outSurv$survJumpT[[iStrata]][,"time"])

        ## correct jumps in survival
        expect_equal(diff(c(1,iE.survC$surv[iE.survC$hazard>0])),
                     outSurv$survJumpC[[iStrata]][,"dSurvival"])
        expect_equal(diff(c(1,iE.survT$surv[iE.survT$hazard>0])),
                     outSurv$survJumpT[[iStrata]][,"dSurvival"])

        ## correct survival
        expect_equal(predictPL2(iE.survT, times = iE.survC$time[iE.survC$hazard>0] - outBT@threshold),
                     outSurv$survJumpC[[iStrata]][,"survival"])
        expect_equal(predictPL2(iE.survC, times = iE.survT$time[iE.survT$hazard>0]),
                     outSurv$survJumpT[[iStrata]][,"survival"])
    })
    
    ## *** Control at observation time
    test_that("initSurvival (observation times, strata)",{        
        ## correct time
        expect_equal(data[treatment=="C",time],
                     outSurv$survTimeC[[iStrata]][,"time"])

        expect_equal(data[treatment=="T",time],
                     outSurv$survTimeT[[iStrata]][,"time"])

        ## correct survival (control observation times)
        expect_equal(predictPL2(iE.survC, times = data[treatment=="C",time] - outBT@threshold),
                     outSurv$survTimeC[[iStrata]][,"survivalC-threshold"])
        expect_equal(predictPL2(iE.survC, times = data[treatment=="C",time]),
                     outSurv$survTimeC[[iStrata]][,"survivalC_0"])
        expect_equal(predictPL2(iE.survC, times = data[treatment=="C",time]),
                     outSurv$survTimeC[[iStrata]][,"survivalC+threshold"])

        expect_equal(predictPL2(iE.survT, times = data[treatment=="C",time] - outBT@threshold),
                     outSurv$survTimeC[[iStrata]][,"survivalT-threshold"])
        expect_equal(predictPL2(iE.survT, times = data[treatment=="C",time]),
                     outSurv$survTimeC[[iStrata]][,"survivalT_0"])
        expect_equal(predictPL2(iE.survT, times = data[treatment=="C",time]),
                     outSurv$survTimeC[[iStrata]][,"survivalT+threshold"])

        ## correct survival (treatment observation times)
        expect_equal(predictPL2(iE.survC, times = data[treatment=="T",time] - outBT@threshold),
                     outSurv$survTimeT[[iStrata]][,"survivalC-threshold"])
        expect_equal(predictPL2(iE.survC, times = data[treatment=="T",time]),
                     outSurv$survTimeT[[iStrata]][,"survivalC_0"])
        expect_equal(predictPL2(iE.survC, times = data[treatment=="T",time]),
                     outSurv$survTimeT[[iStrata]][,"survivalC+threshold"])

        expect_equal(predictPL2(iE.survT, times = data[treatment=="T",time] - outBT@threshold),
                     outSurv$survTimeT[[iStrata]][,"survivalT-threshold"])
        expect_equal(predictPL2(iE.survT, times = data[treatment=="T",time]),
                     outSurv$survTimeT[[iStrata]][,"survivalT_0"])
        expect_equal(predictPL2(iE.survT, times = data[treatment=="T",time]),
                     outSurv$survTimeT[[iStrata]][,"survivalT+threshold"])
    })
}