Nothing
#' Adds a confident interval area of a survival model to a plot.
#'
#' This function adds the confident interval area of one group (strata) of
#' a survfit object to an existing plot. For competitive risk models, it
#' draws the confidence interval of one group and one event; the event-number
#' needs to be specified. If two overlapping confidence intervals are drawn
#' (by two function calls) in one plot, the use of transparent color is
#' recommended, for example "adjustcolor("red",0.1).
#'
#' @param x A survfit (survival-package) or a Cuminc (mstate-package) object.
#' @param group Number of the group (=strata) of which the confidence interval
#' should be plotted. If the survfit-object has only one strata, this
#' parameter can be omitted.
#' @param event If the model-object is a multistate-model, the number of the
#' event-type needs to be specified.
#' @param col Color of the confident interval area. Default is "grey". A
#' transparent value is recommended, for example "adjustcolor("red",0.1).
#' @param invert Inverts the area if TRUE, default is FALSE.
#' @return Draws an area for the confidence interval.
#' @import graphics
#' @examples
#' require(survival)
#' aml_model <- with(aml, survfit(Surv(time, status)~x))
#' col1 <- adjustcolor("red",0.2); col2 <- adjustcolor("blue",0.2)
#' survPlot(xmax=50, space.nrAtRisk=0.32)
#' confIntArea(aml_model, col=col1, group=1)
#' confIntArea(aml_model, col=col2, group=2)
#' survCurve(aml_model, group=1)
#' survCurve(aml_model, group=2, lty=2)
#' nrAtRisk(aml_model, group=1, y=-0.17, bgcol.flag=col1, label="maintain")
#' nrAtRisk(aml_model, group=2, y=-0.24, bgcol.flag=col2, lty.flag=2, label="non-maint.")
#' @export
confIntArea <- function(x, group, event, col="grey", invert=FALSE){
if("Cuminc" %in% class(x))
x <- attr(x,"survfit")
survdata <- extractOneGroupOneEvent(x,
group=ifelse(missing(group),NA,group),
event=ifelse(missing(event),NA,event)
)
if(invert==TRUE){
fun <- function(x) 1-x
}else{
fun <- function(x) x
}
modif_survdata <- within(survdata,{
estimate <- fun(estimate)
upper <- fun(upper)
lower <- fun(lower)
})
drawCIArea <- function(t, u, l){
L <- length(t)
t_rep <- c(t[1], rep(t[c(-1,-L)], each = 2), t[L])
u_rep <- rep(u[-L], each = 2)
l_rep <- rep(l[-L], each = 2)
polygon(c(t_rep,rev(t_rep)),c(u_rep,rev(l_rep)), border = NA,col=col)
}
with(modif_survdata,
drawCIArea(time, upper, lower)
)
}
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.