gugl58
10/16/2017 - 3:36 PM

plot.coxReadable

Take output of readable.coxmodel and make a nice plot

#' Plot multiple Coxmodels
#' 
#' Plot multiple cox models supplied by readable.coxmodel() 
#' The black dots size correlate exactly to the absolute coefficient value
#'
#' @param readable.coxOutput 
#' @param optional.column.ordering 
#' If given, these columns are ordered first
#' "uneven" 	takes the uneven columns and orders them first
#' "even" 		takes the even columns and orders them first
#' @return
#' Single plot
#' @export
#'
#' @examples
#' 
#' a <- readable.coxmodel(coxlist.rgb)
#' print(plot.coxReadable(a))
#' 
plot.coxReadable <- function(readable.coxOutput
							 ,optional.column.ordering=NA
							 ,maxFittextWidth=10
							 ,opt.columns.until=NA){
	inst.load.packages("reshape2", silent = TRUE) # melt
	inst.load.packages("ggplot2", silent = TRUE) # ggplot
	inst.load.packages("tidyr", silent = TRUE) # spread
	inst.load.packages("ggfittext", silent = TRUE) # geom_fit_text
	
	
	coxOut.noCriterions <- readable.coxOutput[-which(names(readable.coxOutput) == "crit")]
	melted <- melt(coxOut.noCriterions, varnames = c("Measurement", "Model"))
	melted <- spread(melted, L1, value)
	melted <- transform(melted, discrete.pval=cut(pval, c(0, 0.001, 0.01, 0.05, 0.1, 1), include.lowest=T))
	melted$Measurement <- factor(melted$Measurement, levels = levels(melted$Measurement)[length(levels(melted$Measurement)):1])
	
	
	if(is.numeric(opt.columns.until)){
		to.number <- opt.columns.until
	}else{
		to.number <- length(levels(melted$Model))
	}
	if(!is.na(optional.column.ordering)){
		if(optional.column.ordering == "uneven"){
			opt.col.order <- seq(from=1, to=to.number, by=2)
		}else if(optional.column.ordering == "even"){
			opt.col.order <- seq(from=2, to=to.number, by=2)
		}
	}
	
	if(!all(is.na(opt.columns.until))){
		new.col.ordering <- c(opt.col.order, (1:length(levels(melted$Model)))[-opt.col.order])
		melted$Model <- factor(melted$Model, levels = levels(melted$Model)[new.col.ordering])
	}
	
	melted$labels <- with(data = melted, sprintf("coef:%5.3f\npval:%5.3f", round(coef, 3), round(pval, 3)))
	# handle "not in model"-coefficients
	melted$labels <- ifelse(grepl("NA", melted$labels), "NA\nCoxResult", melted$labels)
	melted$discrete.pval.NIM <- ifelse(is.na(melted$coef) & !is.nan(melted$coef), "NA-CoxResult", as.character(melted$discrete.pval))
	melted$discrete.pval.NIM <- factor(melted$discrete.pval.NIM, levels = c(levels(melted$discrete.pval), "NA-CoxResult"))
	plot00 <-
		ggplot(melted, aes(x=Model, y=Measurement, fill=discrete.pval.NIM, label=labels)) +
		geom_tile(na.rm = TRUE) +
		geom_point(aes(size=10*abs(coef)), position = position_nudge(y=.15), shape=19, col="white", na.rm = TRUE)+ 
		scale_fill_manual(values=c("green3", "yellow", "orange", "red", "firebrick4", "grey"), drop=FALSE) + 
		# scale_color_manual(values=c("green3", "yellow", "orange", "red", "firebrick4"), drop=FALSE) +       ## color of the corresponding aes
		scale_size_identity() + 
		theme(axis.text.x = element_text(angle = 90, hjust=1, vjust=0.5)) 
	plot01 <- plot00+
		geom_fit_text(width = maxFittextWidth, height = 15)
	return(list(plot00, plot01))
}