[S] "subscripting" a survival curve

Therneau, Terry M., Ph.D. (therneau@mayo.edu)
Thu, 10 Sep 1998 07:49:20 -0500


The function below has been submitted to StatSci, and
will be "built-in" to some future release of Splus, 5.x I would assume.
(It should have been there long ago). It defines a subscript function for
survival curves. In answer to Chi-tsungs's question, using the leukemia
data set that comes with Splus:

fit <- survfit(Surv(time, status) ~ group, data=leukemia)
curve1 <- fit[1]
plot(curve1) #plot first group, with confidence limits
lines(fit[2], col=3)#add second curve without CI limits
etc

The data that he wanted is curve1$time.

If survfit() is applied to a Cox model, the model has multiple strata, and
the newdata dataframe has multiple observations then the survfit object will
contain a matrix of survival curves. This is the only situation in which two
subscripts are appropriate. (For any of you who wonder at the "is.matrix"
clause below).

Terry Therneau (author of the survival code)

------------------

#SCCS 09/01/98 @(#)survfit.s 4.11
"[.survfit" <- function(fit,i,j, drop=F) {
if (is.null(fit$strata)) {
if (is.matrix(fit$surv)) {
fit$surv <- fit$surv[,i,drop=drop]
if (!is.null(fit$std.err)) fit$std.err <- fit$std.err[,i,drop=drop]
if (!is.null(fit$upper)) fit$upper <- fit$upper[,i,drop=drop]
if (!is.null(fit$lower)) fit$lower <- fit$lower[,i,drop=drop]
}
else warning("Survfit object has only a single survival curve")
}
else {
if (missing(i)) keep <- seq(along=fit$time)
else {
if (is.character(i)) strat <- rep(names(fit$strata), fit$strata)
else strat <- rep(1:length(fit$strata), fit$strata)
keep <- seq(along=strat)[match(strat, i, nomatch=0)>0]
if (length(i) <=1) fit$strata <- NULL
else fit$strata <- fit$strata[i]
fit$time <- fit$time[keep]
fit$n.risk <- fit$n.risk[keep]
fit$n.event <- fit$n.event[keep]
}
if (is.matrix(fit$surv)) {
if (missing(j)) {
fit$surv <- fit$surv[keep,,drop=drop]
if (!is.null(fit$std.err))
fit$std.err <- fit$std.err[keep,,drop=drop]
if (!is.null(fit$upper)) fit$upper <-fit$upper[keep,,drop=drop]
if (!is.null(fit$lower)) fit$lower <-fit$lower[keep,,drop=drop]
}
else {
fit$surv <- fit$surv[keep,j]
if (!is.null(fit$std.err)) fit$std.err <- fit$std.err[keep,j]
if (!is.null(fit$upper)) fit$upper <- fit$upper[keep,j]
if (!is.null(fit$lower)) fit$lower <- fit$lower[keep,j]
}
}
else {
fit$surv <- fit$surv[keep]
if (!is.null(fit$std.err)) fit$std.err <- fit$std.err[keep]
if (!is.null(fit$upper)) fit$upper <- fit$upper[keep]
if (!is.null(fit$lower)) fit$lower <- fit$lower[keep]
}
}
fit
}

-----------------------------------------------------------------------
This message was distributed by s-news@wubios.wustl.edu. To unsubscribe
send e-mail to s-news-request@wubios.wustl.edu with the BODY of the
message: unsubscribe s-news