TABLE OF CONTENTS

S3Methods/splinesurv.formula [ Functions ]

NAME

    splinesurv.formula --- formula interface for splinesurv

FUNCTION

This is the main user-facing interface function. It takes a formula and additional parameters, conducts basic input checking and builds a data frame in the format required by splinesurv.agdata. After fitting is done, it constructs the splinesurv output object.

SYNOPSIS

3490 splinesurv.formula <- function(formula, data = parent.frame(), ...)

INPUTS

    See package documentation

OUTPUTS

    See package documentation for splinesurv object

SOURCE

3493 {
3494     # in part based on coxph function
3495     call <- match.call()
3496     m <- match.call(expand.dots = FALSE)
3497     if(is.matrix(eval(m$data, sys.parent()))) m$data <- as.data.frame(data)
3498     m$...<-NULL
3499     m[[1]] <- as.name("model.frame")
3500     special <- "cluster"
3501     Terms <- if (missing(data)) terms(formula, special) else 
3502         terms(formula, special, data = data)    
3503     m$formula <- Terms
3504     m <- eval(m, sys.parent())
3505     n <- nrow(m)
3506     # Check response
3507     resp <- model.extract(m, "response")
3508     if (!is.Surv(resp)) stop("model response must be a Surv object")
3509     if(attr(resp, "type") != "right") stop("right - censored survival data only")
3510     time <- resp[, "time"]
3511     delta <- resp[, "status"]
3512     clusterind <- attr(Terms, "specials")$cluster
3513     clusterind0 <- NULL
3514     dropx <- NULL
3515     # handle cluster special terms
3516     clusternames <- NULL
3517     if(length(clusterind) > 0){
3518         cluster <- m[, clusterind]
3519         for(j in 1:dim(data)[2]) if(isTRUE(all.equal(data[, j], cluster))) clusterind0 <- j
3520         if(is.factor(cluster)) clusternames <- levels(cluster)
3521         if(is.numeric(cluster)) clusternames <- as.character(unique(cluster))
3522         i <- as.numeric(as.factor(cluster))
3523         tempc <- untangle.specials(Terms, "cluster", 1:10)
3524         ord <- attr(Terms, "order")[tempc$terms]
3525         if (any(ord > 1)) stop("Cluster can not be used in an interaction")
3526         dropx <- c(dropx, tempc$terms)
3527     }else{
3528         i <- rep(1, n)
3529     }
3530     Ji <- drop(table(i))
3531     j <- unlist(as.vector(sapply(Ji, function(x) 1:x)))
3532     newTerms <- if(length(dropx))  Terms[ - dropx] else Terms
3533     # construct data frame for splinesurv.agdata
3534     X <- model.matrix(newTerms, m)
3535     X <- X[, -1, drop = FALSE]
3536     agdata <- as.data.frame(cbind(i, j, time, delta, X))
3537     agdata[, -2] <- agdata[order(agdata$i), -2]
3538     class(agdata) <- c("agdata", "data.frame")
3539     fit <- splinesurv.agdata(agdata, ...)
3540     gcout <- gc()
3541     # clean up output object
3542     fit$call <- call
3543     colnames(fit$history$frailty) <- clusternames
3544     if(!is.null(fit$posterior.mean)) names(fit$posterior.mean$frailty) <- clusternames
3545     fit$terms <- newTerms
3546     attr(fit$terms, "special")$cluster <- clusterind0
3547     return(fit)
3548 }