# TODO: Add comment
# 
# Author: E.Korsching, 01.2024
###############################################################################


chromosome.regions.1 <- function(
		x=NULL,		# --or-- data.frame with one col - for side graph - id in row names
		z=NULL,		# --or-- data.frame i.e. genes - no row names
		z.id="hgnc",	# "hgnc" symbol or "zid" row names id for labels in graph
		y,				# data frame chromosome, start region, end region
		ginX,			# cn,SNP chip annotations  - id in row names
		ginZ,			# NULL --or-- Expression chip annotations  - id in row names
		cyto,			# Cytobanding values, data.frame with Chromosome,Physical.Position,Cytoband label
		Chromosome.data,		# data.frame: min. 6 cols - named: "chr", "start","end","cen_start","cen_end","cen_name"
		plottype="bar",			# bar,point,segment
		xrange=6,				# range to the right of the ideogram for labels,bar graph
		xat=c(1.5,3,3.5,4),		# vec - 1-2: cn,SNP range, 2-4: gene names label
		axes=F,
		chr.width=0.6,				# width of chromosome ideogram, 0-width, corresponds with xat[1]
		color.chr.outline="black",	# outline
		color.chr.content=c("gray45","gray65"),	# cyto
		color.anno.lines="red",		# genes
		color.bps="blue",			# cn,SNP
		cex=0.6,					# font size
		mfrow=c(2, 2),			# layout for all ideograms (or 1,1)
		Range.Label=T,				# left labels: T:chr range F:cyto labels
		g.lab.diff=40000,			# distance gene labels
		delta.label=20000,			# distance cytoband labels
		main						# a top header line - if not given some data names will be used
)
{
	# regions of chromosomes only
	# give a list of genes of interest and a sequence range around these genes
	#  very similar in the workflow to  ideogram.genome.3.R  and in data structures to  ideogram.info.txt
	#   see also  above at the parameters  +  below in the definitions
	
	## ini
	a.par <- par(no.readonly=TRUE)		# keep parameters
	source("../0functions/0general/color.set.R")
	source("../0functions/0general/plot.bar.point.segment.R")
	source("../0functions/0general/is.even.R")
	
	# constants
	linsym <- 0.2			# gene line end to symbol distance
	top.quo <- 15			# divisor for h.space
	# def for Chromosome.data
	chrd_2 <- "start"			# chr
	chrd_3 <- "end"				# chr / length of chr
	chrd_4 <- "cen_start"		# centromer position		maybe calc mean value
	chrd_5 <- "cen_end"			# centromer position		maybe calc mean value
	# def cyto
	cyto_1 <- "band"				# cyto band
	cyto_2 <- "chromosome_name"		# chr 1..
	cyto_3 <- "start_position"		# start
	cyto_4 <- "end_position"		# end
	# def ginX
	ginX_2 <- "Chromosome"			# chr 1..
	ginX_3 <- "Physical.Position"	# start
	chrstart <- 1					# EBI 1, UCSC 0
	# def ginZ
	Gene.Symbol <- "hgnc_symbol"	# id:ENST/ENSG in row names
	# def z
	z_1 <- "ensembl_gene_id"		# id:ENST,ENSG in column		"ensembl_transcript_id"
	z_2 <- "chromosome_name"		# chr - int(!), not used in y2
	z_3 <- "start_position"			# start							"transcript_start"
	z_4 <- "end_position"			# end							"transcript_end"
	# def y
	y_2 <- "chromosome_name"		# chr - int(!)
	y_3 <- "region_start"			# start
	y_4 <- "region_end"				# end
	
	par(mfrow=mfrow, mar=c(2, 0.1, 1, 0.1))		# check axis scale 2,3,1,1 , normal 2,0.1,1,0.1
	
	if(is.null(x)){ xat[2:4] <- xat[2:4]-xat[1] }		# adjust 2-4
	
	# x scaling of the plot area(s) <-> mfrow
	xlim <- c(-2, xrange + 1)
	
	loops <- nrow(y)
	
	## region loop
	for(i in 1:loops) {
		cat("\nloop ",i)
		chr.x <- y[i, y_2]
		
		# y scaling of the plot area, max-min
		dPP <- y[i, y_4]-y[i, y_3]
		h.space <- dPP / top.quo
		ylim <- c(h.space+y[i, y_4], y[i, y_3]-h.space)		# graphical outcome: top: start-h.space, bottom: end+h.space
		
		# overlap centromere
		centrostart <- F; centroend <- F
		if( Chromosome.data[chr.x, chrd_4]>=y[i, y_3] & Chromosome.data[chr.x, chrd_4]<=y[i, y_4] ){
			centrostart <- T
			ylow <- Chromosome.data[chr.x, chrd_4]
		}	# lower line
		if( Chromosome.data[chr.x, chrd_5]>=y[i, y_3] & Chromosome.data[chr.x, chrd_5]<=y[i, y_4] ){
			centroend <- T
			yup <- Chromosome.data[chr.x, chrd_5]
		}	# upper line
		
		## define graph area - blank plot
		plot(0, 0, type="n", xlim=xlim, ylim=ylim, axes=axes, xlab="", ylab="")
		
		## plot side graphs
		# plot i.e. cn,SNP
		if(!is.null(x)){
			# y: pp  x: x.pp
			pprn <- row.names(ginX[ ginX[, ginX_2]==chr.x & ginX[, ginX_3]>=y[i, y_3] & ginX[, ginX_3]<=y[i, y_4] , ginX_3, drop=F])
			pp <- ginX[ ginX[, ginX_2]==chr.x & ginX[, ginX_3]>=y[i, y_3] & ginX[, ginX_3]<=y[i, y_4] , ginX_3]
			xpp <- x[pprn, ]
			xpp.l <- length(xpp)
			
			if(plottype == "segment"){ xpp.l <- xpp.l - 1 }	#muss 1 frueher aufhoeren wg. j+1
			for(j in 1:xpp.l) {
				ywidth <- 1
				plot.bar.point.segment(x=pp[j], x2=pp[j+1], height=xpp[j], height2=xpp[j+1], width=ywidth,
						col=color.bps, bcol=color.bps, density=-1, horiz=T, at=xat[1], lwd=0.2, type=plottype)
				# x2,height2 only segment, bar,point: x:height+at y:x,width
			}
		}
		
		## plot i.e. gene names
		if(!is.null(z)){
			#plot line-physical position, plot connection line, plot gene name
			# filter auf gene on chr+position
			y2 <- z[z[, z_2]==chr.x & z[, z_3]>=y[i, y_3] & z[, z_4]<=y[i, y_4], ]		
			y2 <- y2[!is.na(y2[, z_3]),]	# remove rows with NA in physical position - start; y2 is matrix
			y2 <- y2[order(y2[, z_3]),]		# order start positions ascending
			
			if(dim(y2)[1]==1){		# one gene label
				# simplified plotting
				segments(xat[2], y2[1, z_3], xat[4], y2[1, z_3], col=color.anno.lines)		#x0,y0,x1,y1  long line
				# y2 return value must be char
				if(z.id=="hgnc"){
					if(ginZ[y2[1, z_1], Gene.Symbol]==""){
						text(xat[4]+0.2, y2[1, z_3], y2[1, z_1], adj=0, cex=cex)
					}else{
						text(xat[4]+0.2, y2[1, z_3], ginZ[y2[1, z_1], Gene.Symbol], adj=0, cex=cex)
					}
				}
				if(z.id=="zid"){
					text(xat[4]+0.2, y2[1, z_3], y2[1, z_1], adj=0, cex=cex)
				}
			}
			if(dim(y2)[1]>1){		# 2 and more gene label
				nry2 <- nrow(y2)
				y3 <- vector(mode="numeric", length=nry2)
				for(j in 1:nry2){		#plot positions
					segments(xat[2], y2[j, z_3], xat[3], y2[j, z_3], col=color.anno.lines)		#x0,y0,x1,y1  shorter line
				}
				y3 <- y2[, z_3]		# start with real positions
				for(j in 1:(nry2-1)){		#adjust positions
					if((y3[j+1]-y3[j]) < g.lab.diff){		# calculate differences and test
						y3[j+1] <- y3[j] + g.lab.diff		# new position
					}
				}
				if(y3[nry2]>y2[nry2, z_3]){		# center new positions according mid of positions
					cMove <- (y3[nry2]-y2[nry2, z_3])/2
					for(j in 1:nry2){		#adjust positions
						y3[j] <- y3[j] - cMove		# new position
					}
				}
				for(j in 1:nry2){		#plot segment and text
					segments(xat[3], y2[j, z_3], xat[4], y3[j], col=color.anno.lines)		#x0,y0,x1,y1  kink
					# y2 return value must be char
					if(z.id=="hgnc"){
						if(ginZ[y2[j, z_1], Gene.Symbol]==""){
							text(xat[4]+linsym, y3[j], y2[j, z_1], adj=0, cex=cex)
						}else{
							text(xat[4]+linsym, y3[j], ginZ[y2[j, z_1], Gene.Symbol], adj=0, cex=cex)
						}
					}
					if(z.id=="zid"){
						text(xat[4]+linsym, y3[j], y2[j, z_1], adj=0, cex=cex)
					}
				}
			}
		}
		
		## plot chromosome cyto band
		# split for chromosome and given region range
		cyto.1 <- cyto[ cyto[, cyto_2]==chr.x & cyto[, cyto_3]>=y[i, y_3] & cyto[, cyto_3]<=y[i, y_4] &
						cyto[, cyto_4]>=y[i, y_3] & cyto[, cyto_4]<=y[i, y_4] , ]		# cyto for banding of the outline
		
		cyto.list <- split(cyto.1, cyto.1[, cyto_1])				#split for cyto band
		cyto.len <- length(cyto.list)
		pos.vec <- vector(mode="numeric", length=cyto.len)			#for axis ticks
		label.vec <- vector(mode="character", length=cyto.len)		#for axis labels
		for(j in 1:cyto.len){
			cyto.min <- min(cyto.list[[j]][, cyto_3])
			cyto.max <- max(cyto.list[[j]][, cyto_4])
			if(is.even(j)){
				polygon(c(0,chr.width,chr.width,0), c(cyto.max,cyto.max,cyto.min,cyto.min), density=-1, col=color.chr.content[1], border=NA)# interior  ,lwd=lwd
			}else{
				polygon(c(0,chr.width,chr.width,0), c(cyto.max,cyto.max,cyto.min,cyto.min), density=-1, col=color.chr.content[2], border=NA)# interior
			}
			pos.vec[j] <- cyto.min+((cyto.max-cyto.min)/2)			#place label half way min max
			label.vec[j] <- cyto.list[[j]][1, cyto_1]				#pick first label - all in list block are identical
		}
		# if pos.vec positions are too narrow (parameter: delta.label) discard one label
		if(cyto.len>1){
			pos.vec.info <- vector(mode="logical",length=cyto.len)	# all F
			k <- 0
			for(j in cyto.len:2){
				if(abs(pos.vec[j]-pos.vec[j-1]) < delta.label){					#skip one label if too narrow
					if(k==1){ k <- 0 }else{ pos.vec.info[j] <- T; k <- 1 }
				}else{
					k <- 0
				}
			}
			pos.vec <- pos.vec[!pos.vec.info]		# note: not ordered positions
			label.vec <- label.vec[!pos.vec.info]
		}
		
		## plot outline
		# xat=c(1.5,3,3.5,4) chr.width=0.6
		x0 <- 0
		x1 <- chr.width
		a <- c(x0, x1, x1, x0)
		b <- c(y[i, y_3], y[i, y_3], y[i, y_4], y[i, y_4])
		polygon(a, b, density=0, border=color.chr.outline)
		if(centrostart){ segments(-0.1, ylow, chr.width+0.1, ylow, col="chartreuse3", lwd=1.4) }
		if(centroend){ segments(-0.1, yup, chr.width+0.1, yup, col="steelblue2", lwd=1.4) }
		
		# plot labels on the left side and the lables at the bottom
		#  decide chromosome length ticks -or- label of cytoband
		if(Range.Label){
			ci <- c(y[i, y_3], y[i, y_4])	# <-> ylim
			labels <- c(paste(round(ci[1:2]/1000000.), "Mb"))
			axis.2.at <- ci
			text(x=-0.2, y=axis.2.at, labels=labels, adj=c(0.5,0), cex=cex, srt=90)
		}else{
			labels <- label.vec
			axis.2.at <- pos.vec
			text(x=-0.2, y=axis.2.at, labels=labels, adj=1, cex=cex, srt=0)
		}
		
#		if(!is.null(x)){	# e.g. for cn
#			tmp <- xat[1] + (xat[2]-xat[1])/2
#			axis(1, at=c(xat[1], tmp, xat[2]), labels=c("-", "0", "+"))
#			abline(v=tmp, col=color.chr.content[2])
#		}
		if(!is.null(x)){ txt <- paste("\nChr.", chr.x, "\nn:", length(pp)) }else{ txt <- paste("\nChr.", chr.x) }
		
		if(as.integer(chr.x)==23){ if(!is.null(x)){ txt <- paste("\nChr. X\nn:", length(pp)) }else{ txt <- paste("\nChr. X") } }
		if(as.integer(chr.x)==24){ if(!is.null(x)){ txt <- paste("\nChr. Y\nn:", length(pp)) }else{ txt <- paste("\nChr. Y") } }
		if(as.integer(chr.x)==25){ if(!is.null(x)){ txt <- paste("\nChr. Mitochondrine\nn:", length(pp)) }else{ txt <- paste("\nChr. Mitochondrine") } }
		mtext(text=txt, side=1, line=0.9, cex=cex+0.2, adj=0) #portrait / landscape dependend
	}# for chr i
	
	# finish
	par(fig = c(0, 1, 0, 1))		#discard existing plot layout - creating a new plot area on the existing device
	par(usr = c(0, 1, 0, 1))		#user coordinates
	if(missing(main)) {
		main <- paste( if(!is.null(x)){ deparse(substitute(x)) }, if(!is.null(z)){ deparse(substitute(z)) } ,sep=" ")
	}
	mtext(main, side=3, line=0, cex=cex+0.2)
	
	# restore parameters & colors
	par(a.par)
	return()
}