123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142 |
- #' 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
-
-
-
- }
|