gugl58
10/16/2017 - 12:54 PM

Calculate Coxmodel + Covariates

Calculate Coxmodel with covariates

#' Calculate a cox model based on a response and survival data
#'
#' @param response 
#' @param responsename 
#' @param pheno.df 
#' @param survtimename 
#' @param surveventname 
#' 
#' @param corr.formulastring 
#' c("+(IPS>2)", "+Alter", "+(Alter>45)")
#' @param corr.formulastring.name 
#' c("IPS", "Age", "AgeD")
#' @param all.corrections 
#' @param corrections.univariat 
#' 
#' @return
#' @export
#'
#' @examples
#' test <- 1
#' 
#' 
calc.coxmodel <- function(response
						  ,responsename
						  ,pheno.df
						  ,survtimename="SV"
						  ,surveventname="SV_STAT"
						  ,corr.formulastring=NULL
						  ,corr.formulastring.name=NULL
						  ,all.corrections=TRUE
						  ,corrections.univariat=TRUE){
	inst.load.packages("survival", silent=TRUE)
	inst.load.packages("stringr", silent=TRUE)
	
	corr.formulastring <- c("", corr.formulastring) # This is the first looprun without any corrections
	corr.formulastring.name <- c("onlyFeature", corr.formulastring.name) # This is the first looprun without any corrections
	
	if(all.corrections){
		corr.formulastring <- c(corr.formulastring, paste0(corr.formulastring, collapse = ""))
		# corr.formulastring.name <- c(corr.formulastring.name, paste(corr.formulastring.name, collapse = ""))
		corr.formulastring.name <- c(corr.formulastring.name, "allCovariates")
	}
	model.list <- NULL
	survsim <- Surv(pheno.df[[survtimename]], pheno.df[[surveventname]])
	for(formulaN in 1:length(corr.formulastring)){
		formula.resp <- paste("response", corr.formulastring[formulaN], sep = " ")
		
		GotError <- FALSE
		pheno.tmp <- pheno.df
		formula.tmp <- paste0("survsim ~ ", formula.resp)
		tryCatch(expr = {
			cox.tmp <- coxph(as.formula(formula.tmp), data=pheno.tmp)
			# convenient naming
			cox.tmp$call <- paste0('coxph(formula=', formula.tmp, ', data=pheno.tmp)')
			cox.tmp$call <- sub("response", responsename, cox.tmp$call)
			names(cox.tmp$coefficients) <- sub("response", paste0(responsename, "."), names(cox.tmp$coefficients))
		}
		,error=function(e){
			warning("COXMODEL Calculation had the following (catched) ERROR:")
			cat("    "); print(e, quote = FALSE)
			GotError <<- TRUE
		})
		if(GotError){
			resp.result <- NA
		}else{
			resp.result <- cox.tmp
		}
		model.list <- c(model.list, list(resp.result))
		names(model.list)[length(model.list)] <- corr.formulastring.name[formulaN]
	}
	if(corrections.univariat){
		for(formulaN in 2:(length(corr.formulastring))){ # I added to corr.formulastring "" in the beginning
			pheno.tmp <- pheno.df
			tmp.form <- sub("^[ ]*\\+", "", corr.formulastring[formulaN])
			if(tmp.form == ""){
				next
			}
			formula.tmp <- paste0("survsim ~ ", tmp.form)
			cox.tmp <- coxph(as.formula(formula.tmp), data=pheno.tmp)
			cox.tmp$call <- paste0('coxph(formula=', formula.tmp, ', data=pheno.tmp)')
			model.list <- c(model.list, list(cox.tmp))
			names(model.list)[length(model.list)] <- paste0("only", corr.formulastring.name[formulaN])
		}
	}
	return(model.list)
}