[R] Re: variations on the theme of survSplit

[David Duffy]

Danardono <daodao99 at student.umu.se> wrote:
>
> While waiting for 2.1, for those who need function[s] for this
> survival-splitting business, as I do,   this 'survcut' function below
> might be helpful.
> It is not an elegant nor efficient function but it works, at least for
> some examples below.
>
Ditto the following, for the case where there are multiple time-varying
(irreversible) binary covariates, here slicing as coarsely as possible.

#
# Create dataset for survival analysis with time-dependent covariate
# Gill-Anderson model
#
x <- data.frame(onset=c(46, 32, 53, 76, 64, 43),
                case=c(1,1,1,0,0,0),
                ooph=c(NA, 30, 38, 50, NA, NA),
                ocp=c(1,1,0,0,1,0),
                parity=c(2,0,1,3,3,2),
                age.preg=c(28,NA,27,20,22,23))

make.dep <- function(onset, case, time.dep, covs=NULL) {
  if (is.null(n.time.dep <- ncol(time.dep))) {
    if (!is.null(time.dep)) {
      n.time.dep <- 1
      time.dep <- as.matrix(time.dep)
    }else{
      n.time.dep <- 0
      warning("No time dependent covariates")
    }
  }
  if (is.null(n.covs <- ncol(covs))) {
    if (!is.null(covs)) {
      n.covs <- 1
      covs <- as.matrix(covs)
    }else{
      n.covs <- 0
    }
  }
  ordered.t <- t(apply(cbind(onset,time.dep),1,sort,na.last=TRUE))
  tot.time.dep <- apply(ordered.t,1,function(x) sum(!is.na(x)))
  ordered.t <- cbind(rep(0, nrow(ordered.t)), ordered.t)
  npars <- 4+n.time.dep+n.covs
  nrecs <- sum(tot.time.dep)
  new.x <- as.data.frame(matrix(nr=nrecs, nc=npars))
  names(new.x) <- c("start", "stop", "event", names(time.dep),names(covs),"episode")
  this.rec<-0
  for(i in 1:length(onset)) {
    for(j in 1:tot.time.dep[i]) {
      this.rec <- this.rec+1
      new.x[this.rec,1] <- ordered.t[i, j]
      new.x[this.rec,2] <- ordered.t[i, j+1]
      new.x[this.rec,3] <- 0
      new.x[this.rec,4:(3+n.time.dep)] <- (ordered.t[i,j]>=time.dep[i,])
      missing <- is.na(new.x[this.rec,])
      new.x[this.rec,missing] <- 0
      if (n.covs>0) {
        new.x[this.rec, (4+n.time.dep):(4+n.time.dep+n.covs)] <- covs[i,]
      }
      new.x[this.rec, npars]<-paste(i,j,sep=".")
    }
    new.x[this.rec,3]<-case[i]
  }
  new.x
}

David Duffy.