|
@@ -31,3 +31,107 @@ kaplan.meier<-function(x,var,comment=''){
|
|
|
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)
|
|
|
+
|
|
|
+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','NOT GIVEN',...)
|
|
|
+ tit=base::sprintf('Kaplan-Meier plot by %s',varName)
|
|
|
+
|
|
|
+ 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,...)
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+ base::print(base::sprintf('my.n=%f',my.n))
|
|
|
+
|
|
|
+ xlab=base::sprintf('Time (%ss)',unit)
|
|
|
+ ylab='Overall survival probability'
|
|
|
+ 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(ylab)
|
|
|
+ }
|
|
|
+
|
|
|
+
|
|
|
+ q
|
|
|
+
|
|
|
+
|
|
|
+
|
|
|
+}
|