# TODO: Add comment
# 
# Author: E.Korsching 10.9.2009,2023
# Dependencies: plot.bar.point.segment(), bin()
###############################################################################


hist.plot.color <- function(x, xcolor=F, y=NULL, bin.num=10, x.range=NULL, norm=F, n.factor=1, lty=3, lwd=1,
		xlab="", ylab="", xlim=NULL, y.max=NULL, x.at=NULL, y.at=NULL, ylog=F, bar.width=0.7, offset=0, digits=2,
		col.grad=c("red","blue"), col.f="blue", col.sh=NULL, col.b=NA, cex=1, h.title="", add=F, rC=F){
	# will apply bin() and plots a monochrome or color coded histogram  (not intended for categorical variables)
	# x: vector of values (not bin_ed raw data)
	# xcolor: T: enable x values for color generation or use y,  col.grad: 2 colors for gradient
	# y: if given, will define colors on x bars according to values in y (x,y need to have a paired logic)
	# if not gradient based on x or y:
	#    col.f: 1 color: fill/shading or NULL, col.sh: positive number shading/inch or NULL (fill), col.b: 1 color: border or NA
	#    you might select colors by  palette()[i]
	# x.range: NULL: data range by x -else- assumed data range of x,  xlim: plot range
	# bin.num: number of intervals see - bin() sort increasing
	# norm: normalization to sum=1,  n.factor: factor to scale plot in relation to another histogram
	# line-type: lty,  line-width: lwd
	# xlab/ylab: axis labels,  y.max: set max y value,  x.at,y.at: tick positions,  ylog: T: log scale
	# bar.width: 1: no spacing between columns, <1: spacing between columns
	# offset: free place on the left and right from the distribution
	# digits: decimal digits on the x scale label,  cex: character size
	# h.title: title,  add: T: the bars or lines will be added to the active plot
	# rC:T: return bin counts
	
	# normal hist plot via:  hist(x)
	
	# ini
	if(mode(x)=="character"){ stop("\n stop -real values assumed-  \n") }
	if(!is.null(y) & xcolor){ stop("\n Either y can be used or xcolor can be true") }
	
	#source("../0functions/0general/bin.R")
	#source("../0functions/0general/plot.bar.point.segment.R")
	
	# create bins
	tmp <- bin(x=x, x.range=x.range, bin.num=bin.num)
	erg <- tmp[[1]]
	bin.num <- tmp[[2]]["bin.n"]
	min.x <- tmp[[2]]["min"]			# x
	max.x <- tmp[[2]]["max"]
	diff.x <- tmp[[2]]["range.eff"]
	
	# if y is the basis of the color
	if(!is.null(y)){
		hist.bar.col <- sub.hist.plot.simple(x=x, y=y, x.range=x.range, bin.num=bin.num, color=col.grad)
	}
	# if x is the basis of the color
	if(xcolor){
		hist.bar.col <- sub2.hist.plot.simple(x=x, x.range=x.range, bin.num=bin.num, color=col.grad)
	}
	
	# total counts    -- check count size
	dist.sum <- sum(erg[,1])
	cat("\n Total counts of histogram : ",dist.sum)			# not full area
	cat("\n Bin number : ",bin.num,"\n")
	
	#normalize distribution, all counts =1
	if(norm){
		erg[,1] <- ( erg[,1]/dist.sum ) * n.factor
	}
	
	# y log scale
	if(ylog){
		sylog <- erg[,1]<1
		if(sum(sylog>0)){
			warning(paste("bin content smaller 1 - set to 1",sep=""))
			erg[sylog, 1] <- 1
			erg[,1] <- log(erg[,1], base=10)
		}
	}
	min.y <- min(erg[,1])		# y
	max.y <- max(erg[,1])
	
	# plot
	if(is.null(xlim)){
		xlim <- c(min.x-offset, max.x+offset)				# set x range + offset
	}else{
		xlim <- c(xlim[1]-offset, xlim[2]+offset)
	}
	ylim <- c(0, if(is.null(y.max)){ max.y }else{ y.max })		# set y range
	# axis labels
	if(xlab==""){
		xlab <- paste( deparse(substitute(x)), collapse="" )	# data name
		xlab.len <- nchar(xlab)
		if(xlab.len>20){ xlab <- paste(substr(xlab, start=1, stop=20),".. ; ") }	# restrict to 20 character
	}
	if(ylab==""){
		if(ylog){
			if(norm){ ylab="log10(norm_counts)" }else{ ylab="log10(counts)" }
		}else{
			if(norm){ ylab="norm_counts" }else{ ylab="counts" }
		}
	}
	
	# define plot area and layout
	if(!add){	# not for add
		plot(c(0, 1), c(0, 1), type="n", xlim=xlim, ylim=ylim, axes=F, xlab=xlab, ylab=ylab, cex.lab=cex)
		if(is.null(x.at)){
			axis(1, at=c(round(min.x,digits=digits), round(min.x+(diff.x/3),digits=digits), round(min.x+(diff.x/3*2),digits=digits), round(max.x,digits=digits)), cex.axis=cex )
		}else{
			axis(1, at=x.at, cex.axis=cex)
		}
		if(is.null(y.at)){
			tmp <- c(ylim[1], ylim[2]/2, ylim[2])
			axis(2, at=tmp, labels=paste(round(tmp,digits=digits),sep=""), adj=0.5, srt=90, cex.axis=cex)
		}else{
			axis(2, at=y.at, labels=y.at, adj=0.5, srt=90, cex.axis=cex)
		}
	}
	
	# bar plot
	diff.tmp <- erg[,3]-erg[,2]
	ra <- as.vector( (diff.tmp/2)+erg[,2] )
	adj.bar.width <- bar.width * diff.tmp
	
	for(i in 1:length(ra)){	# bin.num
		if(erg[i,1]!=0){							# only make bar if bin != 0
			plot.bar.point.segment(
					x=ra[i],
					height=erg[i,1],				# count
					width=adj.bar.width[i],			# bar width
					col=if(!is.null(y) | xcolor){ hist.bar.col[i] }else{ col.f },
					bcol=col.b,
					density=col.sh,
					horiz=F,
					at=0,
					lwd=lwd,
					type="bar")
		}
	}
	# text
	if(h.title != ""){
		mtext(text=h.title, line=2.2, side=3, cex=cex*0.9)
	}
	
	if(rC){
		return(erg[,1])		# raw counts
	}else{
		return()
	}
}


