Nothing
#' Plot of predicted cumulative incidences according to a profile of covariates
#'
#' This function displays the predicted cause-specific cumulative incidences
#' derived from a joint latent class model according to a profile of
#' covariates. %% ~~ A concise (1-5 lines) description of what the function
#' does. ~~
#'
#'
#' @param x an object of class \code{cuminc}
#' @param profil an integer giving the profile number for which the cumulative
#' incidences are to be plotted.
#' @param event an integer giving the event indicator for which the cumulative
#' incidence are to be plotted.
#' @param add logical indicating if the curves should be added to an existing
#' plot. Default to FALSE.
#' @param legend character or expression to appear in the legend. If no legend
#' should be added, \code{"legend"} should be NULL.
#' @param legend.loc keyword for the position of the legend from the list
#' \code{"bottomright"}, \code{"bottom"}, \code{"bottomleft"}, \code{"left"},
#' \code{"topleft"},\code{"top"}, \code{"topright"}, \code{"right"} and
#' \code{"center"}. By default, the legend is located in the top left of the
#' plot.
#' @param \dots other parameters to be passed through to plotting functions
#' @return returns NULL
#' @author Viviane Philipps and Cecile Proust-Lima
#' @seealso
#' \code{\link{Jointlcmm}}, \code{\link{plot.Jointlcmm}}, \code{\link{cuminc}}
#'
#'
#' @export
plot.cuminc <- function(x,profil=1,event=1,add=FALSE,legend,legend.loc="topleft",...)
{
if(missing(x)) stop("The argument 'x' should be specified")
if(!inherits(x,"cuminc")) stop("Use with 'cuminc' objects only")
if(length(profil)>1) stop("Please specify only one profil")
if(!(profil %in% c(1:length(x)))) stop("Wrong profil number")
if(length(event)>1) stop("Please specify only one event")
nbevt <- length(unique(x[[1]][,"event"]))
if(!(event %in% c(1:nbevt))) stop(paste("event should be between 1 and",nbevt))
xx <- x[[profil]]
mat <- xx[which(xx[,"event"]==event),]
if("med_class1" %in% colnames(xx) | "50_class1" %in% colnames(xx))
{
ic <- 1
ng <- (ncol(xx)-2)/3
}
else
{
ic <- 0
ng <- ncol(xx)-2
}
dots <- list(...)
dots <- dots[setdiff(names(dots),c("x","y","log"))]
if(!length(dots$main))
{
dots$main <- "Class-specific cumulative incidence"
}
if(!length(dots$col))
{
dots$col <- 1:ng
}
if(!length(dots$type))
{
dots$type <- "l"
}
if(!length(dots$lty))
{
if(ic==0) dots$lty <- 1
else dots$lty <- c(rep(1,ng),rep(2,2*ng))
}
if(!length(dots$ylab))
{
dots$ylab <- "cumulative incidence"
}
if(!length(dots$xlab))
{
dots$xlab <- "time"
}
if(missing(legend)) legend <- paste("class",1:ng,sep="")
if(length(list(...)$box.lty))
{
box.lty1 <- as.integer(eval(dots$box.lty))
dots <- dots[setdiff(names(dots),"box.lty")]
}
else box.lty1 <- 0
if(length(list(...)$inset))
{
inset1 <- eval(dots$inset)
dots <- dots[setdiff(names(dots),"inset")]
}
else inset1 <- c(0.02,0.02)
names.plot <- c("adj","ann","asp","axes","bg","bty","cex","cex.axis",
"cex.lab","cex.main","cex.sub","col","col.axis",
"col.lab","col.main","col.sub","crt","err","family","fig",
"fin","font","font.axis","font.lab","font.main","font.sub",
"frame.plot","lab","las","lend","lheight","ljoin","lmitre",
"lty","lwd","mai","main","mar","mex","mgp","mkh","oma",
"omd","omi","pch","pin","plt","ps","pty","smo","srt","sub",
"tck","tcl","type","usr","xaxp","xaxs","xaxt","xlab",
"xlim","xpd","yaxp","yaxs","yaxt","ylab","ylbias","ylim")
dots.plot <- dots[intersect(names(dots),names.plot)]
if(!isTRUE(add))
{
do.call("matplot",c(dots.plot,list(x=mat[,2],y=mat[,-c(1,2)])))
}
else
{
do.call("matlines",c(dots.plot,list(x=mat[,2],y=mat[,-c(1,2)])))
}
names.legend <- c("fill","border","lty","lwd","pch","angle","density",
"bg","box.lwd","box.lty","box.col","pt.bg","cex","pt.cex",
"pt.lwd","xjust","yjust","x.intersp","y.intersp","adj",
"text.width","text.col","text.font","merge","trace",
"plot","ncol","horiz","title","xpd","title.col",
"title.adj","seg.len")
dots.leg <- dots[intersect(names(dots),names.legend)]
if(!(dots$type %in% c("l","b"))) dots.leg <- dots[setdiff(names(dots),c("lty","lwd"))]
if(!is.null(legend)) do.call("legend",c(dots.leg,list(x=legend.loc, legend=legend, box.lty=box.lty1, inset=inset1,col=dots$col)))
return(invisible(NULL))
}
#<plot.incidcum <- function(x,profil=1,event=1,add=FALSE,legend,legend.loc="topleft",...) UseMethod("plot.incidcum")
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.