#' @title Number of events tables
#' @name eventTab
#' @description Creates a table for each risk, containing number of events up to given time in groups.
#' @param time vector with times of the first event or follow-up, must be numeric.
#' @param risk vector with type of event, can be numeric or factor/character.
#' @param group vector with group variable, can be numeric or factor/character.
#' @param cens value of 'risk' indicating censored observation (if NULL, the first value of 'risk' vector will be taken).
#' @param title title of a table.
#' @return A grob with n tables, where n is number of risks. Each table contains number of events that have happened in each group up to given time point (the time points correspond to breaks at x-axis of plots with cumulative incidence curves).
#' @export
#' @seealso \code{\link[cr17]{plotCuminc}}
#' @examples eventTab(time = LUAD$time, risk = LUAD$event, group = LUAD$gender, cens = "alive",
#' title = "Number of events")
#' @importFrom dplyr filter
#' @importFrom scales extended_breaks
#' @importFrom grid textGrob gpar
#' @importFrom gridExtra tableGrob grid.arrange arrangeGrob ttheme_minimal
#' @importFrom survival Surv survfit
eventTab <- function(time, risk, group, cens = NULL, title = "Number of Events"){
if(is.null(cens)) cens <- as.character(risk[1])
risks <- riskVec(risk, cens)
nrOfRisks <- as.numeric(nrow(risks))
#extended_breaks
fit <- lapply(risks, function(x) {
localStatus <- {risk == x}
summary(survfit(Surv(time, localStatus)~group
))
})
names(fit) <- risks
tmp <- toPlotDf(fit)
timePoints <- extended_breaks()(tmp$time)
uniGroups <- unique(group)
uniGroups <- levels(factor(uniGroups))
dt <- cbind(time, as.character(risk), group)
dt <- as.data.frame(dt)
colnames(dt) <- c("time", "risk", "group")
dt$time <- as.numeric(as.character(dt$time))
makeRow <- function(whichRisk, whichGroup){
tmp <- filter(dt, dt$risk == whichRisk & dt$group == whichGroup)
newRow <- sapply(1:length(timePoints), function(x){
length(which(tmp$time <= timePoints[x]))
})
newRow
}
makeTable <- function(whichRisk){
tab <- sapply(uniGroups, function(x) makeRow(whichRisk, x))
tab <- as.data.frame(tab)
tab <- t(tab)
colnames(tab) <- timePoints
tab
}
eventTable <- lapply(risks, function(x) makeTable(x))
names(eventTable) <- risks
args <- lapply(1:length(eventTable), function(x) arrangeGrob(tableGrob(eventTable[[x]], theme = ttheme_minimal()), top = names(eventTable)[x]))
args$top <- textGrob(title, gp=gpar(fontface="bold"), vjust = 0.5)
args$ncol <- length(risks)
do.call(grid.arrange, args)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.