R/events.R

In mstate: Data Preparation, Estimation and Prediction in Multi-State Models

#' Count number of observed transitions
#' 
#' Given a dataset in long format, for instance generated by
#' \code{\link{msprep}}, and a transition matrix for the multi-state model,
#' this function counts the number of observed transitions in the multi-state
#' model and gives their percentages.
#' 
#' Although \code{msdata} does not need to be the result of a call to
#' \code{\link{msprep}}, it does need to be an object of class \code{"msdata"},
#' which is essentially a data frame in long format, with one row for each
#' transition for which the subject is at risk. The columns \code{from},
#' \code{to}, and \code{status} need to be present, with appropriate meaning,
#' see \code{\link{msprep}}. The \code{msdata} argument needs to have a
#' \code{"trans"} attributes, which holds the transition matrix of the
#' multi-state model.
#' 
#' @param msdata An object of class \code{"msdata"}, such as output by
#' \code{\link{msprep}}
#' @return A list containing two tables, the first, called \code{Frequencies},
#' with the number of observed transitions in the multi-state model occurring
#' in \code{msdata}, the second, called \code{Proportions}, with the
#' corresponding proportions.
#' @author Hein Putter \email{H.Putter@@lumc.nl}
#' @keywords univar
#' @examples
#' 
#' tmat <- trans.illdeath(names=c("Tx","PR","RelDeath"))
#' data(ebmt3) # data from Section 4 of Putter, Fiocco & Geskus (2007)
#' msebmt <- msprep(time=c(NA,"prtime","rfstime"),status=c(NA,"prstat","rfsstat"),
#' 		data=ebmt3,trans=tmat)
#' events(msebmt) # see Fig 13 of Putter, Fiocco & Geskus (2007)
#' 
#' @export events
`events` <- function(msdata)
{
    trans <- attr(msdata, "trans")
    K <- nrow(trans)
    absorbing <- which(apply(is.na(trans), 1, all))
    if (!is.null(dimnames(trans))) states <- dimnames(trans)[[1]]
    else states <- as.character(1:K)
    from <- factor(msdata$from,levels=1:K,labels=states)
    to <- factor(msdata$to,levels=1:K,labels=states)
    tbl <- table(from[msdata$status==1],to[msdata$status==1],dnn=c("from","to"))
    counts <- tbl
    tbl <- table(from,to,dnn=c("from","to"))
    total <- apply(tbl,1,max)
    total[absorbing] <- apply(counts[,absorbing,drop=FALSE], 2, sum)
    noevent <- total - apply(counts,1,sum)
    counts <- cbind(counts,noevent,total)
    dn <- dimnames(counts)
    dn[[2]][(K+1):(K+2)] <- c("no event","total entering")
    names(dn) <- c("from","to")
    dimnames(counts) <- dn
    class(counts) <- "table"
    freqs <- (counts/total)[,-(K+2)]
    class(freqs) <- "table"
    return(list(Frequencies=counts,Proportions=freqs))
}