# TODO: Add comment
# 
# Author: E.Korsching  2024
###############################################################################



#### condense complex results to table
# introduce two summarizing final coefficients:
# 1) linear model coefficient [slope]
# 2) normalized correlation score

# summary: ssqg , g.score : specific for the groups situation, g.score even normalized
# sys.local: ssq , lm.s , l.score : values specific for factor combinations

lin.mod.coef <- function(x){
	# calculate linear model coefficient from correlation coefficient table or L2 table
	# x: vector
	aeqdv <- 1:length(x)
	slope <- abs( linfit.ab(aeqdv, x)[[2]] )	# lin.mod.coef
	return(slope)
}

generalized.score <- function(x, lim){
	# score from vector of connceted proximity values
	# x: vector,  lim: upper limit: cor: 1, L2: 2
	x.l <- length(x)
	x1 <- sum(abs(x/x.l))	# normalized on n, sum for generalizing, abs for cor
	if(x1>lim){ warning("Out of limits") }
	return(x1)
}

prox.norm <- function(x){
	# norm values of connceted proximity values
	# x: vector
	x.l <- length(x)
	x1 <- x/x.l		# normalized on n
	return(x1)
}


results2table <- function(exp.name, prox.tab, sel.order, method="Pearson"){
	# generate a final result table with core parameters
	# exp.name: a short but distinct name for the experimental condition
	# prox.tab: proximity table
	# sel.order: order of interest
	# method: "Pearson", "L2"
	nr <- nrow(prox.tab)
	nc <- ncol(prox.tab)
	if(method=="Pearson"){ m <- 1 }else{ m <- 2 }
	# order
	prox.tab <- prox.tab[sel.order, ]
	nrn <- dimnames(prox.tab)[[1]]
	ncn <- dimnames(prox.tab)[[2]]
	
	sys.test <- data.frame(matrix(0, nr, 2*nc))
	dimnames(sys.test)[[1]] <- nrn
	dimnames(sys.test)[[2]] <- rep(c("residuals","prox.norm"), nc)
	k <- 1
	for(i in seq(1, 2*nc, 2)){
		sys.test[ ,i] <- linfit.ab(1:nr, prox.tab[,k])[[4]]		# residuals
		sys.test[ ,(i+1)] <- prox.norm(prox.tab[,k])	# proximity normalization
		k <- k+1
	}
	
	sys.local <- data.frame(matrix(0, nc, 3))
	dimnames(sys.local)[[1]] <- ncn
	dimnames(sys.local)[[2]] <- c("ssq","lm.s","l.score")
	for(i in 1:nc){
		sys.local[i, 1] <- linfit.ssq(1:nr, prox.tab[,i])		# ssq
		sys.local[i, 2] <- lin.mod.coef(prox.tab[,i])		# slope
		sys.local[i, 3] <- generalized.score(prox.tab[,i], lim=m)	# l.score
	}
	
	sys.global <- data.frame(matrix(0, 1, 2))
	dimnames(sys.global)[[1]] <- exp.name
	dimnames(sys.global)[[2]] <- c("ssqg","g.score")
	sys.global[1, 1] <- sum(sys.local[ ,1])		# ssqg
	sys.global[1, 2] <- generalized.score(sys.local[ ,3], lim=m)		# g.score, again generalized by n
	return(list(summary=sys.global, sys.local=sys.local, sys.test=sys.test))
}

#aa <- results2table(exp.name="test.bb1", prox.tab=bb1[[3]], sel.order=bb1[[2]][bb1[[4]], ], method="Pearson")
#aa <- results2table(exp.name="h.bp1.01.a", prox.tab=h.bp1.01.a[[3]], sel.order=h.bp1.01.a[[1]][, 2:6], method="Pearson")


pdf.results2table <- function(x, path.fileprefix="", title=""){
	# write all list elements to pdf page(s)
	# based on write2pdf()
	# x: list( of list(s) ) according to output of results2table()
	xlen <- length(x)
	pdf(file=paste(path.fileprefix,".",format(Sys.time(), "%Y%m%d%H%M"),".pdf", sep=""),
			paper="a4", width=7, height=11, title="test", pointsize=10)	# a4,a4r
	par(family="NimbusMon",font=2)	# mono,NimbusMon,ArialMT
	
	for(i in 1:xlen){
		# text, vertical position, indent
		aaa <- NULL; aaz <- 1; aai <- 1	# content, real line counter, matrix counter
		aaa <- rbind(aaa, c(paste(title," ",dimnames(x[[i]]$summary)[[1]],collapse=""), aaz, 0) )
		aaz <- aaz+2; aai <- aai+1	# empty line
		aaa <- rbind(aaa, c(paste("Global systemic scores (summary)",collapse=""), aaz, 0) )
		aaz <- aaz+1; aai <- aai+1
		aaa <- rbind(aaa, c(paste(dimnames(x[[i]]$summary)[[2]],collapse=", "), aaz, 0) )
		aaz <- aaz+1; aai <- aai+1
		aaa <- rbind(aaa, c(paste(round(x[[i]]$summary[1,],2),collapse=" "), aaz, 0) )
		aaz <- aaz+2; aai <- aai+1	# empty line
		aaa <- rbind(aaa, c(paste("Optimal, nomalized local systemic scores (sys.local)",collapse=""), aaz, 0) )
		aaz <- aaz+1; aai <- aai+1
		aaa <- rbind(aaa, c(paste(dimnames(x[[i]]$sys.local)[[2]],collapse=", "), aaz, 0) )
		aaz <- aaz+1; aai <- aai+1
		aan <- rownames(x[[i]]$sys.local)
		for(j in 1:nrow(x[[i]]$sys.local)){
			aaa <- rbind(aaa, c(paste(paste(round(x[[i]]$sys.local[j,],2),collapse=" "),aan[j],sep="   "), aaz, 0) )
			aaz <- aaz+1; aai <- aai+1
		}
		aaz <- aaz+1	# empty line
		aaa <- rbind(aaa, c(paste("Best order (sys.test)",collapse=""), aaz, 0) )
		aaz <- aaz+1; aai <- aai+1
		aan <- rownames(x[[i]]$sys.test)
		aaa <- rbind(aaa, c(paste(aan,collapse=" "), aaz, 0) )
		write2PDF(aaa, add=F, col="black", cex=0.7, txt.lines=40, txt.width=50)
	}
	dev.off()
	return()
}


dfs.results2table <- function(x){
	# unify all list elements of the same type to one list
	#  restricted to "summary" and "sys.local"
	# x: list( of list(s) ) according to output of results2table()
	xlen <- length(x)
	s.n <- dimnames(x[[1]]$summary)[[2]]
	s.df <- data.frame(matrix(0,1,length(s.n)))
	dimnames(s.df)[[2]] <- s.n
	l.n <- dimnames(x[[1]]$sys.local)[[2]]
	l.df <- data.frame(matrix(0,1,length(l.n)))
	dimnames(l.df)[[2]] <- l.n
	for(i in 1:xlen){
		s.df <- rbind(s.df, x[[i]]$summary)
		l.df <- rbind(l.df, x[[i]]$sys.local)
	}
	s.df <- s.df[-1,]
	l.df <- l.df[-1,]
	return(list(summary=s.df, sys.local=l.df))
}

#a <- dfs.results2table(list(h.bp1.01.a.tab,h.bp1.01.c.tab))


#save.image()