# TODO: Add comment
# 
# Author: E.Korsching  11-2016
###############################################################################



#### sampling cor coefficient, including cor test p value

#### fold a vector/matrix to a lower diagonal matrix representation



calc.each.cor.shuff.comb <- function(x, n, sampling.method="shuffling"){
	# get a df or matrix, calculate col wise all Pearson cor combinations and the respective shufflings (n)
	# sampling.method: "shuffling", "bootstrap"
	nr <- nrow(x)
	nc <- ncol(x)
	erg <- matrix(0,(nc*nc-nc)/2,5)
	colnames(erg) <- c("estimate","p","mean of sample estimate","sd of sample estimate","mean of sample p")
	k <- 1
	for(i in 1:(nc-1)){
		for(j in (i+1):nc){
			erg[k,] <- shuffling.cor.value(x=x[,i],y=x[,j], n=n, sampling.method=sampling.method)
			k <- k+1
		}
	}
	return(erg)
}


#aa <- calc.each.cor.shuff.comb(x=p2.cnv.tma.c[,c(11:16,17:19)], n=10, sampling.method="shuffling")




shuffling.cor.value <- function(x,y, n=100, sampling.method="shuffling"){
	# calculate a shuffling mean correlation coefficient, sd of coeff., mean p value
	#  shuffling is done column wise
	# x: var1 y: var2
	# n: number of shufflings
	# sampling.method: "shuffling" permutation (without replacement) , "bootstrap" (with replacement)
	
	if(sampling.method=="shuffling"){ replace=F }else{ replace=T }
	# calculate real values
	z <- cor.test(x=x, y=y, alternative="two.sided", method="pearson")		# "kendall", "spearman"
	z.r <- z$estimate
	z.p <- z$p.value
	# sampling cor value
	zdx <- vector("numeric",length=n)
	zdy <- vector("numeric",length=n)
	zz <- data.frame(matrix(0,n,2))
	names(zz) <- c("sampling.estimate","sampling.p")
	for(i in 1:n){
		zdx <- sample(x, replace=replace)
		zdy <- sample(y, replace=replace)
		# calculate sample values
		z <- cor.test(x=zdx, y=zdy, alternative="two.sided", method="pearson")		# "kendall", "spearman"
		zz[i,1] <- z$estimate
		zz[i,2] <- z$p.value
	}
	# calculate mean estimate & mean p & sd estimate
	s.r <- mean(zz[,1])
	s.r.sd <- sd(zz[,1])
	s.p <- mean(zz[,2])
	
	# estimate - p - sample estimate mean - sample estimate sd - sample p mean
	out <- c(z.r,z.p,s.r,s.r.sd,s.p)
	return(out)
}


#shuffling.cor.value(x=c(1,3,2,2),y=c(4,3,1,3), n=10, sampling.method="shuffling")




fold.vector.below.diag <- function(x, cnames=NULL){
	# assume a vector or matrix where the row number is fitting in a quadratic matrix
	# if a matrix is given all matrix row elements will be concatenated  by "\n"
	if(is.vector(x)){ xlen <- length(x) }else{ xlen <- nrow(x); nc <- ncol(x) }
	# size of matrix
	i <- T
	k <- 1
	leg <- xlen
	while(i){
		k <- k+1
		if(leg==(k*k-k)/2){ i <- F }
		if(k>xlen){ i <- F; stop("stop - not resulting in a quadratic matrix") }
	}
	# concatenate
	if(exists("nc", where=-1)){
		x <- apply(x, 1, paste, collapse="\n")
	}
	
	erg2 <- matrix(NA,k,k)
	if(is.null(cnames)){ colnames(erg2) <- paste(seq(1,k),sep="") }else{ colnames(erg2) <- cnames }
	
	l <- 1
	for(i in 1:(k-1)){
		for(j in (i+1):k){
			erg2[j,i] <- x[l]
			l <- l+1
		}
	}
	return(data.frame(erg2))
}


#fold.vector.below.diag(x=c(1,2,3))
#fold.vector.below.diag(x=c(1,2,3), cnames=c("a","b","c"))
#fold.vector.below.diag(x=matrix(c(1,2,3,4,5,6,7,8,9),3,3), cnames=c("a","b","c"))