tests/test.R

In cmprsk: Subdistribution Analysis of Competing Risks

library(cmprsk)

options(warn=-1)
RNGversion("1.6.2")
options(warn=0)

set.seed(2)
ss <- rexp(100)
gg <- factor(sample(1:3,100,replace=TRUE),1:3,c('a','b','c'))
cc <- sample(0:2,100,replace=TRUE)
strt <- sample(1:2,100,replace=TRUE)
dd <- data.frame(ss=abs(rnorm(100)))
d2 <- data.frame(ssd=ss,ggd=gg,ccd=cc,strtd=strt,X=c(rep(1,80),rep(0,20)))
gg2 <- gg
gg2[c(5,10,50)] <- NA
print(xx <- cuminc(dd$ss,cc,gg,strt))
print(xx <- cuminc(d2$ssd,d2$ccd))
print(xx <- cuminc(ss,cc))
print(xx <- cuminc(ss,cc,gg,strt))
plot(xx)
plot(xx,lty=1,color=1:6)
print(xx <- cuminc(dd$ss,cc,gg2,strt))
print(xx <- cuminc(ss,cc,gg2,strt,subset=d2$X == 1))
attach(d2)
print(xx <- cuminc(ssd,ccd,gg2,strtd,subset=X == 1))
print(xx <- cuminc(ssd,ccd,gg2,strtd,subset=gg != 'b'))
print(xx <- cuminc(ssd,ccd,gg2,strtd,subset=ggd != 'b'))
print(xx <- cuminc(ssd,ccd,gg2,strtd,subset=gg2 != 'b'))
detach(d2)

cv <- matrix(sample(0:1,3*100,replace=TRUE),ncol=3)
cv[c(1,10,20)] <- NA
print(xx <- crr(ss,cc,cv))
cov2 <- cbind(cv[,1],cv[,1])
tf <- function(uft) cbind(uft,uft^2)
print(ww <- crr(ss,cc,cv,cov2,tf=tf,cengroup=cv[,3]))
plot(ww$uft,ww$res[,1])
lines(lowess(ww$uft,ww$res[,1],iter=0,f=.75))
print(wp <- predict(ww,rbind(c(1,1,1),c(0,0,0)),rbind(c(1,1),c(0,0))))
plot(wp)
plot(wp,lty=1,col=c(2,4))
d2 <- cbind(d2,cv3=cv[,3],cv1=cv[,1])
attach(d2)
print(ww <- crr(ssd,ccd,cbind(cv[,1:2],cv3),cov2,tf=tf,cengroup=cv3))
print(ww <- crr(ssd,ccd,cbind(cv[,1:2],cv3),cov2,tf=tf))
print(ww <- crr(ssd,ccd,cbind(cv[,1:2],cv3),cbind(cv1,cv1),tf=tf,cengroup=cv3))
print(ww <- crr(ssd,ccd,cbind(cv[,1:2],cv3),cbind(cv1,cv1),tf=tf,cengroup=cv3,subset=X == 1))
print(summary(ww))
detach(d2)
print(ww <- crr(ss,cc,cv,cov2,tf=tf,cengroup=cv[,3],subset=d2$X==1))
print(ww <- crr(ss,cc,cv,cov2,tf=tf,cengroup=cv[,3],failcode=2))
print(ww <- crr(ss,cc,cv,cov2,tf=tf,cengroup=cv[,3],cencode=2))
print(ww <- crr(ss,cc,cv[,1]))
print(ww <- crr(ss,cc,cov2=cv[,1],tf=function(x) x))
print(summary(ww))