R/crossvalPerf.bootcv.R

In tagteam/riskRegression: Risk Regression Models and Prediction Scores for Survival Analysis with Competing Risks

# Function to calculate cross-validation performance
crossvalPerf.bootcv <- function(m,crossval,se.fit,keep.cv,byvars,alpha){
    ## score
    if (length(crossval[[1]][[m]]$score)>0){
        cv.score <- data.table::rbindlist(lapply(crossval,function(x){x[[m]]$score}))
        if (se.fit==TRUE){
            bootcv.score <- cv.score[,data.table::data.table(mean(.SD[[m]],na.rm=TRUE),
                                                             se=sd(.SD[[m]],na.rm=TRUE),
                                                             lower=quantile(.SD[[m]],alpha/2,na.rm=TRUE),
                                                             upper=quantile(.SD[[m]],(1-alpha/2),na.rm=TRUE)),by=byvars,.SDcols=m]
            data.table::setnames(bootcv.score,c(byvars,m,"se","lower","upper"))
        }else{
            bootcv.score <- cv.score[,data.table::data.table(mean(.SD[[m]],na.rm=TRUE)),by=byvars,.SDcols=m]
            data.table::setnames(bootcv.score,c(byvars,m))
        }
    }else{
        cv.score <- NULL
        bootcv.score <- NULL
    }
    ## contrasts 
    if (length(crossval[[1]][[m]]$contrasts)>0){
        cv.contrasts <- data.table::rbindlist(lapply(crossval,function(x){x[[m]]$contrasts}))
        delta.m <- paste0("delta.",m)
        bootcv.contrasts <- switch(as.character(as.numeric(se.fit)),
                                   "1"={cv.contrasts[,data.table::data.table(mean(.SD[[delta.m]],na.rm=TRUE),
                                                                             lower=quantile(.SD[[delta.m]],alpha/2,na.rm=TRUE),
                                                                             upper=quantile(.SD[[delta.m]],(1-alpha/2),na.rm=TRUE)),by=c(byvars,"reference"),.SDcols=c(delta.m)]
                                   },
                                   "0"={
                                       bootcv.contrasts <- cv.contrasts[,data.table::data.table(mean(.SD[[delta.m]],na.rm=TRUE)),by=c(byvars,"reference"),.SDcols=delta.m]
                                   })
        data.table::setnames(bootcv.contrasts,"V1",delta.m)
    }else{
        cv.contrasts <- NULL
        bootcv.contrasts <- NULL
    }
    out <- list(score=bootcv.score,contrasts=bootcv.contrasts)
    if (keep.cv)
        out <- c(out,list(cv.score=cv.score,cv.contrasts=cv.contrasts))
    out
}