revdep/checks.noindex/riskRegression/old/riskRegression.Rcheck/tests/test-FineGrayRegression.R

In gbm-developers/gbm: Generalized Boosted Regression Models

library(testthat)
context("Fine-Gray regression")
library(cmprsk)
library(riskRegression)
library(data.table)
library(prodlim)
test_that("Formula interface",{
    set.seed(17)
    d <- prodlim::SimCompRisk(100)
    a <- FGR(Hist(time,event)~X1+X2,data=d)
    b <- cmprsk::crr(ftime=d$time,fstatus=d$event,cov1=model.matrix(terms(~X1+X2),data=d)[,-1])
    ## remove call
    b <- b[-match("call",names(b))]
    class(b) <- "crr"
    expect_equal(a$crrFit,b)
})
if(FALSE){
    test_that("Functions of time",{
        qFun <- function(x){x^2}
        id <- function(x){x}
        set.seed(17)
        d <- prodlim::SimCompRisk(100)
        a <- FGR(Hist(time,event)~cov2(X1,tf=qFun)+cov2(X2),data=d)
        b <- with(d,cmprsk::crr(ftime=time,
                                fstatus=cause,
                                cov2=cbind(X1,X2),
                                tf=function(time){cbind(qFun(time),time)}))
        e <- with(d,
                  cmprsk::crr(ftime=time,
                              fstatus=cause,
                              cov2=cbind(X1,X2),
                              tf=function(x){do.call("cbind",
                                                     lapply(list("qFun", "id"), function(f) {do.call(f,list(x))}))}))
        ## remove call
        b <- b[-match("call",names(b))]
        class(b) <- "crr"
        e <- e[-match("call",names(e))]
        class(e) <- "crr"
        expect_equivalent(a$crrFit,b)
        expect_equivalent(a$crrFit,e)
    })
}
## expect_true(length(coef(ee))==4)