tests/testthat/test-summary-score.R

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

### test-summary-score.R ---
#----------------------------------------------------------------------
## Author: Thomas Alexander Gerds
## Created: Apr 12 2020 (07:48)
## Version:
## Last-Updated: May 31 2022 (11:43) 
##           By: Thomas Alexander Gerds
##     Update #: 8
#----------------------------------------------------------------------
##
### Commentary:
##
### Change Log:
#----------------------------------------------------------------------
##
### Code:
library(testthat)
library(survival)
library(riskRegression)
library(data.table)
context("riskRegression")
# {{{ "binary"
for (y in c("binary","survival","competing.risks")){
    print(y)
    set.seed(2)
    d1 <- sampleData(n=112,outcome=y)
    d2 <- sampleData(n=80,outcome=y)
    if (y=="binary"){
        f1 <- glm(Y~X2+X8,data=d1,family="binomial")
        f2 <- glm(Y~X1+X2+X5+X8+X6,data=d1,family="binomial")
        ff <- Y~1
    }
    if (y=="survival"){
        f1 <- coxph(Surv(time,event)~X2+X8,data=d1,x=1L,y=1L)
        f2 <- coxph(Surv(time,event)~X1+X2+X5+X8+X6,data=d1,x=1L,y=1L)
        ff <- Hist(time,event)~1
    }
    if (y=="competing.risks"){
        f1 <- CSC(Hist(time,event)~X2+X8,data=d1)
        f2 <- CSC(Hist(time,event)~X1+X2+X5+X8+X6,data=d1)
        ff <- Hist(time,event)~1
    }
    # with null and se
    x <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2)
    xa <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="auc")
    xb <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="brier")
    for (X in list(x,xa,xb)){
        suppressMessages(expect_output(print(X)))
        expect_output(print(summary(X)))
        expect_output(print(summary(X,what="contrast")))
        expect_output(print(summary(X,what="score")))
    }
    # without null with se
    x <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,null.model=0L)
    xa <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="auc",null.model=0L)
    xb <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="brier",null.model=0L)
    for (X in list(x,xa,xb)){
        suppressMessages(expect_output(print(X)))
        expect_output(print(summary(X)))
        expect_output(print(summary(X,what="contrast")))
        expect_output(print(summary(X,what="score")))
    }
    # without null without se
    x <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,null.model=0L,se.fit=0L)
    xa <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="auc",null.model=0L,se.fit=0L)
    xb <- Score(list(model.1=f1,model.2=f2),formula=ff,data=d2,metric="brier",null.model=0L,se.fit=0L)
    for (X in list(x,xa,xb)){
        suppressMessages(expect_output(print(X)))
        expect_output(print(summary(X)))
        expect_output(print(summary(X,what="contrast")))
        expect_output(print(summary(X,what="score")))
    }
}
# }}}


######################################################################
### test-summary-score.R ends here