#' Create a KM plot #' #' @param x a data frame that contains followup and censored columns #' @param var a categorical variable to split the data to sub-curves #' @param comment An additional piece of text to write in the curve #' #' @return p probability that curves split by var differ significantly #' #' @export kaplan.meier<-function(x,var,comment=''){ #x should have followup and censored columns surv.obj<-survival::Surv(x$followup,x$censored) m=base::max(x$followup) f<-stats::as.formula(paste('surv.obj',var,sep='~')) s1<-survival::survfit(f,data=x) #str(s1) tit=base::sprintf('Kaplan-Meier plot by %s',var) cols=base::c('red','blue') labels=base::c(base::sprintf('%s=true',var),base::sprintf('%s=false',var)) #plot(s1,mark.time=TRUE,col=c('red','blue'),pch=labels,main=tit) graphics::plot(s1,mark.time=TRUE,col=c('red','blue'),main=tit) s=survival::survdiff(f,data=x) #str(s) p=stats::pchisq(s$chisq, length(s$n)-1, lower.tail = FALSE) sv=base::sprintf("p=%.3f",p) nLab=base::sprintf('N=%d',nrow(x)) graphics::text(x=c(0.9*m,0.3*m,0.9*m),y=c(0.2,0.1,0.3),label=c(sv,comment,nLab),cex=1.2) lLab <- base::gsub("x=","",base::names(s1$strata)) ## legend labels graphics::legend("top",legend=lLab,col=cols,lty=c(1,1),horiz=FALSE, bty='n') p } set.from.list<-function(var,default,...){ z<-list(...) if (var %in% base::names(z)) result<-base::unlist(z[[var]]) else result=default result } #' Plot a Kaplan-Meier curve with ggsurvfit #' #'@param x data frame containing followup and censored column #'@param var name of variable to stratify by #'@param ... other parameters: #' * varName name of variable for title (NOT GIVEN) #' * comment additional text to print on plot (empty string) #' * reorder whether to change order of categorical variable labels in legend (FALSE) #' * unit unit for time axis #' * my.legend.title title to set to legend (varName) #' * my.title title for the plot (Kaplan-Meier plot by varName) #' * my.labels labels for cases #' * draw.axis draw title and axis (FALSE) #' * my.n number of classes (2) #' * my.ylab label for y axis (Overall survival probability) #'@return graphical object #' #'@export kaplan.meier.plot.gg<-function(x,var,...){ if (!requireNamespace('ggsurvfit',quiet=TRUE)){ print('ggsurvfit not available. Use rNIX::kaplan.meier function') return(NULL) } #x should have followup and censored columns surv.obj<-survival::Surv(x$followup,x$censored) m=base::max(x$followup) f<-stats::as.formula(paste('surv.obj',var,sep='~')) #need survfit2 s1<-ggsurvfit::survfit2(f,data=x) varName=set.from.list('varName',var,...) tit=base::sprintf('Kaplan-Meier plot by %s',varName) ylab='Overall survival probability' comment=set.from.list('comment','',...) my.labels=set.from.list('my.labels',c(),...) reorder=set.from.list('reorder',FALSE,...) unit=set.from.list('unit','day',...) my.legend.title=set.from.list('my.legend.title','NONE',...) draw.axis=set.from.list('draw.axis',FALSE,...) my.title=set.from.list('my.title',tit,...) my.n=set.from.list('my.n',2,...) my.ylab=set.from.list('my.ylab',ylab,...) base::print(base::sprintf('my.n=%f',my.n)) xlab=base::sprintf('Time (%ss)',unit) if (my.n==4) cols=base::c('dodgerblue2', 'orchid2','orange','green') else cols=base::c('dodgerblue2', 'orchid2') nc=base::length(cols) base::print(base::sprintf('nc=%d',nc)) labs <- base::gsub("^.*=","",base::names(s1$strata)) ## legend labels if (base::length(my.labels)==0){ my.labels <- labs } nl=base::length(labs) nl1=base::length(my.labels) base::print(base::sprintf('nl=%d nl1=%d',nl,nl1)) if (my.legend.title=='NONE'){ my.legend.title=varName } if (reorder){ perm=base::c(2,1) cols=cols[base::order(perm)] labs=labs[base::order(perm)] my.labels=my.labels[base::order(perm)] } q<-ggsurvfit::ggsurvfit(s1,lwd=1.0,censor=TRUE,censor.shape='+',censor.size=10)+ ggplot2::ylim(0,1)+ ggsurvfit::add_legend_title(my.legend.title)+ ggsurvfit::add_pvalue("annotation", size = 5)+ #add_pvalue("caption", size = 5)+ ggsurvfit::add_confidence_interval()+ #add_risktable()+ ggplot2::scale_color_manual(values=cols,breaks = labs,labels=my.labels) + ggplot2::scale_fill_manual(values=cols, breaks = labs,labels=my.labels) + ggplot2::labs(x=NULL, y=NULL) if (draw.axis){ q<-q+ggplot2::ggtitle(my.title)+ggplot2::xlab(xlab)+ggplot2::ylab(my.ylab) } q }