# TODO: Add comment
# 
# Author: E.Korsching  07-2026
###############################################################################



#options(width=160)


# normalization approach

# overall: this idea is not working--
#
# except in very simple cases (see example)



synchro.sample.set <- function(x, agreement=0.3, ci=0.01, step.size=0.01, thr=10){
	# synchronise samples -- similar library size
	# x: samples in a data.frame or matrix
	#    columns: experiments, rows: factors e.g. genes
	# agreement: [0..1] how many factors need to be on the same level
	# ci: [0..| intervall of agreement (ci*factor.expression)
	# step.size: [0..| increment factor (experiment*(1+step.size++))
	# thr: threshold for normalization (index creation & value multiplication)
	source("../0functions/rank/rank.ek.R")
	source("../0functions/0general/test.zero.R")
	
	nc <- ncol(x)		# number of experiments
	nr <- nrow(x)		# number of factors, uniqueness assumed
	cat("\ndim: rows", nr, "columns", nc)
	# discarding all negative factors and non-informative experiments
	core.set <- synchro.sample.set.1(x, nr, nc)
	x <- x[core.set$row.i, core.set$col.i]
	# renew
	nc <- ncol(x)
	nr <- nrow(x)
	cat("\nadjusted dim: rows", nr, "columns", nc)
	for(i in 1:nc){
		x[,i] <- round(x[,i], 0)
	}
	y <- matrix(0, nr, nc)
	dimnames(y)[[1]] <- dimnames(x)[[1]]
	dimnames(y)[[2]] <- dimnames(x)[[2]]
	# comparative analysis of the column ranks
	caca <- matrix.rank.order.analysis(x)
	# select reference column for adjustment
	coli <- synchro.sample.set.2(x)
	coli.sum <- sum(x[,coli])	# break criteria for iteration if 'agreement' is not achived in sub-set
	cat("\nreference column at position", coli, " sum", coli.sum)
	not.coli <- if(coli>1){ c(1:(coli-1), (coli+1):nc) }else{ c((coli+1):nc) }
	# create sub-index of the reference which should be used in the normalization, thr based
	idx <- synchro.sample.set.3(x=x[,coli], nr=nr, thr=thr)
	idxl <- length(idx)
	g.ee <- round( idxl * agreement )		# number of factors assumed to be constant
	cat("\nagreement on ", g.ee, " of ", idxl, " factors, test: >= agreement")
	# confidence matrix of reference
	c.mat <- synchro.sample.set.4(x=x[,coli], nr=nr, ci=ci)
	
	a <- T
	sts <- 1 + step.size
	
	for(i in not.coli){		# per experiment
		cat("\n\ncolumn",i)
		iter <- 1
		inp2 <- x[, i]
		while(a){
			# test situation
			tmp <- synchro.sample.set.5(x=inp2, y=c.mat, id=idx, nr=nr)
			# decision
			cat("\n",iter," median",tmp[[1]]," agreement",tmp[[2]], " ref. row(s)",tmp[[3]])
			if(tmp[[2]]>=g.ee){
				y[,i] <- round(inp2, 0)
				break
			}else{
				# iterate
				inp2[inp2>thr] <- inp2[inp2>thr] * sts	# multiply again, thr based
				# break criteria if 'agreement' is not achived in sub-set (alternative: criteria library size)
				if(coli.sum<=sum(inp2)){
					y[,i] <- round(inp2, 0)
					cat("\nbreak")
					break
				}
				iter <- iter + 1
			}
		}
	}
	# add reference
	y[,coli] <- x[,coli]
	# comparative analysis of the column ranks
	cacb <- matrix.rank.order.analysis(y)
	cat("\n")
	return(list(norm=y, start=x, rankA=caca[[2]], rankB=cacb[[2]]))
}

#a1 <- synchro.sample.set(x=a, agreement=0.3, ci=0.05, step.size=0.1, thr=1)




