# TODO: Add comment
# 
# Author: E.Korsching updated 29.08.2017, 2026
###############################################################################



# profile plot

plot.profile.de <- function(x, xl=NULL, yl=NULL, xlab=NULL, ylab=NULL, xtext=NULL, xtext.cex=1, srt=0, fn=NULL, breaks=2, col=c("green","blue"), leg.text=NULL, vlines=NULL)
{
	# plot profiles : samples=columns, factors=rows, profiles along the rows
	# x: experiments in columns
	# fn: function condensing groups of rows to one row
	#  returns a condensed data set of x
	#  provide a suitable function name (see below)
	# breaks: number of row groups
	# xl: column selection or range,  yl: data expression range or a custom range
	# xtext: column labels,  srt: rotation of xtext
	# col: vector of colors as long as the input or fn set  or  one/two/three colors
	# leg.text: legend: text vector as long as the input or fn set
	# vlines: additional vertical lines in graph
	if(is.null(xlab)){ xlab <- "experiments" }
	if(is.null(ylab)){ ylab <- "expression" }
	if(!is.null(fn)){ x <- fn(x=x, breaks=breaks) }

	nc <- ncol(x)
	nr <- nrow(x)
	if(is.null(xl)){ xl <- c(0,(nc+1)) }
	if(is.null(yl)){ yl <- range(x) }
	clen <- length(col)
	if(clen<nr){
		col <- colorRampPalette(col)(nr)
#		col <- rep(col, ceiling(nr/clen))
#		col <- col[1:nr]	# remove when created more
	}
	
	# plot
	layout( matrix( c(1,2,3,3), 2, 2 ),	# by column
			width=c(2.1,0.8),
			height=c(1,0.3)
	)
	#layout.show(3)
	
	p.mar <- par()$mar		# par(mar=c(5.1,4.1,4.1,2.1))
	par(mar=c(0.1,4.1,4.1,2.1))
	
	# graph y axis description, y axis, plot area
	cat("\n x range ",xl," y range ",yl,"\n")
	plot(1,1, type="n", axes=F, xlab="", ylab=ylab, xlim=xl, ylim=yl)
#	axis(side=1, at=c(1:nc), labels=if(is.null(xtext)){ T }else{ xtext }, tick=F)
	axis(side=2)
	abline(v=c(1:nc), lty=3)
	if(!is.null(vlines)){ abline(v=vlines, lty=5, col="black") }
	for(i in 1:nr){
		#points(x=c(1:nc), y=x[i,], col=col[i], pch=3)
		lines(x=c(1:nc), y=x[i,], col=col[i], lty=1, lwd=0.8)
	}
	
	# graph x axis lables and x axis description
	par(mar=c(3.1,4.1,0.1,2.1))
	plot(1,1, type="n", axes=F, xlab="", ylab="", xlim=xl, ylim=c(0,2))
	text(x=c(1:nc), y=1, labels=if(is.null(xtext)){ c(1:nc) }else{ xtext }, adj=c(0.5,0.5), offset=0.5, cex=xtext.cex, srt=srt)
	mtext(xlab, side=1, line=0, cex=0.8)
	
	# legend
	par(mar=c(0.1,0.1,0.1,0.1))
	plot(1,1, type="n", axes=F, xlab="", ylab="", xlim=c(0,1.8), ylim=c(0,9))
	if(is.null(leg.text)){
		leg.text <- paste(c(1:nr),sep="")
	}
	legend(x=0.1,y=8, legend=leg.text, col=col, lty=1, bty="n", title="Profile")
	
	par(mar=p.mar)
	par(mfrow=c(1,1))
	return()
}

#plot.profile.de(x=aa, xl=NULL, yl=NULL, xlab=NULL, ylab=NULL, fn=NULL, col=c("green","blue"))
# API missmatch: reinstall 'svglite' in R cran


# condensing to row groups of similar properties

col.mean.groups <- function(x, breaks){
	# based on row means
	nr <- nrow(x)
	nc <- ncol(x)
	rmx <- rowMeans(x)
#	rmx.v <- cut(x=rmx, breaks=breaks, labels=F)
	rmx.v <- cut3(x=rmx, g=breaks)
	umx <- unique(rmx.v)
	umx <- umx[order(umx)]
	cat("\n unique levels ",umx,"\n")
	ul <- length(umx)
	xu <- matrix(0,breaks,nc)
	for(i in umx){
		xu[i,] <- colMeans(x[rmx.v==i,])
	}
	return(xu)
}

col.var.groups <- function(x, breaks){
	# based on row vars
	nr <- nrow(x)
	nc <- ncol(x)
	rmx <- apply(x,1,var)
	rmx.v <- cut3(x=rmx, g=breaks)
	umx <- unique(rmx.v)
	umx <- umx[order(umx)]
	cat("\n unique levels ",umx,"\n")
	ul <- length(umx)
	xu <- matrix(0,breaks,nc)
	for(i in umx){
		if(sum(rmx.v==i)>1){
			xu[i,] <- apply(x[rmx.v==i,],2,var)
		}
	}
	return(xu)
}

#Hmisc::cut2(x=eGEOD58557[1:70,1]+1, g=7, minmax=TRUE, oneval=TRUE, onlycuts=T)

cut3 <- function(x, g){
	# cut based on quantiles but returns a vector with group labels
	xl <- length(x)
	xo <- vector("integer",xl)
	bin <- 1/g
	s.bin <- seq(0, 1, bin)
	sl.bin <- length(s.bin)
	q.b <- quantile(x, probs=s.bin[2:sl.bin])
	k <- 1
	j <- 0
	for(i in q.b){
		xo[(x>j & x<=i)] <- k
		j <- i
		k <- k+1
	}
	return(xo)
}

#cut3(x=eGEOD58557[1:70,1]+1, g=7)