# R-code of the InvTseng, InvMod, RDWGL and GPA method
# Author: Martin Sill
###############################################################################

InvMod <- function(RG,pr,weights,p=0.99,pinvg=0.25,plot.chip=NULL,...){
	maxgenes <- length(pr)*pinvg
	MA <- MA.RG(RG,bc.method="none")
	for (i in 1:ncol(RG)){
		rd <- abs(rank(RG$R[pr,i])-rank(RG$G[pr,i]))
		invg <- pr[order(rd)[1:I(length(pr)*p)]]
		while(length(invg) > maxgenes){
			rd <- abs(rank(RG$R[invg,i])-rank(RG$G[invg,i]))
			invg <- invg[order(rd)[1:I(length(invg)*p)]]
		}
		rd <- abs(rank(RG$R[invg,i])-rank(RG$G[invg,i]))
		weights[invg,i] <- (max(rd)-rd)/max(rd)
		y <-  MA$M[,i]
		x <- MA$A[,i]
		w <- weights[,i]
		lfit <- loessFit(y,x,w,span=0.3,iterations=10)
		if(!is.null(plot.chip)){
			if(plot.chip==i){
				plot(MA$M[pr,i]~MA$A[pr,i],...)
				points(MA$A[invg,i],MA$M[invg,i],col="green")
				ord <- order(MA$A[,i])
				lines(MA$A[ord,i],lfit$fitted[ord],col="red")
				legend(x=12,y=0,legend=c("invariant","fitted"),pch = "HF",col=c("green","red"))
				title("InvMod")
			}
		}
		MA$M[,i] <- lfit$residuals
	}
	return(MA)	
}

invselTseng <- function(RG,pr,weights,p=0.02,lthr=5,plot.chip=NULL,...){
	G <- length(pr)
	MA <- MA.RG(RG,bc.method="none")
	for(i in 1:ncol(RG)){ 
		invg <-  pr[which(abs(rank(RG$R[pr,i])-rank(RG$G[pr,i]))< p*G &
								abs(rank(RG$R[pr,i]+RG$G[pr,i])/2)> lthr &
								abs(rank(RG$R[pr,i]+RG$G[pr,i])/2)< (G-lthr))]
		while(TRUE){
			inS <- length(invg)
			invg <-  invg[which(abs(rank(RG$R[invg,i])-rank(RG$G[invg,i])) < p*length(invg))]
			if(length(invg)==inS) break 
		}
		weights[invg,i] <- 1 
		y <-  MA$M[,i]
		x <- MA$A[,i]
		w <- weights[,i]
		lfit <- loessFit(y,x,w,span=0.3,iterations=10)
		if(!is.null(plot.chip)){
			if(plot.chip==i){
				plot(MA$M[pr,i]~MA$A[pr,i],...)
				points(MA$A[invg,i],MA$M[invg,i],col="green")
				ord <- order(MA$A[,i])
				lines(MA$A[ord,i],lfit$fitted[ord],col="red")
				legend(x=12,y=0,legend=c("invariant","fitted"),pch = "HF",col=c("green","red"))
				title("InvTseng")
			}
		}
		MA$M[,i] <- lfit$residuals
	}
	return(MA)	
}


RDWGL <- function(RG,pr,weights,plot.chip=NULL,...){
	MA <- MA.RG(RG,bc.method="none")
	for (i in 1:ncol(RG)){
		rd <- abs(rank(RG$R[,i])-rank(RG$G[,i]))
		weights[,i] <- (max(rd)-rd)/max(rd)
		y <-  MA$M[,i]
		x <- MA$A[,i]
		w <- weights[,i]
		lfit <- loessFit(y,x,w,span=0.3,iterations=10)
		if(!is.null(plot.chip)){
			if(plot.chip==i){
				plot(MA$M[pr,i]~MA$A[pr,i],...)
				ord <- order(MA$A[,i])
				lines(MA$A[ord,i],lfit$fitted[ord],col="red")
				legend(x=12,y=0,legend=c("fitted"),pch = "F",col=c("red"))
				title("RDWGL")
			}
		}
		MA$M[,i] <- lfit$residuals
	}
	return(MA)	
}

#GPA needs library vegan 
procrustesNormalization <- function(MA){   ###procrustes normalization
	#using median reference line###
	MA.proc <- list(M=NULL,A=NULL)
	
	MA.median <- list(M=NULL,A=NULL)
	MA.median$M <- apply(MA$M,1,median,na.rm=T)
	MA.median$A <- apply(MA$A,1,median,na.rm=T)
	A <- cbind(MA.median$A,MA.median$M)
	center.A <- apply(A,2,mean,na.rm=T)
	MA.proc <- list(M=NULL,A=NULL)
	
	for( j in 1:ncol(MA$M)){
		
		B <- cbind(MA$A[,j],MA$M[,j])
		out <- procrustes(A, B , scale=TRUE,symmetrix=FALSE,kind=1)
		MA.proc$M <- cbind(MA.proc$M, (out$Yrot[,2]+center.A[2]))
		MA.proc$A <- cbind(MA.proc$A, (out$Yrot[,1]+center.A[1]))
	}
	MA$A <- MA.proc$A
	MA$M <- MA.proc$M
	return(MA)
}