synchro.sample.set.1 <- function(x, nr, nc){
	# subfunction - extract core/driver subset
	# x: whole matrix,  nr,nc: number of rows, columns
	r.i <- 1:nr		# row index
	c.i <- 1:nc		# column index
	# remove all '0' rows
	a <- apply(x,1,sum)
	r.i.1 <- r.i[!(a==0)]
	
	# remove columns with max(cell counts) <= 10
	a <- apply(x[,c.i],2,max)
	c.i.1 <- c.i[!(a<=10)]
	#return(list(row.i=r.i.1, col.i=c.i.1, sub=x[r.i.1,c.i.1]))
	return(list(row.i=r.i.1, col.i=c.i.1))
}

#a <- synchro.sample.set.1(n.bladd, nr=2653, nc=34)
#count.zero.cols(a$sub)
#apply(a$sub,2, sum)
#apply(a$sub,2, max)


synchro.sample.set.2 <- function(x){
	# subfunction - extract core/driver subset
	# x: whole matrix,  nr,nc: number of rows, columns
	x.m <- apply(x, 2, max)
	# max values in a column, original column index, number of zeros in a column
	x.mi <- data.frame(x.m=x.m, idx=1:length(x.m), zero=count.zero.cols(x))
	xmi.o <- x.mi[order(x.mi[,1], decreasing=T),]
	# check
	if(length(unique(x.m)) < length(x.m)){
		cat("\n#ties ",length(x.m)-length(unique(x.m)))
		cat("\nmax : ",xmi.o[,1])
	}
	# return column index with a 'more' minimal zero value
	xmi.ci <- xmi.o[ first.loc.min(unlist(xmi.o[,3])), 2]
	return(xmi.ci)
}

#a4 <- synchro.sample.set.2(a$sub)
#range(a3[,3]); hist.plot.color(a3[,3], bin.num=10, xlab="", ylab="", col.f="blue")


synchro.sample.set.3 <- function(x, nr, thr){
	# subfunction - sub-index of reference for normalization
	# x: reference (column as vector)
	idx <- c(1:nr)
	# cells to be considered have higher values than the threshold
	idl <- x>thr
	id <- idx[idl]
	return(id)
}

#synchro.sample.set.3(c(1,20,3,10,11), 5)


synchro.sample.set.4 <- function(x, nr, ci){
	# subfunction - confidence matrix for reference
	# x: reference (column as vector), ci: factor to calulate range
	mat <- matrix(0, nr, 3)
	dimnames(mat)[[2]] <- c("lower","upper","d.div.2")
	for(i in 1:nr){
		d <- x[i]*ci
		mat[i,1] <- x[i] - d
		mat[i,2] <- x[i] + d
		mat[i,3] <- (mat[i,2] - mat[i,1]) /2	# (upper-lower)/2
	}
	return(mat)
}


synchro.sample.set.5 <- function(x, y, id, nr){
	# subfunction - test all fits to the reference
	# x: column in adjustment, y: reference target intervals
	x.m <- median(as.numeric(x))
	idl <- length(id)
	mat <- matrix(0, idl, 2)
	dimnames(mat)[[1]] <- paste(id, sep="")
	dimnames(mat)[[2]] <- c("in","location")
	for(i in 1:idl){
		if(x[id[i]]>y[id[i],1] & x[id[i]]<y[id[i],2]){
			mat[i,1] <- 1
			mat[i,2] <- (x[id[i]]-y[id[i],1])-y[id[i],3]	# not used
		}
	}
	act.id <- id[mat[ ,1]==1]
	act.s <- sum(mat[ ,1])
	return(list(act.med=x.m, act.g.ee=act.s, act.id=act.id))
}






#### second version - primarily library size based
# we do not want to normalize the noise instead only the informative measurements
# split a) 0 to threshold (default 10 counts) [ do not touch this but cinsider in b) ]
# b) threshold to max


