#' @name autoplotTen
#' @title Generate a \code{ggplot} for a \code{survfit} or \code{ten} object
#'
#' @include ten.R
#' @include print.R
#' @include autoplotTAP.R
#' @include sf.R
#' @include ci.R
#' @include nc.R
#'
#' @param object An object of class \code{survfit}, \code{ten} or \code{stratTen}.
#' @param ... Additional arguments (not implemented).
#' @param title Title for survival plot.
#' @param type \code{type="single"} (the default) plots single lines.
#' \describe{
#' \item{\code{type="CI"}}{Adds lines indicating
#' confidence intervals (taken from \code{upper} and \code{lower}
#' values of \code{survfit} object).
#' \cr
#' Higher values of \code{alpha} (opacity) are recommended for this,
#' e.g. \code{alpha=0.8}.}
#' \item{\code{type="fill"}}{Adds filled rectangles from the survival lines to
#' the confidence intervals above.}
#' }
#' @param alpha Opacity of lines indicating confidence intervals
#' or filled rectangles. Should be in range \eqn{0-1}. Lower = more transparent.
#' \cr
#' Larger values e.g. \code{alpha=0.7} are recommended for confidence
#' intervals.
#' @param ciLine Confidence interval line type. See 'line type specification' in
#' \cr
#' ?graphics::par
#' @param censShape Shape of marks to indicate censored onservations.
#' \cr
#' Default is \code{3} which gives vertical ticks.
#' \cr
#' Use \code{censShape=10} for circular marks. See
#' \cr
#' ?graphics::points
#' @param palette Options are taken from
#' \href{http://colorbrewer2.org/}{color_brewer}.
#' \itemize{
#' \item \code{palette="Dark2"} (the default) is recommended for
#' \code{single} or \code{CI} plots.
#' \item \code{palette="Set2"} is recommended for \code{type="fill"} plots.
#' }
#' @param jitter By default, \code{jitter="none"}.
#' \itemize{
#' \item If \code{jitter="noEvents"}, adds some random, positive noise
#' to survival lines with no events (i.e. all observations censored).
#' This will bring them just above 1 on the y-axis, making them easier to see separately.
#' \item If \code{jitter="all"} add some vertical
#' and horizontal noise to all survival lines. This can prevent overlapping
#' of lines for censoring.
#' }
#' @param tabTitle Table title.
#' \cr \cr
#' \bold{--Axis arguments:}
#' @param xLab Label for \eqn{x} axis on survival plot.
#' @param timeTicks Numbers to mark on the \eqn{x} axis of
#' the survival plot and the table.
#' \describe{
#' \item{\code{"major"}}{
#' (the default) only the major \eqn{x}-axis (time) marks from the
#' survival plot are are labelled on the plot and table.}
#' \item{\code{"minor"}}{minor axis marks are labelled instead.}
#' \item{\code{"days"}}{scale is \eqn{0, 7, 14, ..., t_{max}}}
#' \item{\code{"months"}}{scale is \eqn{0, 12,, 24, ..., t_{max}}}
#' \item{\code{"custom"}}{scale is given by \code{times} below}
#' }
#' @param times Vector of custom times to use for \eqn{x} axis.
#' @param yLab Label for \eqn{y} axis on survival plot.
#' @param yScale Display for point on \eqn{y} axis:
#' \describe{
#' \item{\code{"perc"}}{Displays as percentages.}
#' \item{\code{"frac"}}{Displays as fractions e.g. \eqn{0, 0.1, 0.2, ..., 1.0.}}
#' }
#' \bold{--Legend arguments:}
#' \cr
#' @param legend If \code{legend=FALSE}, no legends will be produced
#' for the plot or table.
#' @param legTitle Legend title.
#' @param legLabs Legend labels. These can be used to replace the names
#' of the covariate groups ('strata' in the case of a \code{survfit} object).
#' \cr
#' Should be given in the same order as those strata.
#' @param legOrd Legend order.
#' \cr \cr
#' \bold{--Size arguments:}
#' \cr
#' Size arguments are passed to \code{ggplot2::element_text(size=)}.
#' @param titleSize Title size for survival plot.
#' @param axisTitleSize Title size for axes.
#' @param axisLabSize Title size for labels on axes.
#' @param survLineSize Survival line size.
#'
#' @param legTitleSize Title size for legend.
#' @param legLabSize Legend labels width and height.
#' @param censSize Size of marks to indicate censored onservations.
#' @param fillLineSize Line size surrouding filled boxes.
#' @param tabTitleSize Table title text size.
#' @param tabLabSize Table legend text size.
#' @param nRiskSize Number at risk - text size.
#' \cr \cr
#' \bold{--Arguments for autoplot.survfit only:}
#' \cr
#' @param pVal If \code{pVal=TRUE}, adds \eqn{p} value from
#' log-rank test to plot
#' @param sigP No. of significant digits to display in \eqn{p} value.
#' Typically \eqn{1} to \eqn{3}.
#' @param pX Location of \eqn{p} value on \eqn{x} axis.
#' \cr
#' Should be in the range of \eqn{0 - 1},
#' where value is to be placed relative to the maximum observed
#' time.
#' \cr
#' E.g. \code{pX = 0.5} will place it half-way along \eqn{x}-axis
#' @param pY Location of \eqn{p} value on \eqn{y} axis.
#' \cr
#' Should be in the range of \eqn{0 - 1}, as above.
#'
#' @author Chris Dardis. \code{autoplot.survfit} based on existing work by
#' R. Saccilotto, Abhijit Dasgupta, Gil Tomas and Mark Cowley.
#'
#' @note \code{autoplot.survfit} may be deprecated after packageVersion 0.6.
#' Please try to use \code{autoplot.ten} instead.
#'
#' @keywords hplot
#' @keywords survival
#'
#' @seealso ?ggplot2::ggplot_build
#'
#' @rdname autoplotTen
#' @export
#'
autoplot <- function (object, ...) UseMethod("autoplot")
#'
#' @rdname autoplotTen
#' @method autoplot ten
#' @aliases autoplot.ten
#' @export
#' @examples
#' ## examples are slow to run; see vignette for output from these
#' \dontrun{
#' ### autoplot.ten
#' data("kidney", package="KMsurv")
#' t1 <- ten(survfit(Surv(time, delta) ~ type, data=kidney))
#' autoplot(t1)
#' autoplot(t1, type="fill", survLineSize=2, jitter="all")
#' autoplot(t1, timeTicks="months",
#' type="CI", jitter="all",
#' legLabs=c("surgical", "percutaneous"),
#' title="Time to infection following catheter placement \n
#' by type of catheter, for dialysis patients",
#' titleSize=10, censSize=2)$plot
#' t2 <- ten(survfit(Surv(time=time, event=delta) ~ 1, data=kidney))
#' autoplot(t2, legLabs="")$plot
#' autoplot(t2, legend=FALSE)
#' data("rectum.dat", package="km.ci")
#' t3 <- ten(survfit(Surv(time, status) ~ 1, data=rectum.dat))
#' ## change confidence intervals to log Equal-Precision confidence bands
#' ci(t3, how="nair", tL=1, tU=40)
#' autoplot(t3, type="fill", legend=FALSE)$plot
#' ## manually changing the output
#' t4 <- ten(survfit(Surv(time, delta) ~ type, data=kidney))
#' (a4 <- autoplot(t4, type="CI", alpha=0.8, survLineSize=2)$plot)
#' ## change default colors
#' a4 + list(ggplot2::scale_color_manual(values=c("red", "blue")),
#' ggplot2::scale_fill_manual(values=c("red", "blue")))
#' ## change limits of y-axis
#' suppressMessages(a4 + ggplot2::scale_y_continuous(limits=c(0, 1)))
#' }
autoplot.ten <- function(object,
...,
title="Marks show times with censoring",
type=c("single", "CI", "fill"),
alpha=0.05,
ciLine=10,
censShape=3,
palette=c("Dark2", "Set2", "Accent", "Paired",
"Pastel1", "Pastel2", "Set1", "Set3"),
jitter=c("none", "noEvents", "all"),
tabTitle="Number at risk by time",
xLab="Time",
timeTicks=c("major", "minor", "days", "months", "custom"),
times=NULL,
yLab="Survival",
yScale=c("perc", "frac"),
legend=TRUE,
legTitle="Group",
legLabs=NULL,
legOrd=NULL,
titleSize=15,
axisTitleSize=15,
axisLabSize=10,
survLineSize=0.5,
censSize=5,
legTitleSize=10,
legLabSize=10,
fillLineSize=0.05,
tabTitleSize=15,
tabLabSize=5,
nRiskSize=5) {
stopifnot(inherits(object, "ten"))
stopifnot(alpha > 0 & alpha < 1)
## add no. censored
nc(object)
## confidence intervals for plot
dt1 <- data.table::copy(ci(object))
dt1[, c("Sv", "SCV") := NULL]
dt1 <- merge(object[, list(cg, t, nc)],
dt1,
all.x=FALSE,
all.y=FALSE,
by=c("cg", "t"))
if (!is.null(legOrd)) {
stopifnot(length(unique(legOrd))==length(unique(dt1[, cg])))
stopifnot(all(legOrd %in% dt1[, seq.int(length(cg))]))
}
## make two extra rows for each covariate group
## for t=0 to t=time of first event
dt2 <- data.table::rbindlist(list(dt1[, .SD[1, ], by=cg],
dt1[, .SD[1, ], by=cg]))
## set surv, upper and lower to one
dt2[, c("S", "lower", "upper") := list(1), by=cg]
## set initial time and no. censored to zero
dt2[seq.int(unique(dt2$cg)), c("t", "nc") := list(0L)]
## reorder to allow binding
dt1 <- data.table::rbindlist(list(dt2, dt1))
### jitter
jitter <- match.arg(jitter)
## for groups with no events add random no.to survival (by strata)
if (jitter=="noEvents") {
## add column to indicate no. events by group
dt1[, s1 := sum(n), by=list(cg)]
dt1[s1==0, S := S + (stats::runif(1, 0.01, 0.05)), by=cg]
}
if(jitter=="all"){
## for groups with no events add random no.to survival (by strata)
dt1[, S := S + (stats::runif(1, 0.01, 0.05)), by=cg]
dt1[, t := abs(jitter(t, factor=0.5))]
}
###
if (attr(object, "abbNames")) {
na1 <- attr(object, "longNames")[, id]
## abbreviate function (used later)
abbFn <- identity
} else {
na1 <- attr(object, "longNames")[, longName]
abbFn <- as.integer
}
if (is.null(legLabs)) {
dt1[, "cg" := factor(cg, labels=na1)]
} else {
stopifnot(length(legLabs)==length(unique(object$cg)))
dt1[, "cg" := factor(cg, labels=legLabs)]
}
if (is.null(legOrd)) legOrd <- dt1[, seq.int(levels(cg))]
###
### plot single lines only
###
g1 <- ggplot(data=dt1, aes(group=cg, color=cg, fill=cg)) +
geom_step(aes(x=t, y=S), direction="hv", size=survLineSize)
###
type <- match.arg(type)
if (type=="CI") {
g1 <- g1 +
geom_step(aes(x=t, y=upper),
direction="hv", linetype=ciLine, alpha=alpha) +
geom_step(aes(x=t, y=lower),
direction="hv", linetype=ciLine, alpha=alpha)
}
if (type=="fill") {
## copy dt1 to work allow further work
dt2 <- dt1[, list(l=unique(lower),
u=unique(upper),
minT=as.numeric(min(t)),
t=as.numeric(t)
), by=list(S, cg)]
## make max. time column
dt2[, "maxT" := c(minT[2:length(minT)], Inf), by=cg]
## merge columns
dt1 <- merge(dt1, dt2, by=c("t", "S", "cg"), all.y=TRUE)
dt1 <- dt1[order(cg)]
## add shading
g1 <- g1 + geom_rect(data=dt1, aes(x=NULL, y=NULL,
ymax=S, ymin=l,
xmax=maxT, xmin=minT,
color=cg, group=cg, fill=cg),
alpha=alpha, size=fillLineSize) +
geom_rect(data=dt1, aes(x=NULL, y=NULL,
ymax=u, ymin=S,
xmax=maxT, xmin=minT,
color=cg, group=cg, fill=cg),
alpha=alpha, size=fillLineSize)
}
## add lines to show times where subjects censored
if (any(dt1[, nc >= 1])) {
g1 <- g1 + geom_point(data=dt1[nc >= 1, ],
aes(x=t, y=S),
shape=censShape, size=censSize)
}
### palette + legend
## use palette Dark2 for prominent shades
## (suitable for colorblind)
## use palette Set2 for lighter shades as large fill area
palette <- match.arg(palette)
g1 <- g1 + scale_color_brewer(type="qual",
breaks=dt1[, levels(cg)[legOrd]],
palette=palette,
guide=guide_legend(
title=legTitle)) +
scale_fill_brewer(type="qual",
breaks=dt1[, levels(cg)[legOrd]],
palette=palette,
guide=guide_legend(
title=legTitle))
### scales
g1 <- g1 + ggtitle(title)
yScale <- match.arg(yScale)
if (yScale=="frac") {
g1 <- g1 + scale_y_continuous(yLab)
} else {
y1 <- ggplot_build(g1)$layout$panel_params[[1L]]$y.major_source
g1 <- g1 + scale_y_continuous(yLab,
breaks=y1,
labels=paste0(y1 * 100, "%"))
}
## times to show
## use marks from existing plot
timeTicks <- match.arg(timeTicks)
x1 <- get("range", envir=get("range", envir=layer_scales(g1)$x))
times1 <- switch(EXPR=timeTicks,
major=ggplot_build(g1)$layout$panel_params[[1]]$x.major_source,
minor=ggplot_build(g1)$layout$panel_params[[1]]$x.minor_source,
custom=NaN,
days=seq(from=min(x1), to=max(x1), by=7L),
months=seq(from=min(x1), to=max(x1), by=12L))
if (is.nan(times1[1])) times1 <- times
## x axis
g1 <- g1 +
scale_x_continuous(name=xLab,
breaks=times1)
## font sizes
g1 <- g1 +
theme(title=element_text(size=titleSize),
legend.text=element_text(size=legLabSize),
legend.title=element_text(size=legTitleSize),
axis.text=element_text(size=axisLabSize),
axis.title=element_text(size=axisTitleSize))
### data for table of number at risk
dt3 <- data.table::data.table("t"=times1)
cg1 <- seq.int(attr(object, "ncg"))
## time, no. at risk, covariate group
tnc1 <- lapply(cg1, FUN=function(cg1) {
r1 <- data.table::setkey(object[abbFn(cg)==cg1, ncg, by=t], t)
r1[dt3, roll=-Inf][, ncg]
})
tnc1 <- data.table::data.table(
"t"=rep(times1, attr(object, "ncg")),
"n"=unlist(tnc1),
"cg"=as.factor(rep(na1, each=length(times1))))
## table
g2 <- ggplot(data=tnc1, aes(x=t, y=cg, shape=cg)) +
geom_point(size=0) +
geom_text(aes(label=n), color=1, size=nRiskSize) +
scale_x_continuous(name=xLab,
limits=c(0, max(dt1[, t])),
breaks=times1) +
scale_y_discrete(name=legTitle,
breaks=levels(tnc1$cg),
labels=levels(tnc1$cg)) +
ggtitle(tabTitle) +
theme(axis.text=element_text(size=axisLabSize),
axis.title=element_text(size=axisTitleSize),
plot.title=element_text(size=tabTitleSize),
legend.title=element_text(size=tabLabSize),
legend.text=element_text(size=tabLabSize)) +
guides(shape=guide_legend(title=legTitle,
keywidht=tabLabSize,
keyheight=tabLabSize))
## remove legend
if (!legend) {
g1 <- g1 + theme(legend.position="none")
g2 <- g2 + theme(legend.position="none")
}
res1 <- list("table"=g2,
"plot"=g1)
class(res1) <- c("tableAndPlot", "list")
return(res1)
}
#'
#' @rdname autoplotTen
#' @method autoplot stratTen
#' @aliases autoplot.stratTen
#' @export
#' @examples
#' \dontrun{
#' data("pbc", package="survival")
#' t1 <- ten(Surv(time, status==2) ~ trt + strata(edema), data=pbc, abbNames=FALSE)
#' autoplot(t1)
#' }
autoplot.stratTen <- function(object,
...,
title=NULL,
type=c("single", "CI", "fill"),
alpha=0.05,
ciLine=10,
censShape=3,
palette=c("Dark2", "Set2", "Accent", "Paired",
"Pastel1", "Pastel2", "Set1", "Set3"),
jitter=c("none", "noEvents", "all"),
tabTitle="Number at risk by time",
xLab="Time",
timeTicks=c("major", "minor", "days", "months", "custom"),
times=NULL,
yLab="Survival",
yScale=c("perc", "frac"),
legend=TRUE,
legTitle="Group",
legLabs=NULL,
legOrd=NULL,
titleSize=15,
axisTitleSize=15,
axisLabSize=10,
survLineSize=0.5,
censSize=5,
legTitleSize=10,
legLabSize=10,
fillLineSize=0.05,
tabTitleSize=15,
tabLabSize=5,
nRiskSize=5) {
res1 <- lapply(object,
autoplot,
title=title,
type=type,
alpha=alpha,
ciLine=ciLine,
censShape=3,
palette=palette,
jitter=jitter,
tabTitle=tabTitle,
xLab=xLab,
timeTicks=timeTicks,
times=times,
yLab=yLab,
yScale=yScale,
legend=TRUE,
legTitle=legTitle,
legLabs=legLabs,
legOrd=legOrd,
titleSize=titleSize,
axisTitleSize=axisTitleSize,
axisLabSize=axisLabSize,
survLineSize=survLineSize,
censSize=censSize,
legTitleSize=legTitleSize,
legLabSize=legLabSize,
fillLineSize=fillLineSize,
tabTitleSize=tabTitleSize,
tabLabSize=tabLabSize,
nRiskSize=nRiskSize)
if (is.null(title)) {
if (attr(object, "abbNames")) {
title <- attr(object, "longNames")[, id]
} else {
title <- attr(object, "longNames")[, longName]
}
} else {
title <- rep(title, length(object))
}
for (i in seq.int(length(object))){
res1[[i]][[2]] <- res1[[i]][[2]] + ggplot2::ggtitle(title[i])
}
data.table::setattr(res1, "class", c("stratTableAndPlot", class(res1)))
return(res1)
}
#'
#' @rdname autoplotTen
#' @method autoplot survfit
#' @aliases autoplot.survfit
#' @export
#' @examples
#' ### autoplot.survfit
#' \dontrun{
#' data(kidney, package="KMsurv")
#' s1 <- survfit(Surv(time, delta) ~ type, data=kidney)
#' autoplot(s1, type="fill", survLineSize=2)
#' autoplot(s1, type="CI", pVal=TRUE, pX=0.3,
#' legLabs=c("surgical", "percutaneous"),
#' title="Time to infection following catheter placement \n
#' by type of catheter, for dialysis patients")$plot
#' s1 <- survfit(Surv(time=time, event=delta) ~ 1, data=kidney)
#' autoplot(s1, legLabs="")$plot
#' autoplot(s1, legend=FALSE)$plot
#' data(rectum.dat, package="km.ci")
#' s1 <- survfit(Surv(time, status) ~ 1, data=rectum.dat)
#' ## change confidence intervals to log Equal-Precision confidence bands
#' if (require("km.ci")) {
#' km.ci::km.ci(s1, method="logep")
#' autoplot(s1, type="fill", legend=FALSE)$plot
#' }
#' ## manually changing the output
#' s1 <- survfit(Surv(time, delta) ~ type, data=kidney)
#' g1 <- autoplot(s1, type="CI", alpha=0.8, survLineSize=2)$plot
#' ## change default colors
#' g1 + ggplot2::scale_colour_manual(values=c("red", "blue")) +
#' ggplot2::scale_fill_manual(values=c("red", "blue"))
#' ## change limits of y-axis
#' g1 + ggplot2::scale_y_continuous(limits=c(0, 1))
#' }
autoplot.survfit <- function(object,
...,
title="Marks show times with censoring",
type=c("single", "CI", "fill"),
alpha=0.05,
ciLine=10,
censShape=3,
palette=c("Dark2", "Set2", "Accent", "Paired",
"Pastel1", "Pastel2", "Set1", "Set3"),
jitter=c("none", "noEvents", "all"),
tabTitle="Number at risk by time",
xLab="Time",
timeTicks=c("major", "minor", "weeks", "months", "custom"),
times=NULL,
yLab="Survival",
yScale=c("perc", "frac"),
legend=TRUE,
legLabs=NULL,
legOrd=NULL,
legTitle="Group",
titleSize=15,
axisTitleSize=15,
axisLabSize=10,
survLineSize=0.5,
censSize=5,
legTitleSize=10,
legLabSize=10,
fillLineSize=0.05,
tabTitleSize=15,
tabLabSize=5,
nRiskSize=5,
pVal=FALSE,
sigP=1,
pX=0.1,
pY=0.1) {
stopifnot(inherits(object, "survfit"))
if (!is.null(legLabs) &! length(object$strata)==0){
stopifnot(length(legLabs)==length(object$strata))
}
## change names for strata to legLabs if required
if (is.null(legLabs)) {
stNames <- names(object$strata)
} else {
stNames <- legLabs
}
## if only one strata (intercept only model)
if (is.null(object$strata)) {
if (is.null(legLabs)) {
st1 <- as.factor(rep(1, length(object$time)))
} else {
stopifnot(length(legLabs)==1)
st1 <- as.factor(rep(legLabs, length(object$time)))
}
} else {
## add vector for one strata according to number of rows of strata
st1 <- unlist(sapply(1:length(object$strata),
function (i) rep(stNames[i], object$strata[i])))
}
## create data.table with data from survfit
## add column for strata
## (using data.table here as avoids duplication when adding rows later)
## also rename strata as 'st' to avoid calling survival::function
dt1 <- data.table::data.table(time=object$time,
n.risk=object$n.risk,
n.event=object$n.event,
n.censor=object$n.censor,
surv=object$surv,
upper=object$upper,
lower=object$lower,
st=as.factor(st1))
## make two rows for each stratum
## for time=0 to time=time of first event
dt2 <- data.table::rbindlist(list(dt1[, .SD[1, ], by=st],
dt1[, .SD[1, ], by=st]))
## set n.event and n.censored to zero
dt2[, c("n.event", "n.censor") := list(0), by=st]
## set surv, upper and lower to one
dt2[, c("surv", "upper", "lower") := list(1), by=st]
## set first time to zero
dt2[seq(length(unique(dt2$st))), "time" := (0L) ]
## reorder to allow binding
data.table::setcolorder(dt2, names(dt1))
dt1 <- data.table::rbindlist(list(dt2, dt1))
if (is.null(legOrd)) legOrd <- dt1[, seq.int(levels(st))]
##
## jitter
##
jitter <- match.arg(jitter)
## for groups with no events add random no.to survival (by strata)
if (jitter=="noEvents") {
## add column to indicate no. events by group
dt1[, s1 := sum(n.event), by=list(st)]
dt1[s1==0, surv := surv+(runif(1, 0.01, 0.05)), by=st]
}
if(jitter=="all"){
## for groups with no events add random no.to survival (by strata)
dt1[, surv := surv+(runif(1, 0.01, 0.05)), by=st]
}
##
dt1 <- dt1[order(st)]
##
## plot single lines only
##
g1 <- ggplot(data=dt1, aes(group=st, colour=st, fill=st)) +
geom_step(aes(x=time, y=surv), direction="hv", size=survLineSize)
##
type <- match.arg(type)
if (type=="CI"){
g1 <- g1 +
geom_step(aes(x=time, y=upper),
direction="hv", linetype=ciLine, alpha=alpha) +
geom_step(aes(x=time, y=lower),
direction="hv", linetype=ciLine, alpha=alpha)
}
if (type=="fill"){
## copy dt1 to work allow further work
dt2 <- dt1[, list(l=unique(lower),
u=unique(upper),
minT=as.numeric(min(time)),
time=as.numeric(time)
), by=list(surv, st)]
## make max. time column
dt2[, "maxT" := c(minT[2:length(minT)], NA), by=st]
## merge columns
dt1 <- merge(dt1, dt2, by=c("time", "surv", "st"), all.y=TRUE)
dt1 <- dt1[order(st)]
## add shading
g1 <- g1 + geom_rect(data=dt1, aes(x=NULL, y=NULL,
ymax=surv, ymin=l,
xmax=maxT, xmin=minT,
colour=st, group=st, fill=st),
alpha=alpha, size=fillLineSize) +
geom_rect(data=dt1, aes(x=NULL, y=NULL,
ymax=u, ymin=surv,
xmax=maxT, xmin=minT,
colour=st, group=st, fill=st),
alpha=alpha, size=fillLineSize)
}
## add lines to show times where subjects censored
if (any(dt1$n.censor >= 1)) {
g1 <- g1 + geom_point(data=dt1[n.censor>=1, ],
aes(x=time, y=surv),
shape=censShape, size=censSize)
}
## palette
## use palette Dark2 for prominent shades
## (suitable for colorblind)
## use palette Set2 for lighter shades as large fill area
palette <- match.arg(palette)
g1 <- g1 + scale_color_brewer(type="qual",
breaks=dt1[, levels(cg)[legOrd]],
palette=palette,
guide=guide_legend(
title=legTitle))
g1 <- g1 + scale_fill_brewer(type="qual",
breaks=dt1[, levels(cg)[legOrd]],
palette=palette,
guide=guide_legend(
title=legTitle))
## scales
g1 <- g1 + ggtitle(title)
yScale <- match.arg(yScale)
if (yScale=="frac") {
g1 <- g1 + scale_y_continuous(yLab)
} else {
y1 <- ggplot_build(g1)$layout$panel_params[[1L]]$y.major_source
g1 <- g1 + scale_y_continuous(yLab,
breaks=y1,
labels=paste0(y1 * 100, "%"))
}
## times to show
timeTicks <- match.arg(timeTicks)
x1 <- get("range", envir=get("range", envir=layer_scales(g1)$x))
times1 <- switch(EXPR=timeTicks,
major=ggplot_build(g1)$layout$panel_params[[1]]$x.major_source,
minor=ggplot_build(g1)$layout$panel_params[[1]]$x.minor_source,
custom=NaN,
weeks=seq(from=min(x1), to=max(x1), by=7L),
months=seq(from=min(x1), to=max(x1), by=12L))
if (is.nan(times1[1])) times1 <- times
## x axis
g1 <- g1 +
scale_x_continuous(name=xLab,
breaks=times1)
## font sizes
g1 <- g1 +
theme(title=element_text(size=titleSize),
legend.text=element_text(size=legLabSize),
legend.title=element_text(size=legTitleSize),
axis.text = element_text(size = axisLabSize),
axis.title = element_text(size = axisTitleSize))
## remove legend if required
if(!legend) g1 <- g1 + theme(legend.position="none")
## p value for log-rank test (only if >=2 groups)
if (pVal & !is.null(object$strata)) {
sd1 <- survival::survdiff(eval(object$call$formula),
data=eval(object$call$data))
p1 <- stats::pchisq(sd1$chisq,
length(sd1$n) - 1,
lower.tail=FALSE)
p1txt <- ifelse(p1 < 0.0001,
"Log-rank test \n p < 0.0001",
paste("Log-rank test \n p =", signif(p1, sigP)))
g1 <- g1 + annotate(geom="text",
x=pX * max(dt1$time),
y=pY,
label=p1txt,
size=legLabSize)
}
## data for table
dt3 <- data.table::data.table(
time=summary(object, times = times1, extend = TRUE)$time,
n.risk=summary(object, times = times1, extend = TRUE)$n.risk)
## if intercept-only model
if (is.null(object$strata)) {
dt3[, "st" := as.factor(rep(1, length(times1)))]
} else {
dt3[, "st" := summary(object, times=times1, extend=TRUE)$strata]
}
## change names of strata to legend labels
if(!is.null(legLabs)) dt3[, "st" := factor(st, labels=legLabs) ]
## table
## reverse here to plot in same order as in main plot
g2 <- ggplot(data=dt3, aes(x=time, y=st, shape=st)) +
geom_point(size=0) +
geom_text(aes(label=n.risk), colour=1, size=nRiskSize) +
scale_x_continuous(name=xLab,
limits=c(0, max(object$time)),
breaks=times1) +
## reverse here to plot in same order as in main plot
scale_y_discrete(name=legTitle,
breaks=levels(dt3$st),
labels=levels(dt3$st)) +
ggtitle(tabTitle) +
theme(axis.text = element_text(size=axisLabSize),
axis.title = element_text(size=axisTitleSize),
plot.title = element_text(size=tabTitleSize),
legend.title = element_text(size=tabLabSize),
legend.text = element_text(size=tabLabSize)) +
guides(shape = guide_legend(title=legTitle,
keywidht=tabLabSize,
keyheight=tabLabSize))
## remove legend
if(!legend) g2 <- g2 + theme(legend.position = "none")
res1 <- list("table"=g2,
"plot"=g1)
class(res1) <- c("tableAndPlot", "list")
return(res1)
}
## declare variables (for R CMD check)
## st1 is vector for strata identification
surv <- n.risk <- n.censor <- n.event <- upper <- lower <- NULL
.SD <- st1 <- stNames <- st <- s1 <- minT <- l <- maxT <- u <- NULL
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.