sub.hist.plot.simple <- function(x=NULL, y=NULL, x.range, bin.num, color){
	# create a vector of colors to be applied on the histogram bars
	# based on two distributions of paired values
	# x: main distribution , y: reference distribution
	# color: get two colors for gradient
	
	# bin.num vector
	tmp.b <- vector(mode="numeric",length=bin.num)		# x.color-final
	
	# raw set
	len.x <- length(x)
	len.y <- length(y)
	if(len.x!=len.y){ stop("\n x and y length differ ") }
	tmp.r <- data.frame(x.p=rep(0,len.x),y.p=rep(0,len.x),x.c=rep(0,len.x),stringsAsFactors=F)		# x.bin.pointer, y.bin.pointer, x.color-raw
	
	# raw - create pointer x
	tmp.r[,1] <- bin.pointer(x=x, x.range=if(is.null(x.range)){ NULL }else{ x.range }, bin.num=bin.num)
	# raw - create pointer y
	tmp.r[,2] <- bin.pointer(x=y, x.range=if(is.null(x.range)){ NULL }else{ x.range }, bin.num=bin.num)
	
	# create color gradient
	tmp.r.yrange <- range(tmp.r[,2])		# link to y col
	tmp.r.yrlen <- tmp.r.yrange[2]-tmp.r.yrange[1]+1
	a.pal <- colorRampPalette(c(color[1], color[2]),space="rgb")	# create color function
	col.bin <- a.pal(tmp.r.yrlen)	# generate palette colors
	
	tmp.r.xrange <- range(tmp.r[,1])
	tmp.r.xrlen <- tmp.r.xrange[2]-tmp.r.xrange[1]+1
	
	# add color according to y bin pointer (gradient according to col-1 bin-1..bin-n col-n, plot left to right)
	for(i in 1:len.x){
		tmp.r[i,3] <- col.bin[ tmp.r[i,2]-tmp.r.yrange[1]+1 ]	# link to y col
	}
	# fill bin.num vector & sum all x.colors per bin
	for(i in 1:bin.num){
		if(i<tmp.r.xrange[1] | i>tmp.r.xrange[2]){
			tmp.b[i] <- "#000000"		# no color - white
		}else{
			idx <- tmp.r[ ,1]==i		# now link to x col
			if(sum(idx)==0){
				tmp.b[i] <- "#000000"		# no color - white - gap
			}else{
				tmp.b[i] <- color.mix( tmp.r[idx, 3] )
			}
		}
	}
	
	# return vector of bin colors for x-bin 1..n
	return(tmp.b)
}


sub2.hist.plot.simple <- function(x=NULL, x.range, bin.num, color){
	# create a vector of colors to be applied on the histogram bars
	# useful for a x-colored plot next to a second x-y-colored distribution plot
	# x: main distribution
	# color: get two colors for gradient
	
	# bin.num vector
	tmp.b <- vector(mode="numeric",length=bin.num)		# x.color-final
	
	# raw set
	len.x <- length(x)
	tmp.r <- data.frame(x.p=rep(0,len.x),x.c=rep(0,len.x),stringsAsFactors=F)		# x.bin.pointer, x.color-raw
	
	# raw - create pointer x
	tmp.r[,1] <- bin.pointer(x=x, x.range=if(is.null(x.range)){ NULL }else{ x.range }, bin.num=bin.num)
	
	# create color gradient
	tmp.r.range <- range(tmp.r[,1])		# link to x col
	tmp.r.rlen <- tmp.r.range[2]-tmp.r.range[1]+1
	a.pal <- colorRampPalette(c(color[1], color[2]),space="rgb")	# create color function
	col.bin <- a.pal(tmp.r.rlen)	# generate palette colors
	
	# add color according to x bin pointer (gradient according to col-min bin-min..bin-max col-max, plot left to right)
	n1 <- 1	# counter
	for(i in 1:bin.num){
		if(i<tmp.r.range[1] | i>tmp.r.range[2]){
			tmp.b[i] <- "#000000"		# no color - white - gap
		}else{
			tmp.b[i] <- col.bin[n1]
			n1 <- n1+1
		}
	}
	
	# return vector of bin colors for x-bin 1..n
	return(tmp.b)
}


smooth <- function(x, smooth.r=0){
	# 'mean' smoothing with gliding window - first + last value replicated smooth.r times
	# x: vector to smooth,  smooth.r: number of positions to extend start and end
	if(smooth.r==0){ stop("nothing to do") }
	xlen <- length(x)
	x.smooth1 <- c(rep(x[1],smooth.r),x,rep(x[xlen],smooth.r))
	x.smooth2 <- x.smooth1
	for(i in (smooth.r+1):(smooth.r+xlen)){
		x.smooth2[i] <- mean( x.smooth1[(i-smooth.r):(i+smooth.r)] )
	}
	# return the original inner range
	return( x.smooth2[(smooth.r+1):(smooth.r+xlen)] )
}