synchro2.sample.set <- function(x, thr=10){
	# synchronise samples - same library size
	# x: samples in a data.frame or matrix
	#    columns: experiments, rows: factors e.g. genes
	# thr: threshold for normalization (0-thr, thr-max)
	
	nc <- ncol(x)		# number of experiments
	nr <- nrow(x)		# number of factors, uniqueness assumed
	cat("\ndim: rows", nr, "columns", nc)
	# discarding all negative factors and non-informative experiments
	core.set <- synchro2.sample.set.1(x, nr, nc)
	x <- x[core.set$row.i, core.set$col.i]
	# renew
	nc <- ncol(x)
	nr <- nrow(x)
	cat("\nadjusted dim: rows", nr, "columns", nc)
	for(i in 1:nc){
		x[,i] <- round(x[,i], 0)
	}
	# comparative analysis of the column ranks
	caca <- matrix.rank.order.analysis(x)
	# select reference column for adjustment
	coli <- synchro2.sample.set.2(x)
	coli.sum <- sum(x[,coli])	# break criteria for iteration
	cat("\nreference column at position", coli, " sum", coli.sum)
	not.coli <- if(coli>1){ c(1:(coli-1), (coli+1):nc) }else{ c((coli+1):nc) }
	# split & normalize
	y <- synchro2.sample.set.3(x, coli=coli, not.coli=not.coli, nr=nr, nc=nc, thr=thr)
	y[,coli] <- x[,coli]
	# comparative analysis of the column ranks
	cacb <- matrix.rank.order.analysis(y)
	cat("\nsums ", apply(y,2,sum))
	cat("\n")
	return(list(norm=y, start=x, rankA=caca[[2]], rankB=cacb[[2]]))
}

#a1 <- synchro2.sample.set(x=a, thr=10)




synchro2.sample.set.1 <- function(x, nr, nc){
	# subfunction - extract core/driver subset
	# x: whole matrix,  nr,nc: number of rows, columns
	r.i <- 1:nr		# row index
	c.i <- 1:nc		# column index
	# remove all '0' rows
	a <- apply(x,1,sum)
	r.i.1 <- r.i[!(a==0)]
	
	# remove columns with max(cell counts) <= 10
	a <- apply(x[,c.i],2,max)
	c.i.1 <- c.i[!(a<=10)]
	#return(list(row.i=r.i.1, col.i=c.i.1, sub=x[r.i.1,c.i.1]))
	return(list(row.i=r.i.1, col.i=c.i.1))
}


synchro2.sample.set.2 <- function(x){
	# subfunction - extract core/driver subset
	# x: whole matrix,  nr,nc: number of rows, columns
	x.m <- apply(x, 2, max)
	# max values in a column, original column index, number of zeros in a column
	x.mi <- data.frame(x.m=x.m, idx=1:length(x.m), zero=count.zero.cols(x))
	xmi.o <- x.mi[order(x.mi[,1], decreasing=T),]
	# check
	if(length(unique(x.m)) < length(x.m)){
		cat("\n#ties ",length(x.m)-length(unique(x.m)))
		cat("\nmax : ",xmi.o[,1])
	}
	# return column index with a 'more' minimal zero value
	xmi.ci <- xmi.o[ first.loc.min(unlist(xmi.o[,3])), 2]
	return(xmi.ci)
}


synchro2.sample.set.3 <- function(x, coli, not.coli, nr, nc, thr){
	# subfunction - normalize
	# x: whole matrix,  nr,nc: number of rows, columns
	# coli,not.coli: reference index and the other indices
	y <- matrix(0, nr, nc)
	dimnames(y)[[1]] <- dimnames(x)[[1]]
	dimnames(y)[[2]] <- dimnames(x)[[2]]
	# reference sum
	ms <- sum(x[,coli])
	# adjust all other columns
	for(i in not.coli){
		mal <- x[,i]<=thr
		mbl <- x[,i]>thr
		ma <- sum(x[mal, i])
		mb <- sum(x[mbl, i])
		mi <- ms - ma
		f.m <- mi / mb
		y[mal, i] <- round(x[mal, i], 0)
		y[mbl, i] <- round( (x[mbl, i] * f.m), 0)
	}
	return(y)
}




save.image()