# plotting event chart,
#
# data: a dataframe or a matrix, "dimnames" are used as variable names
#
# events: vector of variable names or column indices in "data" corresponding to various events
#
# status: vector of variable names or column indices in "data" corresponding to status
#              (censor information) of various events, status variables must have values 0 or 1
#              (0 = censored, 1 = un-censored)
#
# by: vector of variable names or column indices in "data" corresponding to the "sort by" variables
#
# subset: any argument used to subset data, ie a vector of T or F, a condition event.1>5 where event.1
#                is the name of a column in data, or any usual subscripting argument
#
# legend.at: positions of the legend box
#
# group.at: positions of the group legend box (if group!=NA)
#
# sym.size: sizes of the symbol used in drawing the points
#
# examples:
#
# 1 event.chart.lite(ovarian,'time','status')
# 2 event.chart.lite(ovarian,'time','status',by='group')
# 3 event.chart.lite(ovarian,'time','status',subset=ovarian$group==0)
 
event.chart.lite<-function(data, events, status, by = events, subset = NA,
legend.at =NULL, sym.size = rep(0.075, length(events)), xlab = "Time",
ylab = "Patient", tit = "Event Chart", nolegend = F, ...)
{
 
if(!is.matrix(data) && !is.data.frame(data))
stop("argument data must be a matrix or a data frame\n")
if(is.na(subset[1])==F){
attach(data)
data<-data[subset,]
}
rows <- dim(data)[1]
ecount <- length(events)
pty <- c(15, 16, 17, 18)
pty.cen <- c(0, 1, 2, 5)
 
if(ecount > length(pty))
stop("too many event types\n")
if(ecount != length(status))
stop("arguments events and status must have the same length\n")
 
pty <- pty[1:ecount]
pty.cen <- pty.cen[1:ecount]
by <- by[by != "NA"]
by <- by[!is.na(by)]
 
if(length(by) > 0)
data <- lsort(data, by = by)
maxtime <- max(data[, events], na.rm = T)
ltypes <- rep(1, rows)
par(omi = rep(0, 4))
plot(1:rows, type = "n", xlim = c(0, (4 * maxtime)/3), ylim = c(0, rows+1), xlab = xlab, ylab = ylab)
title(tit)
for(i in 1:rows) {
ypos <- rows - i + 1
lines(c(0, max(data[i, events], na.rm = T)), rep(ypos, 2), lty = ltypes[i], ...)
for(j in 1:ecount) {
if(data[i, status[j]])
symbol <- pty[j]
else
symbol <- pty.cen[j]
points(data[i, events[j]], ypos, pch = symbol, mkh = sym.size[j], ...)
}
}
if(!nolegend) {
if(length(legend.at) == 0)
legend.at <- c(1.05 * maxtime, rows)
legend.string <- rbind(dimnames(data[, events])[[2]], rep("censored", ecount))
if(is.null(dimnames(data[,events])[[2]]) == F)
legend(legend.at[[1]], legend.at[[2]], legend.string, marks = c(rbind(pty,pty.cen)))
else
legend(legend.at[[1]], legend.at[[2]], legend.string, marks = c(pty.cen))
 
}
cat("done\n")
}
lsort<-function(data, by = 1:dim(data)[2], asc = rep(T, length(by)), na.last = T)
{
 
m <- dim(data)[1]
keys <- 1:m
rotate <- m:1
for(i in length(by):1) {
if(asc[i])
keys[] <- keys[sort.list(data[, by[[i]]][keys], na.last = na.last)]
else keys[] <- keys[order(data[, by[[i]]][keys], rotate, na.last = na.last)[rotate]]
}
data[keys, ]
}