rNIX/R/km.R

#' 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(...)
   set.from.arg.list(var,default,z)
}

#' Set argument value from list or to default value
#'
#' @param name of value in list
#' @param default value
#' @param list of values, such as labkey.url.params
#' @return value from list or default if missing
#'
#' @export 

set.from.arg.list<-function(var,default,z){
   if (var %in% base::names(z)) result<-base::unlist(z[[var]])
   else result=default
   result
}

#' Evaluate 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
#'
#' @return p probability that curves split by var differ significantly
#'
#' @export

kaplan.meier.stats<-function(x,var){
	#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)
	s=survival::survdiff(f,data=x)
   p=stats::pchisq(s$chisq, length(s$n)-1, lower.tail = FALSE)
   p
}


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