R/plotsurv.R

In Survomatic: Analysis of longevity data.

`plotsurv.old`<-
function(x,y,cx=NULL,cy=NULL,col=c(1,'darkred'),lwd=2,legend=NULL,lloc='bottomleft',pcex=1,pch=24:25,ylim=0:1,bg=NULL,add=F,...){
	lx<-length(x);ly<-length(y);args<-list(...);
	if(is.null(cx)){cx<-rep(1,lx);}; if(is.null(cy)){cy<-rep(1,ly);};
	if(is.null(bg)){bg<-col;}
	sf<-survfit(Surv(c(x,y),event=c(cx,cy))~c(rep(0,lx),rep(1,ly)));
	plot(sf,col=col,lwd=lwd,ylim=ylim,...);
	# not a great way to do it, but will do for now
	if(!is.null(args$fun)){
		if(args$fun=='event')for(i in 1:2)
			{points(sf[i]$time,1-sf[i]$surv,pch=pch[i],cex=pcex,lwd=lwd,bg=bg[i],col=col[i])}
	} else {for(i in 1:2){points(sf[i],pch=pch[i],cex=pcex,lwd=lwd,bg=bg[i],col=col[i]);}}
	if(!is.null(legend)){legend(x=lloc,col=col,pt.bg=bg,lwd=lwd,pch=pch,legend=legend);}
	invisible(sf);
}

`plotsurv`<-
function(x, y, cx=NULL, cy=NULL, lloc='bottomleft', add=F, pcex=1, legend=NULL, ...){
# parse arguments
lx<-length(x);ly<-length(y);myargs<-list(...);
# set some defaults if not explicitly set by arguments
if(is.null(cx)){cx<-rep(1,lx);}; if(is.null(cy)){cy<-rep(1,ly);};
if(is.null(myargs$bg)) myargs$bg<-c(1,'darkred');
if(is.null(myargs$lwd)) myargs$lwd<-2;
#if(is.null(myargs$pcex)) myargs$pcex<-1;
if(is.null(myargs$pch)) myargs$pch<-24:25;
if(is.null(myargs$ylim)) myargs$ylim<-0:1;
# generate data to be plotted
sf<-survfit(Surv(c(x,y),event=c(cx,cy))~c(rep(0,lx),rep(1,ly)));
myargs$x<-sf;
# set and call the plotting function
if(add) do.call(lines, myargs) else {
    do.call(plot, myargs);
}
iargs<-myargs; 
if(!is.null(iargs$fun)){
	if(iargs$fun=='event')for(i in 1:2)
		with(iargs, points(sf[i]$time, 1-sf[i]$surv,pch=pch[i],cex=pcex,lwd=lwd,bg=bg[i],col=col[i]))
} else {for(i in 1:2){
	with(iargs,points(sf[i],pch=pch[i],cex=pcex,lwd=lwd,bg=bg[i],col=bg[i]));
    }
}
if(!is.null(legend)){
    with(myargs,legend(x=lloc,col=col,pt.bg=bg,lwd=lwd,pch=pch,legend=legend));
}
}