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


hist.plot.categorical <- function(x, exclude.categorical=NULL, dsort=NULL, xlab=NULL,
		y.max=NULL, y.at=NULL, norm=F,
		bar.width=1, digits=2, col="blue", cex=1, h.title="")
{
	# plots a histogram for categorical data
	# sort implicit included -- character values assumed
	# exclude.categorical: single string or vector of strings which should be excluded from the present categories
	# dsort: "a" alphanumeric sorting -or- numerical sort vector -or- NULL: do not sort
	# x: vector of strings or factor vector,  xlab: axis label,  y.max: set max,
	# x.at,y.at: tick positions,  norm: T: normalization to sum of counts
	# bar.width: 1: no spacing between columns, <1: spacing between columns
	# fxSpace: factor for vertical space for the x axis labels,  srt: x axis label orientation
	# digits: decimal digits on the y scale label,  col: colors,  cex: character size
	
	# ini
	if(!is.character(x)){ stop("Character values assumed\n") }
	source("../0functions/0general/plot.bar.point.segment.R")
	
	if(!is.null(exclude.categorical)){
		# adjust x by exclude.categorical
		x <- x[!(x%in%exclude.categorical)]
	}
	
	xlen <- length(x)
	
	# create levels
	if(is.null(dsort)){
		x.lev <- unique(x)		# NA a level
	}else{
		x.lev <- unique(x)
		if(is.character(dsort)){
			x.lev <- x.lev[order(x.lev)]
		}else if(is.numeric(dsort)){
			if(length(dsort)!=length(x.lev)){ stop("\n dsort: wrong length") }
			x.lev <- x.lev[dsort]
		}else{
			stop("\n dsort: check input")
		}
	}
	x.lev.anz <- length(x.lev)						# number of levels
	x.at <- seq(1,x.lev.anz,1)						# define position of tick marks
	cat("\n number of categories: ",x.lev.anz,"\n")
	
	xlim <- c(0, x.lev.anz+1)
	
	erg <- data.frame(matrix(0,x.lev.anz,2))		# counts per bin
	names(erg) <- c("counts","category")
	
	# counts per category
	for(i in 1:x.lev.anz){
		erg[i,1] <- sum(x%in%x.lev[i])		# count
		erg[i,2] <- x.lev[i]				# level
	}
	
	if(norm){
		erg[,1] <- erg[,1]/sum(erg[,1])
	}
	
	dist.area <- sum(erg[,1])
	
	# ylim
	yr <- max(erg[,1])
	if(yr==0){ stop("all categories zero") }
	if(is.null(y.max)){ ylim <- c(0, yr+(yr/10)) }else{ ylim <- c(0, y.max+(y.max/10)) }
	
	
	# axis label
	if(is.null(xlab)){
		xlab <- paste( deparse(substitute(x)), collapse="" )	#extract data name
		xlab.len <- nchar(xlab)
		if(xlab.len>20){ xlab <- paste(substr(xlab, start=1, stop=20),".. ; ") }	#restrict length of name to 20
	}
	if(!norm){ ylab="counts" }else if(norm){ ylab="frequency" }
	#cat("\n x.lev",x.lev," x.lev.anz ",x.lev.anz," xlim ",xlim," ylim ",ylim)
	
	# create plot window
	plot(c(0,0), c(0,0), type="n", xlim=xlim, ylim=ylim, axes=F, xlab=xlab, ylab=ylab, cex=cex)
	
	# x axis
	axis(1, at=x.at, labels=erg[,2], cex=cex, las=0 )
	# y axis
	if(is.null(y.at)){
		tmp <- c(0, ylim[2]/2, ylim[2])
		axis(2, at=tmp, labels=paste(round(tmp,digits=digits),sep=""), adj=0.5, cex.axis=cex)
	}else{
		axis(2, at=y.at, labels=y.at, adj=0.5, cex.axis=cex)
	}
	
	# process bar plot
	for(i in 1:x.lev.anz){							# number of bins
		if(erg[i,1]!=0){							# only make bar if bin != 0
			plot.bar.point.segment(
					x=i,
					height=erg[i,1],				# counts
					width=bar.width,				# bar width
					col=col,
					density=-1,
					horiz=F,
					at=0,
					lwd=0.1,
					type="bar")
		}
	}
	
	if(h.title!=""){
		mtext(text=h.title, line=2, side=3, cex=0.9)
	}
	mtext(text=paste("Total counts (area) of histogram : ",dist.area,sep=""), line=1, side=3, cex=0.7)
	return(erg)
}


## a:8 b:7 d:6 e:2 f:1
#a <- c("a","b","d","a","b","d","a","b","f","a","b","d","a","b","e","a","e","d","a","b","d","a","b","d")
#a <- c("1","2","1","1","3","3")
#a <- c("1","2","3")
#a <- c("0.1","0.2","0.3")
#a <- c("0.1","0.1","0.1")
#a <- c("0.1")
#a <- as.character(c(0.1))
#a <- c(0.1)

#hist.plot.categorical(a, exclude.categorical=NULL, dsort=NULL, xlab=NULL,
#		y.max=NULL, y.at=NULL, norm=F,
#		bar.width=0.9, digits=2, col="blue", cex=1, h.title="test vector")