R/event.r

In mets: Analysis of Multivariate Event Times

## #' Event history object
## #'
## #' Constructur for Event History objects
## #'
## #' ... content for details
## #'
## #' @aliases Event as.character.Event as.matrix.Event [.Event format.Event
## #' print.Event rbind.Event summary.Event
## #' @param time Time
## #' @param time2 Time 2
## #' @param cause Cause
## #' @param cens.code Censoring code (default 0)
## #' @param ... Additional arguments
## #' @return Object of class Event (a matrix)
## #' @author Klaus K. Holst and Thomas Scheike
## #' @examples
## #'
## #' 	t1 <- 1:10
## #' 	t2 <- t1+runif(10)
## #' 	ca <- rbinom(10,2,0.4)
## #' 	(x <- Event(t1,t2,ca))
## #'
## #' @export
## Event <- function(time,time2=TRUE,cause=NULL,cens.code=0,...) {
##     out <- cbind(time,time2,cause)
##     if (!missing(cause)) {
##         colnames(out) <- c("entry","exit","cause")
##     tmp <- (out[,1]>out[,2])
##     if (any(tmp)) warning("entry time later than exit time\n")
## ###    if (any(tmp) & !is.na(tmp)) warning("entry time later than exit time\n")
##     tmp <- (out[,2]<=0)
##     if (any(tmp)) warning("exit times must be >0\n")
## ###    if (any(tmp) & !is.na(tmp)) warning("exit times must be >0\n")
##     } else {
##         colnames(out) <- c("exit","cause")
##     tmp <- (out[,1]<=0)
##     if (any(tmp)) warning("exit times must be >0\n")
## ###    if (any(tmp) & !is.na(tmp)) warning("exit times must be >0\n")
##     }
##     class(out) <- "Event"
##     attr(out,"cens.code") <- cens.code
##     return(out)
## }

## #' @export
## as.matrix.Event <- function(x,...) structure(x,class="matrix")

## #' @export
## as.character.Event <- function(x,...) {
##     if (ncol(x)==3) {
##         res <- paste("(",format(x[,1],...),";",
##                      format(x[,2],...),":",
##                      format(x[,3],...),"]",sep="")
##     } else {
##         res <- paste(format(x[,1],...),":",format(x[,2],...),sep="")
##     }
##     return(res)
## }

## #' @export
## format.Event <- function(x, ...) format(as.character.Event(x), ...)

## #' @export
## as.data.frame.Event <- as.data.frame.model.matrix

## #' @export
## print.Event <- function(x,...) {
##     print(as.matrix(x),...,quote=FALSE)
## }

## #' @export
## summary.Event <- function(object,...) {
##     cat(paste("cens.code=",attr(object,"cens.code"),"\n"))
##     cat("causes:\n")
##     print(table(object[,"cause"]))
##     cat("exit:\n")
##     print(summary(object[,"exit"]))
##     if (ncol(object)==3) {
##     cat("entry:\n")
##        print(summary(object[,"entry"]))
##     cat("exit-entry:\n")
##        print(summary(object[,"exit"]- object[,"entry"]))
##     }
## }


## #' @export
## "[.Event" <- function (x, i, j, drop = FALSE)
## {
##     if (missing(j)) {
##         atr <- attributes(x)
##         class(x) <- "matrix"
##         x <- x[i, , drop = FALSE]
##         class(x) <- "Event"
##         atr.keep <- c("cens.code","entry")
## ###        atr.keep <- c("cens.code")
##         attributes(x)[atr.keep] <- atr[atr.keep]
##         x
##     }
##     else {
##         class(x) <- "matrix"
##         NextMethod("[")
##     }
## }

## #' @export
## rbind.Event <- function(...) {
##   dots <- list(...)
##   cens.code <- attributes(dots[[1]])$cens.code
##   type <- attributes(dots[[1]])$type
##   ncol <- dim(dots[[1]])[2]
##   nrow <- unlist(lapply(dots,nrow))
##   cnrow <- c(0,cumsum(nrow))
##   M <- matrix(ncol=ncol,nrow=sum(nrow))
##   for (i in 1:length(dots)) {
##     M[(cnrow[i]+1):cnrow[i+1],] <- dots[[i]]
##   }
##   x <- c(); for (i in 1:ncol(M)) x <- c(x,list(M[,i]))
##   x <- c(x,list(cens.code=cens.code))
##   do.call("Event",x)
## }