Nothing
#' @title Cumulative Incidences Curves
#' @name fitCuminc
#' @description Fits cumulative incidence function across different groups and risks.
#' @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).
#' @return list of length [(number of risks)*(number of groups) + 1], containing estimation of cumulative incidences curves for each risk and group. The last element of a list is a data.frame with results of a K-sample test, containing test statistic, p-value and degrees od freedom for each risk.
#' @export
#' @seealso \code{\link[cmprsk]{cuminc}}
#' @examples fitCuminc(time = LUAD$time, risk = LUAD$event, group = LUAD$gender, cens = "alive")
#' @importFrom dplyr filter
#' @importFrom cmprsk cuminc
#' @importFrom survival Surv survfit
fitCuminc <- function(time,
risk,
group,
cens = NULL){
if(is.null(cens)) cens <- as.character(risk[1])
risks <- riskVec(risk, cens)
# uniRisks <- 1:length(risks)
# mapRisks <- cbind(risks, uniRisks)
# mapRisks <- rbind(mapRisks, c(cens, 0))
# mapRisks <- as.data.frame(mapRisks)
# colnames(mapRisks)[1] <- "risk"
#
# groups <- as.data.frame(unique(group))
# groups <- filter(groups, !is.na(groups))
# uniGroups <- letters[1:nrow(groups)]
# mapGroups <- cbind(groups, uniGroups)
# colnames(mapGroups)[1] <- "group"
#
# 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))
#
#
# dt <- merge(dt, mapRisks, by = "risk")
# dt <- merge(dt, mapGroups, by = "group")
# ci <- cuminc(ftime = dt[, "time"],
# fstatus = dt[, "uniRisks"],
# group = dt[, "uniGroups"],
# cencode = cens)
risk <- gsub(pattern = " ", replacement = "_", risk, fixed = TRUE)
cens <- gsub(pattern = " ", replacement = "_", cens, fixed = TRUE)
group <- gsub(pattern = " ", replacement = "_", group, fixed = TRUE)
ci <- cuminc(ftime = time,
fstatus = risk,
group = group,
cencode = cens)
aggnames <- names(ci)
aggnames <- aggnames[-length(aggnames)]
#
# tab <- c()
# for(i in aggnames){
# tmp <- unlist(strsplit(i, " "))
# tab <- rbind(tab, c(i, tmp))
# }
# tab <- as.data.frame(tab)
#
# colnames(tab) <- c("aggnames", "uniGroups", "uniRisks")
#
# tab <- merge(tab, mapRisks, by = "uniRisks")
# tab <- merge(tab, mapGroups, by = "uniGroups")
#
# tab$newname <- paste( tab[, "risk"], tab[,"group"])
#
# names(ci)[1:length(ci)-1] <- tab$newname
#
# tab$risk <- factor(as.character(tab$risk))
# tab$group <- factor(as.character(tab$group))
#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)
attr(ci, "timePoints") <- timePoints
ci$Tests <- as.data.frame(ci$Tests)
ci
}
#' @title K-sample Test for Competing Risks
#' @name testCuminc
#' @description tests differences in cumulative incidences function between groups using K-sample test.
#' @param ci a result of fitCumin function.
#' @return data.frame containing p-values of K-sample test for each risk.
#' @examples fitC <- fitCuminc(time = LUAD$time, risk = LUAD$event, group = LUAD$gender, cens = "alive")
#' testCuminc(fitC)
#' @export
#' @seealso \code{\link[cr17]{fitCuminc}}
testCuminc <- function(ci){
aggNames <- names(ci[1:(length(ci)-1)])
risks <- sapply(aggNames, function(x) strsplit(x, " ", fixed = TRUE)[[1]][2])
risks <- sort(unique(risks))
tab <- as.data.frame(ci[["Tests"]])
p <- as.data.frame(t(tab$pv))
colnames(p) <- risks
tab1 <- vector()
for(i in 1:length(risks)){
tmp <- p[,which(colnames(p) == risks[i])]
tmp <- signif(tmp, digits = 2)
tab1 <- as.data.frame(cbind(tab1,tmp))
}
colnames(tab1) <- risks
rownames(tab1) <- "K-Sample test"
as.data.frame(tab1)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.