본문 바로가기

R관련/Rfunction

survival analysis function

728x90
반응형
#' survival analysis and get Log-rank p.value
#' 
#' This function is to get Log-rank p-value and Kaplan-meier plot for survival analysis.
#' @param class (default=NULL,factor) : Input vector, 1st row drug response, 2nd mutation
#' @param survival_time (default=NULL,numeric) : Input vector, put them as numeric.
#' @param status (default=NULL,numeric) : Input vector, 0(alive) or 1(dead)
#' @param plot (default=T,logical) : True or False to draw the KM plot
#' @param colors (default=NULL,character) : Colors for each groups
#' @param xlab (default=NULL,character) : Put time scale (days, months, years....)
#' @param title (default=NULL,character) : Put title of plot
#' @param export (default=T,character) : True or False to export the results of survival analysis.
#' @param scientific (default=F) : True or False whether p-value should be scientific notation because of too significant p-value.
#' @param nlarge (default=5) : If scientific is true, this parameter is used to decide whether p-value is too significant or not.\cr
#' 5 means (10^-5). If a p-value is more significant than the nlarge, the p-value will computed as scientific notation (ex. 5E-6)
#' @keywords Log-rank test
#' @return
#' surv_formula : formula used in survfit and survdiff
#' survfit : survfit(surv_formula)
#' p.value : Log-rank p value survdiff(surv_formula)
#' @export
#' @examples
#' class=as.factor(paste0('GPC',rep(c(1,2,3),each=50)))
#' survival_time=c(rnorm(50,10),rnorm(50,100,sd=5),rnorm(50,50,sd=10))
#' status=sample(c(0,1),150,replace=T)
#' #Drawing only
#' survival_analysis(class=cls,survival_time=surv_time,status=status,plot=T,
#' colors=c('skyblue','tomato','darkgreen'),
#' xlab='Months',title='example',export=F,scientific=T)
#' #Result and plotting
#' survival_analysis(class=cls,survival_time=surv_time,status=status,plot=T,
#' colors=c('skyblue','tomato','darkgreen'),
#' xlab='Months',title='Result and plotting',export=T)
  #-----------------------------------------
  # draw plot
  #-----------------------------------------
    survival_analysis=function(class=NULL,survival_time=NULL,status=NULL,plot=T,colors=NULL,
                               xlab=NULL,title=NULL,export=T,scientific=F,nlarge=5){
      frms=survival::Surv(survival_time,status)~class
      os=survival::survfit(frms)
      # Calculate Log-rank p.value
        pv=survival::survdiff(frms)
        pv=pchisq(pv$chisq,length(pv$n)-1,lower.tail = F)
      # Plotting?
        if(plot){
          plot(os,ylab='Survival probability',xlab=xlab,main=title,mark.time=T,cex=5,lwd=5,col=colors)
          # p-value formating
            if(scientific){
              if(pv<10^(-nlarge)){
                pv2=toupper(format(pv,scientific=T,nsmall=3,digits=3))
                pv2=gsub(pv2,pattern = '-0',replacement = '-')
              }else{
                pv2=format(pv,scientific=F,nsmall=3,digits=3)
              }
            }else{
              pv2=format(pv,scientific=F,nsmall=3,digits=3)
            }
          mtext(paste0('Log-rank p=',pv2),adj=1,side=3)
          # Legend
            legend.txt=gsub(paste0(names(os$strata),'(N=',os$n,')'),pattern='class=',replacement = "",fixed=T)
            legend('topright',legend = legend.txt,lwd=5,col=colors)
        }
      # Calculate hazard ratio
        # Get a subtype showing the best prognosis (longest median survival)
          median.os=quantile(os)$quantile[,2]
          median.os=sort(median.os,decreasing = T) # Sort the classes according to median survival period
          sorted.su=gsub(names(median.os),pattern = 'class=',replacement = '',fixed = T)
        # Change class name
          class2=as.factor(multi_sub(as.character(class),pattern = sorted.su,
                                     replacement = 1:length(sorted.su),exact=T))
          frms2=survival::Surv(survival_time,status)~class2
          hazard.ratio=coxph(frms2)
          hazard.ratio2=exp(hazard.ratio$coefficients)
        # Return the hazard ratio
          hazard.ratio3=c(1,hazard.ratio2)
          names(hazard.ratio3)=sorted.su
       
      # Export result?
        if(export){return(list('surv_formula'=frms,'survfit'=os,'p.value'=pv,'hazard.ratio'=hazard.ratio3))}
    }

    

 

728x90
반응형

'R관련 > Rfunction' 카테고리의 다른 글

Hexbin scatter plot  (0) 2020.03.23
GSEA Enrichment Score calculation  (0) 2019.02.27
scanning ks-test  (0) 2018.03.02
domain_annotation  (0) 2017.07.21
IC50, drc  (0) 2017.07.21