#!/usr/bin/env R

# need: 
# #host, port, user, password will be passed to readGrps directly.

# grps = [[(dbnm, array_id, chN), ...], ...]
# # array_pf = {dbnm:{array_id:pf_id, ...}, ...} # don't need now
# bg_correct, norm_in_array, norm_in_pf # {dbnm_pfid:method, ...}, now is {dbnm:{pfid:method, ... }, ... }
# analysis_method_or_options
 
# XPF = TRUE | FALSE, and if XPF:
# 	MatchLines = {dbnm:{pf_id:[[pbids], ...], ...}, ...}
# 	xpf_names = c(dbkw, ...)
# 	norm_xpf

# now all in user_params

# Usage: analyzeMPMDB(params, DTList=NULL, con=NULL) 

#save(grps, file='/home/xxia/temp/inqInt_svdt.Rdata')
#save.image(file='/home/xxia/temp/image.Rdata')

library(RMySQL)
library(Biobase)
library(limma) # for normalize
library(affy)

#use_lme4 <- FALSE 
#use_lme4 <- TRUE
#liblme <- if (use_lme4) 'lme4' else 'nlme'
#liblme <- c('nlme', 'lme4')
liblme <- c('nlme')#, 'lme4')
#if (use_lme4) library(lme4) else library(nlme)
library(nlme)
#library(lme4)

library(multcomp)
library(muStat) # for prentice.test
#source("/home/xxia/master/webarray/v1/cgi-bin/R_code/mpmdb_code.R")
#source(paste(user_params$wd, '/mpmdb_code.R', sep=''))


#con <- dbConnect(dbDriver('MySQL'), host=host, port=port, user=user, password=password)

## convert probe_id from int to char
#if (XPF) {
#	for (dbnm in names(MatchLines)) 
#		for (pf in names(MatchLines[[dbnm]]))
#			MatchLines[[dbnm]][[pf]] <- lapply(MatchLines[[dbnm]][[pf]], as.character)
#	xpf_names <- unlist(xpf_names) # be careful, unlist will remove NULL items
#	}
	
IN_DEBUG_MODE <- FALSE #TRUE
DEBUG_FN <- if (.Platform$OS.type == 'windows') '\\temp\\analyzeDBs.log' else '/tmp/analyzeDBs.log'
#options(error=expression(traceback()))
HOSTNAME <- Sys.getenv('HOSTNAME') # may get '' for HOSTNAME the program is run by a daemon launched in /etc/init.d/. In such a case, Python os.uname will get correct name.

N_para <- 4000 # if rows exceed this number, do parallel computation
N_para_mix <- 1000 # if rows exceed this number for mixed model, do parallel computation
N_digits <- 5

RG_norm_mtd <- c("Aquantile", "Gquantile", "Rquantile")

stackMatrix <- function(L) {
	# same to the one in mytools/mytools.R
	# L is a list of Matrix with same number of columns
	# return a matrix that is a stack of all matrix in L
	
	# get the column number for each number
	LX <- unlist(lapply(L, function(x) {x<-as.matrix(x); rep(1:ncol(x), each=nrow(x))}))
	# unstack return data.frame if all columns have the same length. otherwise a list (even if only one column)
	rlt <- unstack(data.frame(unlist(L), as.character(LX)))
	invisible(if (is.data.frame(rlt)) as.matrix(rlt) else as.matrix(unlist(rlt)))

	}

matchLinesNo <- function(pbids, lines, merge_method='log mean', len=1, each=1, times=1, colnm=NULL) {
	# pbids is a vector of probe ids of a platform, this parameter is no used any more since lines contains idx
	#pos <- seq(pbids)
	#names(pos) <- pbids
	grp_num <- length(lines)
	if (length(len)==1) len <- rep(len, length=grp_num) 
	s <- seq(grp_num)
	lines <- lapply(lines, as.integer) #Use as.integer directly since now it is idx instead of probe_id
	if (merge_method %in% c('mean', 'median', 'log mean')) {
		#return(rlt <- pos[sapply(lines, function(x) x[1])])
		#return(match(sapply(lines, function(x) x[1]), pbids)) # match should be faster than index by name
		return(sapply(lines, function(x) x[1]))
		}
	else if (merge_method %in% c("one-by-one-min", "one-by-one-max")) {
		#return(rlt <- pos[unlist(lapply(s, function(x) rep(lines[[x]], length=len[x])))])
		#return(match(unlist(lapply(s, function(x) rep(lines[[x]], length=len[x]))), pbids))
		return(unlist(lapply(s, function(x) rep(lines[[x]], length=len[x]))))
		}
	else if (merge_method == "combination") {
		peach <- each[,colnm]
		if (length(peach)==1) peach <- rep(peach, length=grp_num) 
		ptimes <- times[,colnm]
		if (length(ptimes)==1) ptimes <- rep(ptimes, length=grp_num)
		#return(rlt <- pos[unlist(lapply(s, function(x) rep(lines[[x]], each=peach[x], times=ptimes[x])))])
		#return(rlt <- match(unlist(lapply(s, function(x) rep(lines[[x]], each=peach[x], times=ptimes[x]))), pbids))
		return(rlt <- unlist(lapply(s, function(x) rep(lines[[x]], each=peach[x], times=ptimes[x]))))
		}
	else return(NULL)
	}

matchLines <- function(M, lines, merge_method='log mean', len=1, each=1, times=1, min_proc=1) {
	# "M" is numeric matrix, with columns like fg, bg. rows are probes
	# "lines" is a list of vectors, the vectors contains probe IDs to be merged
	# "len" is a vector of number, contain the result rows number for each item in "lines", "len" is used when "merge_method" in ("one-by-one-min", "one-by-one-max")
	# "each" and "times" are list or vector with length equal to "lines", they used when merge_method is "combination"
	#rlt <- matrix(nrow=length(lines), ncol=ncol(M))

	# convert to matrix first
	if (!is.matrix(M))
		if (is.vector(M)) M <- as.matrix(M) 
		else stop('matrix is reqired for matchLines')

	grp_num <- length(lines)
	rnm <- names(lines)
	#rnmM <- rownames(M)
	if (length(len) > 1) rnm <- rep(rnm, times=len)
	else {
		if (len != 1) rnm <- rep(rnm, each=len)
		len <- rep(len, length=grp_num) }
	cnm <- colnames(M)
	s <- seq(grp_num) #seq(lines)
	peach <- each
	if (length(peach)==1) peach <- rep(peach, length=grp_num) 
	ptimes <- times
	if (length(ptimes)==1) ptimes <- rep(ptimes, length=grp_num)
	LogMean <- function(x) mean(log2(x), na.rm=TRUE)
	lines <- lapply(lines, as.integer)
	mtd_OneByOneMin <- function(x) {
		#idx <- rep(match(lines[[x]], rnmM), length=len[x])
		#idx <- rep(as.integer(lines[[x]]), length=len[x])
		idx <- rep(lines[[x]], length=len[x])
		if (length(idx)==1) rbind(M[idx, ]) else cbind(M[idx, ])
		}
	#mtd_OneByOneMax <- mtd_OneByOneMin # recycling if has less items
	mtd_OneByOneMax <- function(x) { # filled by log-mean values if has less items
		#newM <- M[lines[[x]],] # much much much slower than using match!!!
		#idx <- match(lines[[x]], rnmM)
		#idx <- as.integer(lines[[x]])
		idx <- lines[[x]]
		newM <- if (length(idx)==1) rbind(M[idx,]) else cbind(M[idx,])
		dif <- len[x]-nrow(newM)
		if (dif > 0) {
			meanM <- apply(newM, 2, LogMean)
			newM <- rbind(newM, matrix(meanM, ncol=length(meanM), nrow=dif, byrow=TRUE)) }
		return(newM)
		}

	mtd <- switch(merge_method, 
		mean=function(x) mean(x, na.rm=TRUE), median=function(x) median(x, na.rm=TRUE), 'log mean'=LogMean, # x is values for these mtds
		'one-by-one-min'=mtd_OneByOneMin, 'one-by-one-max'=mtd_OneByOneMax, # x is idx for these mtds
		combination=function(x) { # x is idx
			#idx <- rep(match(lines[[x]], rnmM), each=peach[x], times=ptimes[x])
			#idx <- rep(as.integer(lines[[x]]), each=peach[x], times=ptimes[x])
			idx <- rep(lines[[x]], each=peach[x], times=ptimes[x])
			if (length(idx)==1) rbind(M[idx, ]) else cbind(M[idx,])
			}
		)
	#M <<- M; mtd<<-mtd; Lines<<-lines
	if (IN_DEBUG_MODE) cat('\nBefore merge function', file=DEBUG_FN, append=TRUE)
	if (merge_method %in% c('mean', 'median', 'log mean')) {
		#rlt <- t(sapply(lines, function(x) apply(as.matrix(M[x,]), 2, mtd) ))
		#lines <- lapply(lines, function(x) match(x, rnmM)) # actuualy use as.integer(x) should be much faster than match(x, rnmM)
		#lines <- lapply(lines, as.integer)
		if (grp_num<N_para) rlt <- sapply(lines, function(x) apply(if (length(x)==1) rbind(M[x,]) else cbind(M[x,]), 2, mtd) )
		else rlt <- computeSeq(lines, function(x) apply(if (length(x)==1) rbind(M[x,]) else cbind(M[x,]), 2, mtd), min_proc=min_proc, srcfun=sapply, parfun=parSapply )
		if (is.vector(rlt)) 
			rlt <- as.matrix(rlt)
			#rlt <- rbind(rlt) #as.matrix(rlt)
		else rlt <- t(rlt)
		}
	else if (merge_method %in% c("one-by-one-max")) {
		if (grp_num<N_para) rlt <- stackMatrix(lapply(s, mtd)) #function(x) apply(M[lines[[x]],], 2, mtd) ))
		else rlt <- stackMatrix(computeSeq(s, mtd, min_proc=min_proc)) #function(x) apply(M[lines[[x]],], 2, mtd) ))
		}
	else if (merge_method %in% c("one-by-one-min", "combination")) {
		# now use index to get data, might be faster.
		mtd_pbids <-  switch(merge_method, 'one-by-one-min'=function(x) rep(lines[[x]], length=len[x]),
			'combination'=function(x) rep(lines[[x]], each=peach[x], times=ptimes[x]) )
		#idx <- unlist(computeSeq(s, mtd_pbids, min_proc=min_proc))
		idx <- unlist(lapply(s, mtd_pbids))
		#idx <- match(idx, rnmM)
		#idx <- as.integer(idx)
		rlt <- if(length(idx)==1) rbind(M[idx,]) else cbind(M[idx,])
		}
	else return(NULL)
	if (IN_DEBUG_MODE) cat('\nAfter merge function', file=DEBUG_FN, append=TRUE)
	rownames(rlt) <- rnm
	colnames(rlt) <- cnm
	invisible(rlt)
	}

#if (!XPF) 
getRepParam <- function(merge_method, MatchLines) {
	# return the copy number for each probe: a list with items: "len" (and "times" and "each" when merge_method=='combination'), each item is a vector with length equal to probe number, its elements are copy number of a probe
	ML <- NULL # the matrix of length, columns are pf, row are match lines, items are numbers of probes.
	colnm <- c() # a vector of dbnm_pfids # list() # list( list(dbnm, pf_id), ... )
	rlt <- list()

	#if (merge_method in c('mean', 'median', 'log mean'))
	if (merge_method %in% c("one-by-one-min", "one-by-one-max", "combination")) {
		# 
		for (dbnm in names(MatchLines)) {
			db_pf <- MatchLines[[dbnm]]
			for (pfid in names(db_pf)) {
				colnm[length(colnm)+1] <- paste(dbnm, pfid, sep='_') #list(dbnm, pfid)
				ML <- cbind(ML, unlist(lapply(db_pf[[pfid]], length)))
				}
			}
		colnames(ML) <- colnm
		if (merge_method == 'combination') {
			acc <- function(x) {
				rltx <- c(1)
				for (i in 2:length(x) ) rltx[i] <- rltx[i-1] * x[i-1]
				return(rltx)
				}
			revacc <- function(x) {
				x <- rev(x)
				rltx <- c(1)
				for (i in 2:length(x) ) rltx[i] <- rltx[i-1] * x[i-1]
				return(rev(rltx))
				}
			rlt[['times']] <- t(apply(ML, 1, acc ))
			colnames(rlt[['times']]) <- colnm
			rlt[['each']] <- t(apply(ML, 1, revacc))
			colnames(rlt[['each']]) <- colnm
			rlt[['len']] <- apply(ML, 1, prod)
			}
		else {
			rlt[['len']] = apply(ML, 1, switch(merge_method, "one-by-one-min"=min, "one-by-one-max"=max) )
			}
		}

	return(rlt)
	}

bgCorrect <- function (FG, BG, method = "subtract", offset = 0, printer=NULL, verbose = TRUE) {
	# FM and BG are fg matrix and bg matrix, with rows are probes and cols are samples
	# this function is a modified version of Limma's backgroundCorrect
	method <- match.arg(method, c("none", "subtract", "half",
		"minimum", "movingmin", "edwards", "normexp", "rma"))
	if (is.null(BG)) method <- "none"
	switch(method, 
		subtract = { FG <- FG - BG }, 
		half = { FG <- pmax(FG - BG, 0.5) }, 
		minimum = {
			FG <- as.matrix(FG - BG)
			for (slide in 1:ncol(FG)) {
				i <- FG[, slide] < 1e-18
				if (any(i, na.rm = TRUE)) {
					m <- min(FG[!i, slide], na.rm = TRUE)
					FG[i, slide] <- m/2
					}
				} 
			}, 
		movingmin = {
			FG <- FG - ma3x3.spottedarray(BG, printer = printer, FUN = min, na.rm = TRUE) }, 
		edwards = {
			one <- matrix(1, NROW(FG), 1)
			delta.vec <- function(d, f = 0.1) {
				quantile(d, mean(d < 1e-16, na.rm = TRUE) * (1 +
					f), na.rm = TRUE)
			}
			sub <- as.matrix(FG - BG)
			delta <- one %*% apply(sub, 2, delta.vec)
			FG <- ifelse(sub < delta, delta * exp(1 - (BG +
				delta)/FG), sub)
			}, 
		normexp = {
			for (j in 1:ncol(FG)) {
				x <- FG[, j] - BG[, j]
				out <- normexp.fit(x)
				FG[, j] <- normexp.signal(out$par, x)
				if (verbose)
					cat("Corrected array", j, "\n")
				}
			},
		rma = {
			require("affy")
			FG <- apply(FG - BG, 2, bg.adjust)
			} )
		
	if (offset) FG <- FG + offset
	invisible(FG)
	}

normInArray <- function(RM, GM, mtd, con) {
	# only for two color data
	# RM is ch1 matrix, GM is ch2 matrix, con is the database connection
	# return normalized RM and GM: list(RM, GM)
	invisible(list(R=RM, G=GM))
	}

normInPf <- function(M, mtd) {
	# M is matrix, rows are probe, cols are samples
	# return normalized M
	invisible(M)
	}

correctOpts <- function(bg_correct, norm_in_array, norm_in_pf, norm_x_pf) {
	# convert to list
	# vsn require raw data
	if (norm_x_pf=='vsn') invisible(list(bg_correct=NULL, norm_in_array=NULL, norm_in_pf=NULL))
	for (dbnm in names(norm_in_pf)) {
		pfdic <- norm_in_pf[[dbnm]]
		bg_correct[[dbnm]] <- as.list(bg_correct[[dbnm]])
		norm_in_array[[dbnm]] <- as.list(norm_in_array[[dbnm]])
		for (pfid in names(pfdic))
			if (pfdic[[pfid]]=='vsn' ) bg_correct[[dbnm]][[pfid]] <- norm_in_array[[dbnm]][[pfid]] <- 'none'
		}
	invisible(list(bg_correct=bg_correct, norm_in_array=norm_in_array, norm_in_pf=norm_in_pf))
	}

getChIDs <- function(grps, norm_in_array=NULL, norm_in_pf=NULL, norm_x_pf, con=NULL) {
	db_pf_ary_N <- list() # {dbnm:{pf:{ary:{chN:TRUE, ... }, ... }, ... }, ...}
	#db_pf_ary_N_to_use <- list() # {dbnm:{pf:{ary:{chN:TRUE, ... }, ... }, ... }, ...}
	i <- 0
	# get db_pf_ary_N first
	for (grp in grps) {
		i <- i+1
		grp_nm <- paste('group', i, sep='')
		for (ary in grp) {
			dbnm <- ary[[1]]
			pf_id <- ary[[2]]
			array_id <- ary[[3]]
			chN <- ary[[4]]
			if (is.null(db_pf_ary_N[[dbnm]])) db_pf_ary_N[[dbnm]] <- list() #list(pf_id=list(array_id=list())) # {ary:{chN:true, ... }, ... }
			if (is.null(db_pf_ary_N[[dbnm]][[pf_id]])) db_pf_ary_N[[dbnm]][[pf_id]] <- list() #list(array_id=list()) # {chN:true, ... }
			if (is.null(db_pf_ary_N[[dbnm]][[pf_id]][[array_id]])) db_pf_ary_N[[dbnm]][[pf_id]][[array_id]] <- list() #{chN:true, ... }
			db_pf_ary_N[[dbnm]][[pf_id]][[array_id]][[chN]] <- grp_nm #TRUE
			}
		}
	# sort channels in pf
	for (dbnm in names(db_pf_ary_N)) {
		pfdic = db_pf_ary_N[[dbnm]]
		for (pfid in names(pfdic)) {
			ary_chNs <- pfdic[[pfid]]
			for (ary_id in names(ary_chNs)) {
				chNs <- as.integer(names(ary_chNs[[ary_id]]))
				chNs_sorted <- sort(chNs)
				if (!all(chNs == chNs_sorted)) ary_chNs[[ary_id]] <- ary_chNs[[ary_id]][as.character(chNs_sorted)]
				}
			db_pf_ary_N[[dbnm]][[pfid]] <- ary_chNs
			}
		}

	db_pf_ary_N_to_use <- db_pf_ary_N

	# add channels required by norm_x_pf, norm_in_pf and norm_in_array

	#if ( (!is.null(norm_in_array)) || ((!is.null(norm_x_pf)) && (norm_x_pf %in% RG_mtd)) || ((!is.null(norm_x_pf)) && (length(intersect(RG_mtd, unlist(norm_in_pf)))>0))  ) { } # need to check 
	chk_x_pf <- ifelse((!is.null(norm_x_pf)) && (norm_x_pf %in% RG_norm_mtd), TRUE, FALSE)
	db_pf_mtd <- unlist(norm_in_pf)
	db_pf_mtd <- db_pf_mtd[db_pf_mtd %in% intersect(db_pf_mtd, RG_norm_mtd)] # vector with elements like dbnm.pf=norm_method
	chk_in_pf <- ifelse(length(db_pf_mtd)>0, TRUE, FALSE)
	db_pf_ary_mtd <- unlist(norm_in_array)
	db_pf_ary_mtd <- db_pf_ary_mtd[db_pf_ary_mtd != 'none']
	chk_in_array <- ifelse(length(db_pf_ary_mtd)>0, TRUE, FALSE)
	if (!chk_x_pf && !chk_in_pf && !chk_in_array) return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
	# need to check two color arrays
		
	# find channel numbers to be used for analysis
	ary_chNs <- unlist(db_pf_ary_N, recursive=FALSE)
	ary_chNs <- unlist(ary_chNs, recursive=FALSE) # list with elements like dbnm.pfid.aryid=list(chN=grpN)
	ary_chNs_num <- sapply(ary_chNs, length) # vector with elements like dbnm.pfid.aryid=channel_num_to_use
	
	if (all(ary_chNs_num==2)) # all are two channels
		return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
	
	# check arrays with 3 or more channels to use
	idx_log <- ary_chNs_num > 2
	if (any(idx_log)) { 
		if (chk_x_pf) {
			chk_x_pf <- FALSE 
			norm_x_pf <- 'none' # or NULL 
			}
		if (chk_in_pf || chk_in_array) {
			db_pf_ary <- strsplit(names(ary_chNs_num[idx_log]), '\\.') # a list of name vector: c(dbnm, pfid, aryid)
			db_pf_ary <- matrix(unlist(db_pf_ary), byrow=TRUE, ncol=3, dimnames=list(NULL, c('dbnm', 'pf', 'ary')))
			if (chk_in_pf) {
				db_pf_nm <- unique(db_pf_ary[, 1:2], MARGIN=1) 
				db_pf_nm <- paste(db_pf_nm[,1], db_pf_nm[,2], sep='.')
				common_nm <- intersect(db_pf_nm, names(db_pf_mtd))
				if (length(common_nm)>0) {
					db_pf_mtd <- as.list(db_pf_mtd)
					lapply(common_nm, function(x) {db_pf_mtd[x] <<- NULL; dbpfnm <- strsplit(x, '\\.')[[1]]; norm_in_pf[[dbpfnm[1]]][[dbpfnm[2]]] <<- NULL} )
					db_pf_mtd <- unlist(db_pf_mtd)
					if (length(db_pf_mtd) == 0) chk_in_pf <- FALSE
					}
				}
			if (chk_in_array) {
				#db_pf_ary_nm <- unique(db_pf_ary[, c(1,3)], MARGIN=1)
				db_pf_ary_nm <- apply(db_pf_ary, 1, function(x) paste(x, collapse='.'))
				common_nm <- intersect(db_pf_ary_nm, names(db_pf_ary_mtd))
				if (length(common_nm)>0) {
					db_pf_ary_mtd <- as.list(db_pf_ary_mtd)
					lapply(common_nm, function(x) {db_pf_ary_mtd[x] <<- NULL; dbpfarynm <- strsplit(x, '\\.')[[1]]; norm_in_array[[dbpfarynm[1]]][[dbpfarynm[2]]][[dbpfarynm[3]]] <<- NULL} )
					db_pf_ary_mtd <- unlist(db_pf_ary_mtd)
					if (length(db_pf_ary_mtd) == 0) chk_in_array <- FALSE
					}
				}
			}
		if (!chk_x_pf && !chk_in_pf && !chk_in_array) return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
		}
	# check arrays with just 1 channel to use
	idx_log <- ary_chNs_num < 2
	if (!any(idx_log)) return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
	ary_ch <- unlist(ary_chNs[idx_log]) # vector with elements like dbnm.pfid.aryid.chN=grpN
	db_pf_ary_ch <- matrix(unlist(strsplit(names(ary_ch), '\\.')), byrow=TRUE, ncol=4, dimnames=list(NULL, c('dbnm', 'pf', 'ary', 'ch1'))) 
	# get a list of aryid vector, with dbnm as names
	aryids <- tapply(db_pf_ary_ch[,'ary'], db_pf_ary_ch[,'dbnm'], function(x) x)
	rowidx <- unlist(tapply(seq(nrow(db_pf_ary_ch)), db_pf_ary_ch[,'dbnm'], function(x) x)) # keep a row idx since tapply reorganized aryid according to dbnm and destroyed the order
	dbnms <- names(aryids)
	aryidstr <- sapply(aryids, function(x) paste(x, collapse=', '))
	ary_chnums <- lapply(seq(dbnms), function(i) {ary_id_chnum <- dbGetQuery(con, paste('SELECT id, channel_num FROM ', dbnms[i], '.array WHERE id in (', aryidstr[i], ')', sep='') ); ary_chnum <- ary_id_chnum$channel_num; names(ary_chnum) <- ary_id_chnum$id; ary_num <- ary_chnum[aryids[[dbnm[i]]]] } ) # a list of vectors (ary_chnums), with length equal to dbnms 
	mono_idx <- unlist(ary_chnums) < 2
	if (any(mono_idx)) { # some array just has one channel in database
		if (chk_x_pf) {
			chk_x_pf <- FALSE
			norm_x_pf <- 'none' # cannot do norm_x_pf
			}
		ridx <- rowidx[mono_idx] # rows of db_pf_ary_ch, which has just one channel data in MPMDB
		if (chk_in_pf) {
			db_pf_nm <- unique(db_pf_ary_ch[ridx, 1:2], MARGIN=1) 
			db_pf_nm <- paste(db_pf_nm[,1], db_pf_nm[,2], sep='.')
			common_nm <- intersect(db_pf_nm, names(db_pf_mtd))
			if (length(common_nm)>0) {
				db_pf_mtd <- as.list(db_pf_mtd)
				lapply(common_nm, function(x) {db_pf_mtd[x] <<- NULL; dbpfnm <- strsplit(x, '\\.')[[1]]; norm_in_pf[[dbpfnm[1]]][[dbpfnm[2]]] <<- NULL} )
				db_pf_mtd <- unlist(db_pf_mtd)
				if (length(db_pf_mtd) == 0) chk_in_pf <- FALSE
				}
			}
		if (chk_in_array) {
			db_pf_ary_nm <- apply(db_pf_ary_ch[ridx, 1:3], 1, function(x) paste(x, collapse='.'))
			common_nm <- intersect(db_pf_ary_nm, names(db_pf_ary_mtd))
			if (length(common_nm)>0) {
				db_pf_ary_mtd <- as.list(db_pf_ary_mtd)
				lapply(common_nm, function(x) {db_pf_ary_mtd[x] <<- NULL; dbpfarynm <- strsplit(x, '\\.')[[1]]; norm_in_array[[dbpfarynm[1]]][[dbpfarynm[2]]][[dbpfarynm[3]]] <<- NULL} )
				db_pf_ary_mtd <- unlist(db_pf_ary_mtd)
				if (length(db_pf_ary_mtd) == 0) chk_in_array <- FALSE
				}
			}
		if (!chk_x_pf && !chk_in_pf && !chk_in_array) return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
		}
	mul_idx <- !mono_idx
	if (!any(mul_idx)) return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))
	# try to find those channels needed
	db_pf_ary_ch <- db_pf_ary_ch[mul_idx,]
	if (sum(mul_idx)==1) db_pf_ary_ch <- t(as.matrix(db_pf_ary_ch))
	db_pf_ary_ch <- cbind(db_pf_ary_ch, 'ch2'=ifelse(db_pf_ary_ch[,'ch1']=='1', '2', '1'))
	db_pf_ary_ch_srt <- db_pf_ary_ch
	lapply(seq(nrow(db_pf_ary_ch)), function(i) db_pf_ary_ch_srt[i, c('ch1', 'ch2')] <<- sort(db_pf_ary_ch[i,c('ch1', 'ch2')]) )
	# add channel to db_pf_ary_N
	dtmp <- db_pf_ary_ch
	dtmps <- db_pf_ary_ch_srt
	lapply(seq(nrow(dtmp)), function(i) {db <- dtmp[i,1]; pf <- dtmp[i,2]; ary <- dtmp[i,3]; ch2 <- dtmp[i,5]; db_pf_ary_N[[db]][[pf]][[ary]][[ch2]] <- FALSE; db_pf_ary_N[[db]][[pf]][[ary]] <<- db_pf_ary_N[[db]][[pf]][[ary]][dtmps[i, 4:5]] } )
	
	return(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))


	check_more <- TRUE
	# check norm_x_pf first
	if ((!is.null(norm_x_pf)) && (norm_x_pf %in% RG_norm_mtd)) { # all should be two channels
		# get channel number to be used
		ary_chNs <- unlist(db_pf_ary_N, recursive=FALSE)
		ary_chNs <- unlist(ary_chNs, recursive=FALSE)
		ary_chNs_num <- sapply(ary_chNs, length)
		if (all(ary_chNs_num==2)) check_more <- FALSE # don't need to add channels any more
		else {
			if (any(ary_chNs_num>2)) {
				norm_x_pf <- 'none' # or NULL
				# disable norm_in_pf for those pf with arrays got more than 2 channel's data
				arys <- arys_chNs[ary_chNs_num>2]
				arynms <- strsplit(names(arys), '\\.') # a list of name vector: c(dbnm, pfid, aryid)
				db_pf_ary <- matrix(unlist(arynms), byrow=TRUE, ncol=3, dimnames=list(NULL, c('dbnm', 'pf', 'ary')))
				if (!is.null(norm_in_pf)) {
					db_pf <- unique(db_pf_ary[, 1:2], MARGIN=1) 
					apply(db_pf, 1, function(x) if (norm_in_pf[[x[1]]][[x[2]]] %in% RG_norm_mtd) norm_in_pf[[x[1]]][[x[2]]] <<- NULL)
					}
				
				# disable norm_in_array for those arrays got more than 2 channel's data
				if (!is.null(norm_in_array)) {
					db_pf_ary <- unique(db_pf_ary[, 1:3], MARGIN=1) #paste(db_pf_ary_ch[ridx, 1], db_pf_ary_ch[ridx,2], sep='.')
					apply(db_pf_ary, 1, function(x) norm_in_array[[x[1]]][[x[2]]][[x[3]]] <<- NULL)
					}
				
				}
			if (any(ary_chNs_num<2)) { # must has some arrays just has one channel
				arys <- ary_chNs[ary_chNs_num == 1] # or < 2)
				ary_ch <- unlist(arys, recursive=FALSE)
				nms <- strsplit(names(ary_ch), '\\.') # a list of name vector: c(dbnm, pfid, aryid, chN)
				db_pf_ary_ch <- matrix(unlist(nms), byrow=TRUE, ncol=4, dimnames=list(NULL, c('dbnm', 'pf', 'ary', 'ch1')))
				aryids <- tapply(db_pf_ary_ch[,'ary'], db_pf_ary_ch[,'dbnm'], function(x) x) # a list of aryid vector, with dbnm as names
				rowidx <- unlist(tapply(seq(nrow(db_pf_ary_ch)), db_pf_ary_ch[,'dbnm'], function(x) x))
				dbnms <- names(aryids)
				aryidstr <- sapply(aryids, function(x) paste(x, collapse=', '))
				ary_chnums <- lapply(seq(dbnms), function(i) {ary_id_chnum <- dbGetQuery(con, paste('SELECT id, channel_num FROM ', dbnms[i], '.array WHERE id in (', aryidstr[i], ')', sep='') ); ary_chnum <- ary_id_chnum$channel_num; names(ary_chnum) <- ary_id_chnum$id; ary_num <- ary_chnum[aryids[[dbnm[i]]]] } ) # a list of vectors (ary_chnums), with length equal to dbnms 
				mon_idx <- which(unlist(ary_chnums) < 2)
				if (length(mon_idx) > 0) { 
					norm_x_pf <- 'none' # cannot do norm_x_pf
					ridx <- rowidx[mon_idx] # rows of db_pf_ary_ch, which has just one channel data in MPMDB
					# disable norm_in_pf
					if (!is.null(norm_in_pf)) {
						db_pf <- unique(db_pf_ary_ch[ridx, 1:2], MARGIN=1) #paste(db_pf_ary_ch[ridx, 1], db_pf_ary_ch[ridx,2], sep='.')
						apply(db_pf, 1, function(x) if (norm_in_pf[[x[1]]][[x[2]]] %in% RG_norm_mtd) norm_in_pf[[x[1]]][[x[2]]] <<- NULL)
						}
					# disable norm_in_array
					if (!is.null(norm_in_array)) {
						db_pf_ary <- unique(db_pf_ary_ch[ridx, 1:3], MARGIN=1) #paste(db_pf_ary_ch[ridx, 1], db_pf_ary_ch[ridx,2], sep='.')
						apply(db_pf_ary, 1, function(x) norm_in_array[[x[1]]][[x[2]]][[x[3]]] <<- NULL)
						}

					}
				else { # try to find those channels needed 
					check_more <- FALSE # every array should be got two channels of data
					db_pf_ary_ch <- cbind(db_pf_ary_ch, 'ch2'=ifelse(db_pf_ary_ch[,'ch1']=='1', '2', '1'))
					apply(seq(nrow(db_pf_ary_ch)), 1, function(i) db_pf_ary_ch[i, c('ch1', 'ch2')] <<- sort(db_pf_ary_ch[i,c('ch1', 'ch2')]) ) 
					}
				}
			}
		}
	# then check norm_in_pf
	if (check_more && !is.null(norm_in_pf)) { 
		
		}
	# check norm_in_array last
	if (check_more && !is.null(norm_in_array)) { # add other necessary channels needed by norm_in_array to db_pf_ary_N and validate norm_in_array
		for (dbnm in names(norm_in_array)) {
			pfdic <- norm_in_array[[dbnm]]
			for (pfid in names(pfdic)) {
				nmtd <- pfdic[[pfid]]
				ary_chNs <- db_pf_ary_N[[dbnm]][[pfid]]
				ary_chNs_num <- sapply(ary_chNs, length)
				if (nmtd == 'none' || any(ary_chNs_num>2) ) { # delete arrays in norm_in_array if more than 2 channels are used
					norm_in_array[[dbnm]][[pfid]] <- NULL
					next}
				if (any(ary_chNs_num < 2)) { # try to add a channel for arrays with only one channel used
					ary_ids <- names(ary_chNs)[ary_chNs_num < 2]
					ary_chnums <- dbGetQuery(con, paste('SELECT channel_num FROM ', dbnm, '.array WHERE id in (', paste(ary_ids, collapse=', '), ')', sep='') )$channel_num
					if (any(ary_chnums < 2)) { # all arrays should has 2 or more channels
						norm_in_array[[dbnm]][[pfid]] <- NULL
						next}
					for (ary_id in ary_ids) { # add channel
						ary <- ary_chNs[[ary_id]]
						chN <- as.integer(names(ary)[1])
						if (chN == 1) ary_chNs[[ary_id]][['2']] <- FALSE
						else ary_chNs[[ary_id]][['1']] <- FALSE
						chNs <- as.integer(names(ary_chNs[[ary_id]]))
						chNs_sorted <- sort(chNs) # sort channels
						if (any(chNs != chNs_sorted)) 
							ary_chNs[[ary_id]] <- ary_chNs[[ary_id]][as.character(chNs_sorted)]
						}					
					}
				db_pf_ary_N[[dbnm]][[pfid]] <- ary_chNs # put back into db_pf_ary_N
				}
			}
		}
	
	invisible(list(db_pf_ary_N=db_pf_ary_N, db_pf_ary_N_to_use=db_pf_ary_N_to_use, norm_in_array=norm_in_array))	
	}

getChDTs <- function(db_pf_ary_N, con, bg_correct=NULL, db_pf_ctrl=NULL, printers=NULL, plot_chart=FALSE, plot_pdf=FALSE, chart_prefix=NULL, use_rma=FALSE) {
	db_pf_M <- list()
	#db_pf_arynm <- ifelse(plot_chart, list(), NULL)  # NULL cannot be used like this -- error if not plot_chart !!!
	#db_pf_nm <- ifelse(plot_chart, list(), NULL)
	get_pf_ary_nm <- TRUE
	if (get_pf_ary_nm || plot_chart) {
		db_pf_arynm <- list()
		db_pf_nm <- list()
		}
	else db_pf_arynm <- db_pf_nm <- NULL
	for (dbnm in names(db_pf_ary_N)) {
		db_pf_M[[dbnm]] <- list()
		if (get_pf_ary_nm || plot_chart) {
			db_pf_arynm[[dbnm]] <- list()
			db_pf_nm[[dbnm]] <- list()
			}
		dbdic <- db_pf_ary_N[[dbnm]]
		for (pf_id in names(dbdic) ) {
			if (get_pf_ary_nm || plot_chart) {
				pnm <- dbGetQuery(con, paste('SELECT name FROM ', dbnm, '.platform WHERE id=', pf_id, sep='') )[1,1]
				db_pf_nm[[dbnm]][[pf_id]] <- pnm}
			pfdic <- dbdic[[pf_id]]
			pbidx <- NULL

			# check bg method
			bg_mtd <- bg_correct[[dbnm]][[pf_id]]
			#bg_mtd <- attr(attr(bg_correct, dbnm), pf_id)
			printer <- NULL
			get_pnt <- FALSE
			correct_bg <- !(is.null(bg_mtd) || bg_mtd=='none')
			if (!correct_bg && !plot_chart) { # now plot_chart will plot array with fg and bg!
				get_bg <- FALSE
				bgcol <- ''
				}
			else {
				get_bg <- TRUE
				bgcol <- ', bg'
				if ((!is.null(bg_mtd) && bg_mtd %in% c('movingmin')) || plot_chart) get_pnt <- TRUE  # now plot_chart will need printer!
				}  
			# check if need to get control
			get_ctrl <- db_pf_ctrl[[dbnm]][[pf_id]]
			if (!is.null(get_ctrl) && get_ctrl) {
				get_pnt <- TRUE
				db_pf_ctrl[[dbnm]][[pf_id]] <- getPfCtrl(dbnm, pf_id, con)
				}

			if (get_pnt) {
				if (is.null(printers)) printers <- list() #list(dbnm=list())
				if (is.null(printers[[dbnm]])) printers[[dbnm]] <- list()
				if (is.null(printers[[dbnm]][[pf_id]])) printers[[dbnm]][[pf_id]] <- getPrinter(dbnm, pf_id, con)$printer
				printer <- printers[[dbnm]][[pf_id]] #getPrinter(dbnm, pf_id, con)$printer
				}


			# get data
			FG <- BG <- rnm <- cnm <- aid <- anms <- chNs<- NULL #pnms <- NULL
			i_rma <- fn_rma <- NULL # store the index of cols and related file names.
			i <- 0 # current col index
			for (array_id in names(pfdic) ) {
				arydic <- pfdic[[array_id]]
				if (TRUE || plot_chart) {
					#apnm <- dbGetQuery(con, paste('SELECT a.identifier, p.name FROM ', dbnm, '.array a LEFT JOIN ', dbnm, '.platform p ON a.platform_id=p.id WHERE a.id=', array_id, sep='') )
					apnm <- dbGetQuery(con, paste('SELECT identifier, data_type FROM ', dbnm, '.array WHERE id=', array_id, sep='') )
					anm <- apnm[1,1]
					dt_type <- apnm[1,2]
					#pnm <- apnm[1,2] 
					}
				for (chN in names(arydic)) {
					if (plot_chart)  {
						anms <- c(anms, anm)
						chNs <- c(chNs, chN)
						#pnms <- c(pnms, pnm)
						}

					#array_dt <- dbGetQuery(con, paste('SELECT probe_id, fg', bgcol, ' FROM ', dbnm, '.intensity WHERE array_id=', array_id, ' AND channel_No=', chN, ' ORDER BY probe_id', sep='') )
					# now use idx instead of probe_id
					array_dt <- dbGetQuery(con, paste('SELECT idx, fg', bgcol, ' FROM ', dbnm, '.intensity i LEFT JOIN ', dbnm, '.probe p ON i.probe_id=p.id WHERE array_id=', array_id, ' AND channel_No=', chN, ' ORDER BY idx', sep='') )
					if (! (nrow(array_dt)>1)) next
					i <- i + 1
					#array_dt$unique_id[which(is.na(array_dt$unique_id))] <- ''
					if (is.null(rnm)) rnm <- array_dt$idx 
					#if (is.null(rnm)) rnm <- array_dt$unique_id # now use unique_id instead of idx -- No! because data.frame cannot accept replicate row names. 
					cnm <- c(cnm, paste(array_id, chN, sep='.'))
					aid <- c(aid, array_id)

					# try to read CEL file
					#if (plot_chart || use_rma) {
					if (use_rma) {
						fn <- dbGetQuery(con, paste('SELECT f.location, f.name FROM ', dbnm, '.filexref x, ', dbnm, '.fileinfo f WHERE x.tb_id=', array_id, ' AND x.tbname="array" AND x.file_id=f.id AND f.category="intensity" AND f.format="CEL"', sep=''))
						if (nrow(fn) == 0) dtrma <- NULL
						else {
							fn <- file.path(fn$location[1], fn$name[1])
							i_rma <- c(i_rma, i)
							fn_rma <- c(fn_rma, fn)
							#dtrma <- ReadAffy(filenames=fn)
							#dtrma <- exprs(rma(dtrma))
							#if (is.null(pbidx)) {
							#	pbidx <- dbGetQuery(con, paste('SELECT idx, unique_id FROM ', dbnm, '.probe WHERE platform_id=', pf_id, ' ORDER BY idx', sep='') )
							#	pbidx <- match(pbidx$unique_id, rownames(dtrma))
							#	}
							#dtrma <- dtrma[pbidx,]
							#array_dt$fg <- 2^dtrma
							}
						}


					#array_dt <- cbind(fg=array_dt$fg)
					FG <- cbind(FG, if(dt_type %in% c('log-ratio', 'log-intensity')) 2^array_dt$fg else array_dt$fg)
					if (get_bg) BG <- cbind(BG, array_dt$bg) 
					}
				}
			# read rma over here since rma should not be read one by one (it do bewteen-array normalization!)
			if (use_rma && !is.null(fn_rma)) {
				dtrma <- ReadAffy(filenames=fn_rma)
				dtrma <- exprs(rma(dtrma))
				if (is.null(pbidx)) {
					pbidx <- dbGetQuery(con, paste('SELECT idx, unique_id FROM ', dbnm, '.probe WHERE platform_id=', pf_id, ' ORDER BY idx', sep='') )
					pbidx <- match(pbidx$unique_id, rownames(dtrma))
					}
				dtrma <- 2^dtrma[pbidx,]
				FG[, i_rma] <- dtrma
				}
			
			
			if (get_pf_ary_nm || plot_chart) {
				db_pf_arynm[[dbnm]][[pf_id]] <- anms
				if (plot_chart) {
					if (get_bg) plotArrays(FG, BG, anms, arychs=chNs, file_prefix=paste(chart_prefix, dbnm, '_', pnm, '_array_image_', sep=''), plot_pdf=plot_pdf, printer=printer)
					plotM(FG, anms, arychs=chNs, file_prefix=paste(chart_prefix, dbnm, '_', pnm, '_raw_data_', sep=''), plot_pdf=plot_pdf )}
				}
			# background correct
			if (correct_bg) {
				FG <- bgCorrect(FG, BG, method=bg_mtd, printer=printer)
				
				if (plot_chart) plotM(FG, anms, arychs=chNs, file_prefix=paste(chart_prefix, dbnm, '_', pnm, '_', bg_mtd, '_bg_corrected_', sep=''), plot_pdf=plot_pdf )
				}
			#rownames(FG) <- rnm # probe_id
			#rownames(FG) <- as.character(as.integer(rnm)) # probe_id # convert to integer first to avoid resulting in somegthing like '2e+5'
			rownames(FG) <- rnm # now it is idx instead of unique_id
			colnames(FG) <- cnm # arrayID.chN
			db_pf_M[[dbnm]][[pf_id]] <- FG 

			#db_pf_ary_N[[dbnm]][[pf_id]][[array_id]][[chN]] <- array_dt # now db_pf_ary_N became {dbnm:{pf:{ary:{chN:M[probes,'fg'], ... }, ... }, ... }, ... } 
			}
		}
	invisible(list(db_pf_M=db_pf_M, printers=printers, db_pf_arynm=db_pf_arynm, db_pf_nm=db_pf_nm, db_pf_ctrl=db_pf_ctrl))
	}

getMf <- function(n) {
	# use max col 3 if possible
	return( if(n<3) c(1,n) else c(ceiling(n/3), 3) )

	# max col is 3
	rc <- list(c(1,1), c(1,2), c(1,3), c(2,2), c(3,2), c(3,2), c(4,2), c(4,2), c(3,3), c(4,3), c(4,3), c(4,3))
	return( if(n <= 12) rc[[n]] else c(ceiling(n/3), 3) )

	# max col is 4
	if (n >= 16) {nc <- 4; nr <- ceiling(n/4)}
	else if (n >= 9) {nc <- 3; nr <- ceiling(n/3)}
	else if (n == 1) {nc <- 1; nr <- 1}
	else if (n %% 3) {nc <- 2; nr <- ceiling(n/2)}
	else {nc <- 3; nr <- n/3}
	return( c(nr, nc) )
	}

mkEpsPng <- function(fn) {
	fh <- substr(fn, 1, nchar(fn)-4)
	feps <- paste(fh, '.eps', sep='')
	fpng <- paste(fh, '.png', sep='')
	#can only print from screen device
	dev.copy2eps(file=feps) 
	dev.print(device=png, file=fpng)
	}

plotDens <- function(M, arynms, arychs=NULL, file_prefix='', plot_pdf=FALSE, max_charts=20, logged=FALSE) {
	matDensities <- function(X, chs=NULL) { # this function is modified from the one in LIMMA
        densXY <- function(Z) {
            zd <- density(Z, na.rm = TRUE)
            x <- zd$x
            y <- zd$y
            cbind(x, y)
			}
		if (!is.null(chs)) X <- cbind(X[, order(as.integer(chs))])
        out <- apply(X, 2, densXY)
        outx <- out[(1:(nrow(out)/2)), ]
        outy <- out[(((nrow(out)/2) + 1):nrow(out)), ]
        list(X = outx, Y = outy)
		}

	plotOne <- function(M, arynms, arychs, filename) {
		uni_ary <- unique(arynms)
		ary_n <- length(uni_ary)
		if (ary_n == 1) {
			if (plot_pdf) pdf(filename, pointsize=20, width=8, height=6)
			else bitmap(filename, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=20, width=8, height=6) }
		else {
			mf <- getMf(ary_n)
			#bitmap(filename, pointsize=20, width=5*mf[2]+2, height=4*mf[1]+2)
			if (plot_pdf) pdf(filename, pointsize=20, width=5*mf[2]+2, height=4*mf[1]+2)
			else bitmap(filename, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=20, width=5*mf[2]+2, height=4*mf[1]+2)
			par(mfrow = mf)
			}

		for (arynm in uni_ary) { #arynms) {
			idx <- arynms==arynm
			if (logged) dens.x <- matDensities(cbind(M[, idx]), arychs[idx])
			else dens.x <- matDensities(cbind(log2(M[, idx])), arychs[idx])
			matplot(dens.x$X, dens.x$Y, xlab = 'log2(intensity)', ylab = 'Density',
				main = arynm, type = "l", col = c('red','green','brown','grey','black'), lwd = 2,
				lty = 1)
			}
		if (FALSE && plot_pdf) mkEpsPng(filename)
		dev.off()	
		}

	uni_ary <- unique(arynms)
	ary_n <- length(uni_ary)
	if (ary_n <= max_charts) {
		filename <- paste(file_prefix, 'Densities', ifelse(plot_pdf, '.pdf', '.png'), sep='')
		plotOne(M, arynms, arychs, filename)
		}
	else {
		i1 <- 1
		i2 <- i1 + max_charts - 1
		nlen <- nchar(as.character(ary_n))
		while (i1 <= ary_n) {
			arysect <- uni_ary[i1:i2]
			idx <- which(arynms %in% arysect)
			filename <- paste(file_prefix, 'Densities_', fillZero(i1, nlen), '-', fillZero(i2, nlen), ifelse(plot_pdf, '.pdf', '.png'), sep='')
			plotOne(cbind(M[, idx]), arynms[idx], arychs[idx], filename)
			i1 <- i2 + 1
			i2 <- min(ary_n, i1 + max_charts - 1)
			}
		}
	}

plotMAs <- function(M, arynms, arychs=NULL, file_prefix='', plot_pdf=FALSE, max_charts=20, logged=FALSE) {
	uni_ary <- unique(arynms)
	ary_num <- tapply(arynms, arynms, length)[uni_ary]
	ary_dual <- names(ary_num[ary_num==2])
	ary_n <- length(ary_dual)
	if (ary_n<1) return()

	plotOne <- function(MM, AA, ary_dual, filaname) {
		ary_n <- length(ary_dual)
		if (ary_n == 1) {
			if (plot_pdf) pdf(filename, pointsize=15, width=8, height=6)
			else bitmap(filename, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=8, height=6) }
		else {
			mf <- getMf(ary_n)
			if (plot_pdf) pdf(filename, pointsize=15, width=5*mf[2]+2, height=4*mf[1]+2)
			else bitmap(filename, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=5*mf[2]+2, height=4*mf[1]+2)
			par(mfrow = mf)
			}

		for (i in seq(ary_dual)) {
			plotMA(list(M=MM[,i], A=AA[,i]), pch=ifelse(nrow(R)>2000, '.', 20), main=ary_dual[i])
			abline(0,0)
			}
		if (FALSE && plot_pdf) mkEpsPng(filename)
		dev.off()
		}

	if (is.null(arychs)) {
		P <- match(ary_dual, arynms)
		P1 <- P+1}
	else {
		Pch <- try(tapply(as.integer(arychs), arynms, function(x) x)[ary_dual])
		if ('try-error' %in% class(Pch)) {print(arychs); print(arynms); stop('Error!')}
		Pidx <- sapply(Pch, order)
		#P <- as.matrix(as.data.frame(tapply(seq(arychs), arynms, function(x) x)[ary_dual]))
		P <- sapply(tapply(seq(arychs), arynms, function(x) x)[ary_dual], function(x) x)
		P1 <- sapply(1:ncol(P), function(x) P[Pidx[2,x], x])
		P <- sapply(1:ncol(P), function(x) P[Pidx[1,x], x])
		}
	if (logged) {
		R <- cbind(M[, P])
		G <- cbind(M[, P1])}
	else {
		R <- cbind(logValue(M[, P]))
		G <- cbind(logValue(M[, P1]))}
	MM <- R-G
	AA <- (R+G)/2
	if (ary_n <= max_charts) {
		filename <- paste(file_prefix, 'MA', if (plot_pdf) '.pdf' else '.png', sep='')
		plotOne(MM, AA, ary_dual, filename)
		}
	else {
		i1 <- 1
		i2 <- i1 + max_charts - 1
		nlen <- nchar(as.character(ary_n))
		while (i1 <= ary_n) {
			idx <- i1:i2 
			filename <- paste(file_prefix, 'MA_', fillZero(i1, nlen), '-', fillZero(i2, nlen), ifelse(plot_pdf, '.pdf', '.png'), sep='')
			plotOne(cbind(MM[, idx]), cbind(AA[, idx]), ary_dual[idx], filename)
			i1 <- i2 + 1
			i2 <- min(ary_n, i1 + max_charts - 1)
			}		
		}
	}

fillZero_may_slower <- function(x, len) {
	x <- as.character(x)
	n <- nchar(x)
	if (n >= len) return(x)
	paste(rep('0', len-n), x, sep='')
	}

fillZero <- function(x, len) {
	sprintf(sprintf('%%0%dd', len), x) # or sprintf(paste('%0', len, 'd', sep=''), x)
	}

plotM <- function(M, arynms, arychs=NULL, file_prefix='', plot_pdf=FALSE, max_charts=9, logged=FALSE) {
	#paste(params$result_dir, ifelse(substr(params$result_dir,nchar(params$result_dir),nchar(params$result_dir))=='/', '', '/'), params$req_name, '_result_table.txt', sep='')
	M <- cbind(M)
	plotDens(M, arynms, arychs, file_prefix=file_prefix, plot_pdf=plot_pdf, max_charts=max_charts, logged=logged )
	plotMAs(M, arynms, arychs, file_prefix=file_prefix, plot_pdf=plot_pdf, max_charts=max_charts, logged=logged )
	}

plotDbPfM <- function(db_pf_M, treat_list, file_prefix, db_pf_arynm, db_pf_nm, db_pf_ary_ch, data_stage='', plot_pdf=FALSE, logged=FALSE) {
	for (dbnm in names(treat_list)) {
		pfdic <- treat_list[[dbnm]]
		for (pfid in names(pfdic)) {
			mtd <- pfdic[[pfid]]
			if (mtd == 'none') next
			#plotM(db_pf_M[[dbnm]][[pfid]], db_pf_arynm[[dbnm]][[pfid]], arychs=db_pf_ary_ch[[dbnm]][[pfid]], file_prefix=paste(file_prefix, dbnm, '_', db_pf_nm[[dbnm]][[pfid]], '_', mtd, data_stage, sep=''), plot_pdf=plot_pdf, logged=logged )
			arys <- db_pf_ary_ch[[dbnm]][[pfid]]
			chs <- c(sapply(arys, names)) #names(unlist(arys, recursive=FALSE))
			plotM(db_pf_M[[dbnm]][[pfid]], db_pf_arynm[[dbnm]][[pfid]], arychs=chs, file_prefix=paste(file_prefix, dbnm, '_', db_pf_nm[[dbnm]][[pfid]], '_', mtd, data_stage, sep=''), plot_pdf=plot_pdf, logged=logged )
			}
		}
	}

plotArrays <- function(FG, BG, arynms, arychs=NULL, file_prefix='', plot_pdf=FALSE, printer=NULL, logged=FALSE) {
	#paste(params$result_dir, ifelse(substr(params$result_dir,nchar(params$result_dir),nchar(params$result_dir))=='/', '', '/'), params$req_name, '_result_table.txt', sep='')
	if (is.null(printer)) return()
	if (printer$ngrid.r + printer$nspot.r <= 2 || printer$ngrid.c + printer$nspot.c <= 2) return()
	FG <- cbind(FG)
	BG <- cbind(BG)
	if (ncol(FG) != ncol(BG)) return()
	arys <- split(seq(arynms), arynms)
	for (anm in names(arys)) {
		idx <- arys[[anm]]
		plotArray(cbind(FG[, idx]), cbind(BG[, idx]), anm, arychs[idx], filename=paste(file_prefix, anm, ifelse(plot_pdf, '.pdf', '.png'), sep=''), plot_pdf=plot_pdf, printer=printer, logged=logged )
		}
	}

plotArray <- function(FG, BG, arynm, arychs=NULL, filename='', plot_pdf=FALSE, printer=NULL, logged=FALSE) {
	has_bg <- !is.null(BG) && any(BG > 0)
	if (!logged) {
		FG <- cbind(logValue(FG))
		if (has_bg) BG <- cbind(logValue(BG))}
	chN <- ncol(FG) 
	wid <- if(has_bg) 12 else 6
	hei <- 6 * chN
	if (plot_pdf) pdf(filename, pointsize=15, width=wid, height=hei)
	else bitmap(filename, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=wid, height=hei) 
	#if (chN > 1) par(mfrow = c(chN, ifelse(has_bg, 2, 1)) )
	par(mfrow = c(chN, ifelse(has_bg, 2, 1)) )
	col <- rep(c('red', 'green', 'blue', 'brown', 'purple'), length=chN)

	for (i in seq(chN)) {
		titl <- paste(arynm, 'ch', arychs[i], sep='_')
		rlt <- try(imageplot(FG[,i], printer, low='white', high=col[i], main=titl, cex.main=1, font.main=2, cex.lab=2, cex.axis=1))
		if ('try-error' %in% class(rlt)) {
			plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
			text(5,6, 'Failed in array image! \nPerhaps due to incorrect information for array grid.')
			}
		if (has_bg) {
			rlt <- try(imageplot(BG[,i], printer, low='white', high=col[i], main=paste(titl, '- Background'), cex.main=1, font.main=2, cex.lab=2, cex.axis=1))
			if ('try-error' %in% class(rlt)) {
				plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
				text(5,6, 'Failed in array image! \nPerhaps due to incorrect information for array grid.')
				}
			}
		}
	if (FALSE && plot_pdf) mkEpsPng(filename)
	dev.off()
	}

getPrinter <- function(dbnm, pfid, con, other_cols=NULL) {
	other_cols <- if (is.null(other_cols)) '' else paste(',', paste(other_cols, collapse=', '))
	pfinfos <- dbGetQuery(con, paste('SELECT id, idx, block_row, block_col, row, col, unique_id', other_cols, ' FROM ', dbnm, '.probe WHERE platform_id=', pfid, ' ORDER BY idx', sep='') ) # idx should be in the order same to probe_id
	for (i in 1:6) pfinfos[,i] <- as.integer(pfinfos[,i])
	printer <- list(ngrid.r=max(pfinfos$block_row), ngrid.c=max(pfinfos$block_col), nspot.r=max(pfinfos$row), nspot.c=max(pfinfos$col) )
	probe_id <- pfinfos$id
	pfinfos$id <- NULL
	invisible(list(printer=structure(printer, class = "PrintLayout"), genes=pfinfos, probe_id=probe_id))
	}

getPfCtrl <- function(dbnm, pfid, con) {
	pfinfos <- dbGetQuery(con, paste('SELECT idx FROM ', dbnm, '.probe WHERE platform_id=', pfid, ' AND probe_purpose="control" ORDER BY idx', sep='') )
	if (nrow(pfinfos) > 0) return(pfinfos$idx)
	return(NULL)
	}

normChsInArray <- function(db_pf_M, con, norm_in_array, printers=NULL, controls=NULL) {
	# only for two-channel data
	#for (db_pf in names(norm_in_pf)) {
	#	dbnmpf <- strsplit(db_pf, '_')[[1]]
	#	dbnm <- paste(dbnmpf[1:(length(dbnmpf)-1)], collapse='_')
	#	pfid <- dbnmpf[length(dbnmpf)]
	mtd_need_printer <- c('printtiploess', 'composite', 'control', 'robustspline')
	mtd_need_ctrl <- c('composite', 'control')
	for (dbnm in names(norm_in_array)) {
		pfdic <- norm_in_array[[dbnm]]
		for (pfid in names(pfdic)) {
			mtd <- pfdic[[pfid]]
			if (mtd == 'none') next
			# make RGList first
			DT <- db_pf_M[[dbnm]][[pfid]]
			aryNmCh <- colnames(DT) # a vector of 'aryid.chNo'
			# get ary names
			arynm <- t(as.data.frame(strsplit(aryNmCh,'\\.')))[,1]
			# count channel number of each array
			arychnum <- tapply(arynm, arynm, length)[arynm]
			PosEven <- which((arychnum %% 2) == 0)
			if (length(PosEven) < 2) next
			#posG <- as.logical(seq(ncol(DT)) %% 2) 
			posG <- as.logical(seq(PosEven) %% 2) 
			posR <- !posG
			posG <- PosEven[posG]
			posR <- PosEven[posR]
			R <- DT[, posR]
			G <- DT[, posG]
			#R <- G <- NULL
			#pfdt <- db_pf_ary_N[[dbnm]][[pfid]] # {ary:{chN:M[probes,'fg'], ... }, ... }
			#for (ary in names(pfdt)) {
			#	arydt <- pfdt[[ary]]
			#	if (!is.null(arydt[['1']]) && !is.null(arydt[['2']])) {
			#		R <- cbind(R, ary=arydt[['1']])
			#		G <- cbind(G, ary=arydt[['2']])
			#		}
			#	}
			if (! is.null(R)) {
				# get necessary information (printer) first
				if (mtd %in% mtd_need_printer) {
					if (is.null(printers)) printers <- list() #list(dbnm=list())
					if (is.null(printers[[dbnm]])) printers[[dbnm]] <- list()
					if (is.null(printers[[dbnm]][[pfid]])) printers[[dbnm]][[pfid]] <- getPrinter(dbnm, pfid, con)$printer
					printer <- printers[[dbnm]][[pfid]] #getPrinter(dbnm, pfid, con)$printer
					if (mtd %in% mtd_need_ctrl) {
						if (is.null(controls)) controls <- list()
						if (is.null(controls[[dbnm]])) controls[[dbnm]] <- list()
						if (is.null(controls[[dbnm]][[pfid]])) controls[[dbnm]][[pfid]] <- getPfCtrl(dbnm, pfid, con)
						control <- controls[[dbnm]][[pfid]]
						# if is.null(control) error will happen
						}
					}
				else printer <- control <- NULL
				# normalize it
				RG <- RG.MA(normalizeWithinArrays(list(R=R, G=G, printer=printer), method=mtd, controlspots=control))
				# put data back to db_pf_ary_N
				db_pf_M[[dbnm]][[pfid]][, posR] <- RG$R
				db_pf_M[[dbnm]][[pfid]][, posG] <- RG$G
				#i <- 0
				#for (ary in names(pfdt)) {
				#	i <- i+1
				#	arydt <- pfdt[[ary]]
				#	if (!is.null(arydt[['1']]) && !is.null(arydt[['2']])) {
				#		db_pf_ary_N[[dbnm]][[pfid]][[ary]][['1']] <- RG$R[, i]
				#		db_pf_ary_N[[dbnm]][[pfid]][[ary]][['2']] <- RG$G[, i]
				#		}
				#	}
				}
			}
		}
	invisible(db_pf_M) 
	}

RG2M_slower <- function(RG) {
	RG <- cbind(RG$G, RG$R)
	nr <- nrow(RG)
	nc <- ncol(RG)
	dim(RG) <- c(nr, nc/2, 2)
	RG <- aperm(RG, c(1, 3, 2))
	dim(RG) <- c(nr, nc)
	invisible(RG)
	}
RG2M <- function(RG) {
	RG <- rbind(RG$G, RG$R)
	dim(RG) <- c(nrow(RG)/2, ncol(RG)*2)
	invisible(RG)
	}

normChsInPf <- function(db_pf_M, db_pf_ary_N_to_use, db_pf_ary_N, norm_in_pf, wd) {
	if ('PCA' %in% unlist(norm_in_pf)) source(file.path(wd, 'normPCA.R')) # or paste(wd, 'normPCA.R', sep=.Platform$file.sep)
	for (dbnm in names(norm_in_pf)) {
		pfdic <- norm_in_pf[[dbnm]]
		for (pfid in names(pfdic)) {
			mtd <- pfdic[[pfid]]
			if (mtd == 'none') next
			if (mtd == 'Tquantile') {
				grp <- unlist(db_pf_ary_N[[dbnm]][[pfid]])
				lapply(unique(grp), function(g) if (g) db_pf_M[[dbnm]][[pfid]][, grp==g] <<- normalizeQuantiles(db_pf_M[[dbnm]][[pfid]][, grp==g]) )	
				}
			else if (mtd %in% RG_norm_mtd) {
				# make RGList
				RG <- db_pf_M[[dbnm]][[pfid]]
				dimnms <- dimnames(RG)
				nc <- ncol(RG)
				if (nc<4 || nc %% 2) next
				Ridx <- (seq(ncol(RG)) %% 2) == 0
				RG <- new('RGList', list(R=RG[,Ridx], G=RG[,!Ridx]))
				RG <- RG2M(RG.MA(normalizeBetweenArrays(RG, method=mtd)))
				dimnames(RG) <- dimnms
				# put back to db_pf_M
				db_pf_M[[dbnm]][[pfid]] <- RG
				}
			else if (mtd == 'PCA') { # PCA need log-transformed data
				arydic <- db_pf_ary_N_to_use[[dbnm]][[pfid]]
				# make column names
				cnm <- names(unlist(arydic)) # names like 'ary.chN'
				# make data matrix M
				#if (length(cnm)>1) db_pf_M[[dbnm]][[pfid]][, cnm] <- NormPCA(db_pf_M[[dbnm]][[pfid]][, cnm])$ND
				if (length(cnm)>1) db_pf_M[[dbnm]][[pfid]][, cnm] <- 2^NormPCA(logValue(db_pf_M[[dbnm]][[pfid]][, cnm]))$ND
				}
			else if (mtd == 'vsn') { # vsn output log-transformed data
				arydic <- db_pf_ary_N_to_use[[dbnm]][[pfid]]
				cnm <- names(unlist(arydic))
				if (length(cnm)>1) db_pf_M[[dbnm]][[pfid]][, cnm] <- 2^normalizeBetweenArrays(db_pf_M[[dbnm]][[pfid]][, cnm], method=mtd)
				}
			else { # scale or quantile
				arydic <- db_pf_ary_N_to_use[[dbnm]][[pfid]]
				# make column names
				cnm <- names(unlist(arydic)) # names like 'ary.chN'
				# make data matrix M
				if (length(cnm)>1) db_pf_M[[dbnm]][[pfid]][, cnm] <- normalizeBetweenArrays(db_pf_M[[dbnm]][[pfid]][, cnm], method=mtd)
				#M <- NULL
				#for (aryid in names(arydic)) 
				#	for (chN in names(arydic[[aryid]])) 
				#		M <- cbind(M, db_pf_ary_N[[dbnm]][[pfid]][[aryid]][[chN]])
			
			
				# put data back to db_pf_M
				#i <- 0
				#for (aryid in names(arydic)) 
				#	for (chN in names(arydic[[aryid]])) {
				#		i <- i+1
				#		db_pf_ary_N[[dbnm]][[pfid]][[aryid]][[chN]] <- M[,i]
				#		}
				}
			}
		}
	invisible(db_pf_M)
	}

cutLines <- function(db_pf_M, db_pf_ary_N_to_use, MatchLines, merge_method, len, each, times, min_proc=1){
	for (dbnm in names(db_pf_ary_N_to_use)) {
		pfdic <- db_pf_ary_N_to_use[[dbnm]]
		for (pfid in names(pfdic)) {
			arydic <- pfdic[[pfid]]
			# make column names
			cnm <- names(unlist(arydic)) # names like 'ary.chN'
			# make data matrix M
			M <- cbind(db_pf_M[[dbnm]][[pfid]][, cnm])
			colnames(M) <- cnm # necessary if there is just one array and one channel in a platform!
			#M <- NULL
			#for (aryid in names(arydic)) 
			#	for (chN in names(arydic[[aryid]])) 
			#		M <- cbind(M, db_pf_ary_N[[dbnm]][[pfid]][[aryid]][[chN]])
			
			# match/cut lines	
			if (merge_method %in% c("one-by-one-min", "one-by-one-max"))
				M <- matchLines(M, MatchLines[[dbnm]][[pfid]], merge_method=merge_method, len=len, min_proc=min_proc)
			else if (merge_method == 'combination') {
				dbnmpfid <- paste(dbnm, pfid, sep='_')
				M <- matchLines(M, MatchLines[[dbnm]][[pfid]], merge_method=merge_method, each=each[,dbnmpfid], times=times[,dbnmpfid], min_proc=min_proc)
				}
			else 
				M <- matchLines(M, MatchLines[[dbnm]][[pfid]], merge_method=merge_method, min_proc=min_proc)

			# put data back to db_pf_ary_N
			#db_pf_M[[dbnm]][[pfid]][, cnm] <- M
			db_pf_M[[dbnm]][[pfid]] <- M
			#i <- 0
			#for (aryid in names(arydic)) 
			#	for (chN in names(arydic[[aryid]])) {
			#		i <- i+1
			#		db_pf_ary_N[[dbnm]][[pfid]][[aryid]][[chN]] <- M[,i]
			#		}			 
			}
		}
	invisible(db_pf_M)
	}

getLimmaRG <- function(params, db_pf_ary_N_to_use, con) { # not used now
	contrasts <- params$contrasts_orig <- params$contrasts
	ref <- params$ref_name

	dbnm <- names(db_pf_ary_N_to_use)[1]
	pf <- names(db_pf_ary_N_to_use[[1]])[1]
	# make targets first
	ary_chN <-db_pf_ary_N_to_use[[1]][[1]]
	targets <- matrix('', nrow=length(ary_chN), ncol=2, dimnames=list(names(ary_chN), c('Cy3', 'Cy5')) )
	i <- 0
	cnm <- c()
	R <- G <- Rb <- Gb <- rnm <- NULL
	for (ary in names(ary_chN)) {
		i <- i+1
		chnms <- sort(names(ary_chN[[ary]]))
		targets[i, ] <- c(ary_chN[[ary]][[chnms[1]]], ary_chN[[ary]][[chnms[2]]])
		# read RG data from database
		cnm <- c(cnm, dbGetQuery(con, paste('SELECT identifier FROM ', dbnm, '.array WHERE id=', ary, sep=''))$identifier[1])
		dt <- dbGetQuery(con, paste('SELECT probe_id, fg, bg FROM ', dbnm, '.intensity WHERE array_id=', ary, ' AND channel_No=', chnms[1], ' ORDER BY probe_id', sep='') )
		R <- cbind(R, dt$fg)
		Rb <- cbind(Rb, dt$bg)
		dt <- dbGetQuery(con, paste('SELECT probe_id, fg, bg FROM ', dbnm, '.intensity WHERE array_id=', ary, ' AND channel_No=', chnms[2], ' ORDER BY probe_id', sep='') )
		G <- cbind(G, dt$fg)
		Gb <- cbind(Gb, dt$bg)
		}
	colnames(R) <- cnm
	colnames(Rb) <- cnm
	colnames(G) <- cnm
	colnames(Gb) <- cnm
	pfinfo <- getPrinter(dbnm, pf, con)
	RG <- new("RGList", list(R=R, Rb=Rb, G=G, Gb=Gb, genes=pfinfo$genes, printer=pfinfo$printer))

	# select ref here
	DesignMat <- modelMatrix(targets, ref=ref)

	# validate DesignMat
	if (any(apply(!DesignMat, 1, all)) || any(apply(!DesignMat, 2, all)) ) { 
		use_ratio <- FALSE
		# with rows or cols all equal to zero
		# seperate channels
		targetsC <- targetsA2C(targets)
		u <- unique(targetsC$Target)
		f <- factor(targetsC$Target, levels=u)
		DesignMat <- model.matrix(~0+f)
		colnames(DesignMat) <- u
		ContrastMat <- makeContrasts(contrasts=contrasts, levels=DesignMat)
		}
	else { # use ratio
		use_ratio <- TRUE
		# remove ref name from contrasts
		contrasts <- sub(paste('-[[:space:]]*', ref, sep=''), '', contrasts) 
		contrasts <- sub(paste(ref, '[[:space:]]*-', sep=''), '', contrasts) 
		## get grp_nm 
		#grp_nm <- unique(targets)
		#grp_nm[grp_nm == ref] <- NA
		#grp_nm <- sort(grp_nm) # remove NA

		# make contrast matrix
		#ContrastsMat <- makeContrasts(contrasts=contrasts, levels=grp_nm)
		ContrastMat <- makeContrasts(contrasts=contrasts, levels=DesignMat)
		}

	pfinfo <- dbGetQuery(con, paste('SELECT replicate, space FROM ', dbnm, '.platform WHERE id=', pf, sep=''))

	params$use_ratio <- use_ratio
	params$data <- RG
	params$targets <- targets
	params$design <- DesignMat
	params$contrasts <- ContrastMat
	params$replicate <- pfinfo$replicate[1]
	params$space <- pfinfo$space[1]
	params$bg_correct <- 'none'
	params$norm_in_array <- 'none'
	params$norm_in_pf <- 'none'

	invisible(params)
	}

getCtrlPf <- function(norm_in_array) {
	# find platform that need get control probes for normalization in array
	mtds <- c('composite', 'control')
	pf_ctrl <- list()
	for (dbnm in names(norm_in_array)) {
		pfs <- lapply(norm_in_array[[dbnm]], function(x) x %in% mtds )
		pfs <- pfs[unlist(pfs)]
		if (length(pfs) > 0) pf_ctrl[[dbnm]] <- pfs
		}
	pf_ctrl
	}

readGrps <- function(params, con=NULL) { 

	if (IN_DEBUG_MODE) cat('\n\n----Started-----', file=DEBUG_FN, append=TRUE)
	
	grps <- params$grps
	merge_method <- params$merge_method
	bg_correct <- params$bg_correct
	norm_in_array <- params$norm_in_array
	norm_in_pf <- params$norm_in_pf
	norm_x_pf <- params$norm_x_pf
	XPF <- params$XPF
	match_probe <- params$match_probe
	MatchLines <- params$MatchLines
	xpf_names <- params$xpf_names
	use_ratio <- params$use_ratio
	nproc <- if(is.null(params$nproc)) 1 else params$nproc
	use_rma <- if(is.null(params$use_rma)) FALSE else params$use_rma
	
	#plot_chart <- TRUE #params$plot_chart
	plot_chart <- params$plot_chart
	if (.Platform$OS.type == 'windows') params$plot_pdf <- TRUE
	plot_pdf <- params$plot_pdf
	file_sep <- .Platform$file.sep
	chart_dir <- paste(params$result_dir, ifelse(substr(params$result_dir,nchar(params$result_dir),nchar(params$result_dir))==file_sep, 'chart', paste(file_sep, 'chart', sep='') ), file_sep, sep='')
	#chart_prefix <- paste(chart_dir, params$req_name, '_', sep='')
	#chart_prefix <- mkFn(chart_dir, params$req_name, '_')
	chart_prefix <- mkFn(chart_dir)
	params$chart_dir <- chart_dir
	params$chart_prefix <- chart_prefix

	#if (!grps) return
	#else if (!is.list(grps[[1]])) {
	#	if (length(grps) != 2) return
	#	grps <- list(grps) 
	#	}
	# read intensity

	if (is.null(con)) con <- dbConnect(dbDriver('MySQL'), host=params$host, port=params$port, user=params$user, password=params$password)
	params$host <- NULL
	params$port <- NULL
	params$user <- NULL
	params$password <- NULL

	#con <<- con


	FG <- NULL
	BG <- NULL
	GRP <- vector()
	i_grp <- 0
	i_ary <- 0

	# sort out the relationship among bg_correct, norm_in_array and norm_in_pf, e.g. VSN require raw data without background correction.
	opts <- correctOpts(bg_correct, norm_in_array, norm_in_pf, norm_x_pf)
	params$bg_correct <- bg_correct <- opts$bg_correct
	params$norm_in_array <- norm_in_array <- opts$norm_in_array
	params$norm_in_pf <- norm_in_pf <- opts$norm_in_pf

	# decide which dbnm_pf_array_chN should be fetched
	dt <- getChIDs(grps, norm_in_array=norm_in_array, norm_in_pf=norm_in_pf, norm_x_pf=norm_x_pf, con=con) # {dbnm:{pf:{ary:{chN:pf_id, ... }, ... }, ... }, ...}
	db_pf_ary_N_to_use <- dt$db_pf_ary_N_to_use
	db_pf_ary_N <- dt$db_pf_ary_N
	params$norm_in_array <- norm_in_array <- dt$norm_in_array

	## check if all arrays are two-color
	#if (!XPF && use_ratio && params$analysis_method=='LIMMA') { # only one platform
	#	ary_N <- db_pf_ary_N_to_use[[1]][[1]]
	#	if (all(unlist(lapply(ary_N, length))==2)) {# use two-color method
	#		LimmaDT <- getLimmaRG(params, db_pf_ary_N_to_use, con)
	#		dbDisconnect(con)
	#		return(LimmaDT)
	#		}
	#	}

	# find platform that need get control probes for normalization in array ('composite' and 'control')
	db_pf_ctrl <- getCtrlPf(norm_in_array) 

	# now read array data into db_pf_M
	if (length(bg_correct)>0) dt <- getChDTs(db_pf_ary_N, con, bg_correct=bg_correct, db_pf_ctrl=db_pf_ctrl, plot_chart=plot_chart, plot_pdf=plot_pdf, chart_prefix=chart_prefix, use_rma=use_rma)
	else dt <- getChDTs(db_pf_ary_N, con, db_pf_ctrl=db_pf_ctrl, plot_chart=plot_chart, plot_pdf=plot_pdf, chart_prefix=chart_prefix, use_rma=use_rma)
	db_pf_M <- dt$db_pf_M
	printers <- dt$printers
	db_pf_arynm <- dt$db_pf_arynm
	db_pf_nm <- dt$db_pf_nm
	db_pf_ctrl <- dt$db_pf_ctrl

	#db_pf_ary_N <<-db_pf_ary_N# norm_in_array

	if (IN_DEBUG_MODE) cat('\nGot data', file=DEBUG_FN, append=TRUE)

	# norm_in_array
	if (length(norm_in_array)>0) {
		db_pf_M <- normChsInArray(db_pf_M, con, norm_in_array, printers, controls=db_pf_ctrl)
		if (plot_chart) plotDbPfM(db_pf_M, norm_in_array, file_prefix=chart_prefix, db_pf_arynm=db_pf_arynm, db_pf_nm=db_pf_nm, db_pf_ary_ch=db_pf_ary_N, data_stage='_normalized_in_array_', plot_pdf=plot_pdf)
		}

	if (IN_DEBUG_MODE) cat('\nNormalized in array', file=DEBUG_FN, append=TRUE)

	# norm_in_pf
	if (length(norm_in_pf)>0) {
		db_pf_M <- normChsInPf(db_pf_M, db_pf_ary_N_to_use, db_pf_ary_N, norm_in_pf, wd=params$wd)
		#if (plot_chart) plotDbPfM(db_pf_M, norm_in_pf, file_prefix=chart_prefix, db_pf_arynm=db_pf_arynm, db_pf_nm=db_pf_nm, db_pf_ary_ch=db_pf_ary_N_to_use, data_stage='_normalized_in_platform_', plot_pdf=plot_pdf)
		if (plot_chart) plotDbPfM(db_pf_M, norm_in_pf, file_prefix=chart_prefix, db_pf_arynm=db_pf_arynm, db_pf_nm=db_pf_nm, db_pf_ary_ch=db_pf_ary_N, data_stage='_normalized_in_platform_', plot_pdf=plot_pdf)
		}

	if (IN_DEBUG_MODE) cat('\nNormalized in platform', file=DEBUG_FN, append=TRUE)

	if (XPF) {
		if (match_probe) {
			# Now it was convert to str in python
			## convert probe_id from int to char
			#for (dbnm in names(MatchLines)) 
			#	for (pf in names(MatchLines[[dbnm]]))
			#		MatchLines[[dbnm]][[pf]] <- lapply(MatchLines[[dbnm]][[pf]], as.character)
			if (IN_DEBUG_MODE) cat('\nMatchLines', file=DEBUG_FN, append=TRUE)

			xpf_names <- unlist(xpf_names) # be careful, unlist will remove NULL items
			# prepare len, each, times
			len <- each <- times <- NULL
			rep_param <- getRepParam(merge_method, MatchLines)
			if (IN_DEBUG_MODE) cat('\ngetRepParam', file=DEBUG_FN, append=TRUE)

			for (nm in names(rep_param)) assign(nm, rep_param[[nm]]) # assign values in rep_param to len, each, times
			}
		if (IN_DEBUG_MODE) cat('\nBefore cutLines', file=DEBUG_FN, append=TRUE) 
		if (norm_x_pf %in% RG_norm_mtd){
			if (match_probe) db_pf_M <- cutLines(db_pf_M, db_pf_ary_N, MatchLines, merge_method, len, each, times, min_proc=nproc)

			# normalize here
			# make RGList
			col_n <- 0
			db_pf_colidx <- lapply(db_pf_M, function(pfLST) lapply(pfLST, function(aryM) {rlt <- seq(ncol(aryM))+col_n; col_n <<- col_n+ncol(aryM); return(rlt) } ) )
			RG <- NULL
			lapply(unlist(db_pf_M, recursive=FALSE), function(x) RG <<- cbind(RG, x))
			Ridx <- (seq(ncol(RG)) %% 2) == 0
			RG <- new('RGList', list(R=RG[, Ridx], G=RG[, !Ridx]))
			RG <- RG.MA(normalizeBetweenArrays(RG, method=norm_x_pf))
			RG <- RG2M(RG)
			# put back to db_pf_M
			for (dbnm in names(db_pf_M)) 
				for (pfid in names(db_pf_M[[dbnm]])) 
					dimnms <- dimnames(db_pf_M[[dbnm]][[pfid]])
					db_pf_M[[dbnm]][[pfid]] <- RG[, db_pf_colidx[[dbnm]][[pfid]]]
					dimnames(db_pf_M[[dbnm]][[pfid]]) <- dimnms
			}
		else
			if (match_probe) db_pf_M <- cutLines(db_pf_M, db_pf_ary_N_to_use, MatchLines, merge_method, len, each, times, min_proc=nproc)
		if (IN_DEBUG_MODE) cat('\nAfter cutLines', file=DEBUG_FN, append=TRUE)
		}

	db_nms <- c()
	pf_nms <- c()
	pf_ids <- c()
	array_nms <- c()
	array_ids <- c()
	chNs <- c()
	samp_nms <- c()
	samp_ids <- c()
	samp_orgs <- c()
	samp_tis <- c()
	samp_gends <- c()
	samp_ages <- c()
	samp_desps <- c()
	samp_users <- c()
	individual_ids <- c()
	dyes <- c()
	pb_nms <- NULL
	ind_strs <- list()
	tis_strs <- list()
	gend_strs <- list()
	age_strs <- list()
	iloc <- list(int=3, float=4, string=5)

	for (dbnm in names(db_pf_M)) {
		sampcols <- dbGetQuery(con, paste('DESCRIBE ', dbnm, '.sample', sep=''))$Field
		ind_strs[[dbnm]] <- if ('individual_id' %in% sampcols) ', s.individual_id' else ', s.strain AS individual_id'
		tis_strs[[dbnm]] <- if ('tissue' %in% sampcols) ', s.tissue' else ', ""'
		gend_strs[[dbnm]] <- if ('gender' %in% sampcols) ', s.gender' else ', ""'
		age_strs[[dbnm]] <- if ('age' %in% sampcols) ', s.age' else ', ""'
		}
	for (grp in grps) {
		i_grp <- i_grp + 1
		for (ary in grp) {
			i_ary <- i_ary + 1
			db_nms[i_ary] <- dbnm <- ary[[1]]
			pf_ids[i_ary] <- pf_id <- ary[[2]]
			array_ids[i_ary] <- array_id <- ary[[3]]
			chN <- ary[[4]]

			# get array, sample and other information
			#array_nm <- dbGetQuery(con, paste('SELECT identifier FROM ', dbnm, '.array WHERE id=', array_id, sep=''))[1,1]
			#infos <- dbGetQuery(con, paste('SELECT a.identifier, s.id, s.name, s.individual_id, x.dye, p.name FROM ', dbnm, '.array a, ', dbnm, '.sampxref x, ', dbnm, '.sample s, ', dbnm, '.platform p WHERE a.id=', array_id, ' AND x.array_id=', array_id, ' AND x.channel_No=', chN, ' AND x.sample_id=s.id AND a.platform_id=p.id', sep=''))
			#sql <- paste('SELECT a.identifier, s.id, s.name, ', ind_strs[[dbnm]], 'x.dye, p.name FROM ', dbnm, '.array a, ', dbnm, '.sampxref x, ', dbnm, '.sample s, ', dbnm, '.platform p WHERE a.id=', array_id, ' AND x.array_id=', array_id, ' AND x.channel_No=', chN, ' AND x.sample_id=s.id AND a.platform_id=p.id', sep='')
			sql <- paste('SELECT p.name, a.identifier, x.dye, s.id, s.name, s.organism, s.description', ind_strs[[dbnm]], tis_strs[[dbnm]], gend_strs[[dbnm]], age_strs[[dbnm]], ' FROM ', dbnm, '.array a, ', dbnm, '.sampxref x LEFT JOIN ', dbnm, '.sample s ON x.sample_id=s.id, ', dbnm, '.platform p WHERE a.id=', array_id, ' AND x.array_id=', array_id, ' AND x.channel_No=', chN, ' AND a.platform_id=p.id', sep='')
			infos <- dbGetQuery(con, sql)
			pf_nms[i_ary] <- infos[1,1]
			array_nm <- infos[1,2]
			array_nms[i_ary] <- array_nm
			chNs[i_ary] <- chN #infos[1,2]
			dyes[i_ary] <- infos[1,3]
			samp_ids[i_ary] <- infos[1,4]
			samp_nms[i_ary] <- infos[1,5]
			samp_orgs[i_ary] <- infos[1,6]
			samp_desps[i_ary] <- infos[1,7]
			individual_ids[i_ary] <- infos[1,8]
			samp_tis[i_ary] <- infos[1,9]
			samp_gends[i_ary] <- infos[1,10]
			samp_ages[i_ary] <- infos[1,11]
			# get user-defined properties
			infos <- dbGetQuery(con, sprintf('SELECT df.col_type, df.col_name, d.value_int, d.value_float, d.value_str FROM %s.dyncoldef df, %s.dyncol d WHERE df.id=d.col_id AND d.rec_id=%d AND df.tb_name="sample" ORDER BY df.col_name', dbnm, dbnm, samp_ids[i_ary]))
			samp_users[i_ary] <- if (nrow(infos) <= 0) '' else paste(sapply(seq(nrow(infos)), function(x) paste(infos[x, 2], infos[x, iloc[[infos[x, 1]]]], sep='=')), collapse='; ')

			# get array data
			##col_nm <- paste(dbnm, array_nm, chN, sep='_')
			#array_dt <- dbGetQuery(con, paste('SELECT probe_id, fg, bg FROM ', dbnm, '.intensity WHERE array_id=', array_id, ' AND channel_No=', chN, sep='') )
			#rnm <- array_dt$probe_id
			#array_dt <- cbind(fg=array_dt$fg, bg=array_dt$bg)
			#rownames(array_dt) <- rnm
			
			# get data from db_pf_M
			#array_dt <- cbind(fg=db_pf_ary_N[[dbnm]][[pf_id]][[array_id]][[chN]])
			array_dt <- cbind(fg=db_pf_M[[dbnm]][[pf_id]][, paste(array_id, chN, sep='.')])
			#array_dt <- array_dt) #, bg=array_dt)

			#if (XPF) { # filter array_dt by MatchLines
			#	# pf_id <- as.character(array_pf[[dbnm]][[array_id]])
			#	if (merge_method %in% c("one-by-one-min", "one-by-one-max"))
			#		array_dt <- matchLines(array_dt, MatchLines[[dbnm]][[pf_id]], merge_method=merge_method, len=len)
			#	else if (merge_method == 'combination') {
			#		dbnmpfid <- paste(dbnm, pf_id, sep='_')
			#		array_dt <- matchLines(array_dt, MatchLines[[dbnm]][[pf_id]], merge_method=merge_method, each=each[,dbnmpfid], times=times[,dbnmpfid])
			#		}
			#	else 
			#		array_dt <- matchLines(array_dt, MatchLines[[dbnm]][[pf_id]], merge_method=merge_method)
			#	}

			GRP[i_ary] <- i_grp
			FG <- cbind(FG, array_dt[, 'fg'])
			#BG <- cbind(BG, array_dt[, 'bg'])
			}
		}

	#DT <- list(fg = FG, bg = BG, grp = GRP)
	#chNs <- paste('ch', chNs, sep='')
	if (length(unique(db_nms))>1) { # or length(db_nms[!duplicated(db_nms)])>1
		pf_ids <- paste(db_nms, pf_ids, sep='.')
		array_ids <- paste(db_nms, array_ids, sep='.')
		samp_ids <- paste(db_nms, samp_ids, sep='.')
		individual_ids <- paste(db_nms, individual_ids, sep='.')
		col_nm <- paste(db_nms, array_nms, chNs, sep='_')
		#col_nm <- paste(array_nms, chNs, sep='.')
		}
	else col_nm <- paste(array_nms, chNs, sep='.')

	# col_nm is "arraynm.chN" and may be used repeatly in different groups, but row.names cannot have replicates. So make it unique.
	col_nm_dup_idx <- which(duplicated(col_nm))
	if (length(col_nm_dup_idx)>0) {
		col_nm_dup <- col_nm[col_nm_dup_idx]
		n_reps <- list()
		No_rep <- rep(1, times=length(col_nm_dup))
		for (cnm_i in seq(col_nm_dup)) {
			cnm <- col_nm_dup[cnm_i]
			if (is.null(n_reps[[cnm]])) n_reps[[cnm]] <- 1
			else n_reps[[cnm]] <- No_rep[[cnm_i]] <- n_reps[[cnm]] + 1
			}
		col_nm[col_nm_dup_idx] <- paste(col_nm[col_nm_dup_idx], '.copy', No_rep, sep='')
		}
		
	colnames(FG) <- col_nm
	col_IDs <- paste(array_ids, chNs, sep='.')
	#colnames(BG) <- col_nm

	dbnm_first <- pf_id_first <- NULL # annotation information will be queried from the first platform
	probe_idx <- list()
	for (dbnm in names(db_pf_M)) {
		probe_idx[[dbnm]] <- list()
		pf_M <- db_pf_M[[dbnm]]
		for (pf_id in names(pf_M)) {
			fn <- dbGetQuery(con, paste('SELECT f.location, f.name FROM ', dbnm, '.filexref x, ', dbnm, '.fileinfo f WHERE x.tb_id=', pf_id, ' AND x.tbname="platform" AND x.file_id=f.id', sep=''))
			fn <- if (nrow(fn)>0) file.path(fn$location[1], fn$name[1]) else NULL
			probe_idx[[dbnm]][[pf_id]] <- list(pfname=db_pf_nm[[dbnm]][[pf_id]], filename=fn, row_idx=NULL) # NULL will be omitted by a list!!!
			if (is.null(dbnm_first)) { dbnm_first <- dbnm; pf_id_first <- pf_id }
			}
		}
	#FG<<-FG; BG<<-BG; xpf_names<<-xpf_names; grp<<-GRP; len<<-len
	pbinfo <- getPrinter(dbnm_first, pf_id_first, con, other_cols=c('chromosome', 'probe_start', 'probe_end', 'probe_strand', 'gene_symbol', 'gene_title', 'gene_strand')) # any one (the first one) of dbnms and pf_ids
	if (XPF && match_probe) {
		#row_idx <- matchLinesNo(pbinfo$probe_id, MatchLines[[dbnm]][[pf_id]], merge_method=merge_method, len=len, each=each, times=times, colnm=paste(dbnm, pf_id, sep='_'))
		row_idx <- matchLinesNo(pbinfo$genes$idx, MatchLines[[dbnm_first]][[pf_id_first]], merge_method=merge_method, len=len, each=each, times=times, colnm=paste(dbnm_first, pf_id_first, sep='_'))
		#probe_idx <- list()
		#probe_idx[[dbnm_first]] <- list()
		probe_idx[[dbnm_first]][[pf_id_first]][['row_idx']] <- row_idx
		for (dbnm in names(db_pf_M)) {
			pf_M <- db_pf_M[[dbnm]]
			#if (is.null(probe_idx[[dbnm]])) # or dbnm != dbnm_first
			#	probe_idx[[dbnm]] <- list()
			for (pf_id in names(pf_M)) {
				#if (!is.null(probe_idx[[dbnm]][[pf_id]])) next
				if (!is.null(probe_idx[[dbnm]][[pf_id]][['row_idx']])) next
				pbinfo_tmp <- getPrinter(dbnm, pf_id, con) #, other_cols=c('gene_symbol', 'gene_title')) 
				row_idx_tmp <- matchLinesNo(pbinfo_tmp$genes$idx, MatchLines[[dbnm]][[pf_id]], merge_method=merge_method, len=len, each=each, times=times, colnm=paste(dbnm, pf_id, sep='_'))
				probe_idx[[dbnm]][[pf_id]][['row_idx']] <- row_idx_tmp
				}
			}
		#rownames(FG) <- xpf_names[row_idx]
		if (nrow(FG)==length(xpf_names)) rownames(FG) <- xpf_names # no row names if there are replicates
		#rownames(BG) <- xpf_names 
		# update xpf_names to correct length since it may be used as unique_id in result table
		if (merge_method %in% c("one-by-one-min", "one-by-one-max", 'combination')) 
			xpf_names <- rep(xpf_names, times=len) # xpf_names may be used as unique_id in result table
		genes <- pbinfo$genes[row_idx, ]
		genes$xpf_names <- xpf_names
		replicate <- printer <- NULL
		# try to find the replicate and (space=1)
		idx_rep <- duplicated(xpf_names)
		pos_uni <- which(!idx_rep)
		n_uni <- length(pos_uni)
		space <- 1
		if (n_uni==1) # only one unqiue gene
			replicate <- length(xpf_names)
		else {
			spaces <- pos_uni[2:n_uni] - pos_uni[1:(n_uni-1)] # xpf_names are sorted vector!
			if (any(spaces != spaces[1])) replicate <- 1 # no regular replicates
			else replicate <- spaces[1] # regular replicate: all unique_id has the same replicate number
			}
		}
	else {
		pfinfo <- dbGetQuery(con, paste('SELECT replicate, space FROM ', dbnm_first, '.platform WHERE id=', pf_id_first, sep=''))
		replicate <-  pfinfo$replicate[1]
		space <- pfinfo$space[1]
		genes <- pbinfo$genes
		printer <- pbinfo$printer
		xpf_names <- NULL
		}

	dbDisconnect(con)

	names(GRP) <- paste('group', GRP, sep='')
	#pD <- new('phenoData', pData=data.frame(platform_name=pf_nms, platform_id=pf_ids, array_name=array_nms, array_id=array_ids, channel_No=chNs, sample_name=samp_nms, sample_id=samp_ids, dye=dyes, group=GRP, row.names=col_nm), varLabels=list(platform_name='Platform', platform_id='Platform ID', array_name='Array identifier', array_id='Array ID', channel_No='Channel No', sample_name='Sample', sample_id='Sample ID', dye='Dye', group='Group'))

	pD <- new('AnnotatedDataFrame', 
		data=data.frame(group=GRP, platform_name=pf_nms, platform_id=pf_ids, array_name=array_nms, array_id=array_ids, channel_No=chNs, dye=dyes, sample_name=samp_nms, sample_id=samp_ids, individual_id=individual_ids, organism=samp_orgs, tissue=samp_tis, gender=samp_gends, age=samp_ages, other_attrs=samp_users, row.names=col_nm), 
		varMetadata=data.frame(labelDescription=c(group='Group', platform_name='Platform', platform_id='Platform ID', array_name='Array identifier', array_id='Array ID', channel_No='Channel No', dye='Dye', sample_name='Sample', sample_id='Sample ID', individual_id='Individual ID', organism='Organism', tissue='Tissue', gender='Gender', age='Age', other_attrs='Other attributes')))
	#DT <- list(fg = new('exprSet', exprs=FG, phenoData=pD), bg = new('exprSet', exprs=BG, phenoData=pD))
	#DT <- list(data=new('exprSet', exprs=FG, phenoData=pD), XPF=XPF, norm_method=norm_x_pf, contrasts=contrasts, use_ratio=use_ratio, replicate=replicate, space=space)
	#DT <- new('exprSet', exprs=FG, phenoData=pD)
	if (XPF) { # normalize across platform
		# norm_x_pf
		mtd_to_do <- c("none", "mrs", "qd", "gq", "mrsMod", "qdMod", "scale", "quantile", "Aquantile", "Gquantile", "Rquantile", "Tquantile", "vsn")
		#mtd_to_do <- c("none", "mrs", "qd", "gq", "mrsMod", "qdMod", "scale", "quantile", "Tquantile", "vsn") # RG_norm_mtd has been done above
		if (!(norm_x_pf %in% mtd_to_do) ) norm_x_pf <- 'none'

		#DT <- crossPlatformNormalization(norOpt=norm_x_pf, unNorDT=exprs(DT), pData=pData(DT), nBin=params$nbin)
		#DT <- new('exprSet', exprs=DT$exprs, phenoData=new('phenoData', pData=DT$pData, varLabels=pD@varLabels) )
		if (norm_x_pf != 'none' && !(norm_x_pf %in% RG_norm_mtd) ) { 
			FG <- normXPF(M=FG, pf=pf_ids, mtd=norm_x_pf, nbin=params$nbin, grp=GRP, wd=params$wd)
			if (norm_x_pf %in% c("qd", "qdMod")) params$need_log_transform <- FALSE
			}
		if (plot_chart && (match_probe || norm_x_pf != 'none') ) {# && norm_x_pf != 'none') {
			if (length(db_pf_M) > 1) { # single db
				uni_ary_nm <- paste(db_nms, array_nms, sep='_')
				if (length(unique(array_nms))==length(uni_ary_nm)) uni_ary_nm <- array_nms
				}
			else uni_ary_nm <- array_nms
			proc_xpf <- if (match_probe && norm_x_pf != 'none') paste('_', params$match_method, '_aligned_', norm_x_pf, '_normalized_x_platform_', sep='') else if (match_probe) paste('', params$match_method, '_aligned_x_platform_', sep='') else paste('_', norm_x_pf, '_normalized_x_platform_', sep='')
			plotM(FG, uni_ary_nm, arychs=chNs, file_prefix=paste(chart_prefix, proc_xpf, sep=''), plot_pdf=plot_pdf, logged=!(is.null(params$need_log_transform) || params$need_log_transform) )
			}
		# correct replicated names
		#rnm <- rownames(FG)
		#if (length(rnm) != length(unique(rnm))) rownames(FG) <- NULL
		#if (any(duplicated(rownames(FG)))) rownames(FG) <- NULL
		}
	#else DT <- new('exprSet', exprs=FG, phenoData=pD)
	#DT <- new('exprSet', exprs=FG, phenoData=pD)

	# for DEBUG
	if (!is.null(params$debug_mode) && params$debug_mode) {
		if (!is.null(params$row_num) && params$row_num > 0 && params$row_num < nrow(FG)) {
			dlen <- seq(params$row_num)
			FG <- cbind(FG[dlen, ])
			genes <- cbind(genes[dlen, ])
			replicate <- 1
			space <- 1
			printer <- NULL 
			xpf_names <- xpf_names[dlen]
			probe_idx <- probe_idx[dlen]
			}
		}

	DT <- new('ExpressionSet', exprs=FG, phenoData=pD)
	
	genes$probe_left <- seq(nrow(genes))
	params$data <- DT
	params$col_IDs <- col_IDs
	params$replicate <- replicate
	params$space <- space
	params$genes <- genes
	params$printer <- printer
	params$xpf_names <- xpf_names
	params$probe_idx <- probe_idx
	params$db_pf_ary_N <- db_pf_ary_N_to_use
	params$unique_id <- if(XPF && match_probe) xpf_names else genes$unique_id
	params$n_grp <- length(grps)
	params$dbnm_first <- dbnm_first
	params$pf_id_first <- pf_id_first

	#if (params$use_ratio) {
	#	ary_N <- unlist(unlist(params$db_pf_ary_N, recursive=FALSE), recursive=FALSE)
	#	if (any(unlist(lapply(ary_N, length))!=2)) # all array have two channels
	#		params$use_ratio <- FALSE
	#	}
	
	ary_N <- unlist(unlist(params$db_pf_ary_N, recursive=FALSE), recursive=FALSE)
	params$has_two_chs <- if (all(unlist(lapply(ary_N, length))==2)) TRUE else FALSE # all array have two channels

	class(params) <- c(class(params), 'MPMDBList')
	#if (IN_DEBUG_MODE) save(params, file='/home/xxia/temp/inqInt_DT.Rdata')
	invisible(params)
	}

norm_mrs <- function(M, pf, ...) { # median rank  scores algorithm  - a modification of quantile for multi-platform data
	idx <- tapply(seq(pf), pf, function(x) x)
	if (length(pf)<=0) return(M)
	#if (length(idx)==1) return(normalizeQuantiles(M))
	imax <- which.max(sapply(idx, length)) # for reference
	ref_med_srt <- sort(apply(M[, idx[[imax]]], 1, function(x) median(x, na.rm=TRUE) ))
	idx[imax] <- NULL
	lapply(unlist(idx), function(i) M[,i] <<- ref_med_srt[rank(M[,i])])
	invisible(M)
	}

norm_mrsMod <- function(M, ...) { # NA-keeping median rank  scores algorithm
	ref_med_srt <- sort(apply(M, 1, function(x) median(x, na.rm=TRUE) ))
	#lapply(seq(ncol(M)), function(i) {MI <- M[,i]; i_avail <- !is.na(MI); M[,i][i_avail] <- ref_med_srt[rank(MI[i_avail])]) }
	lapply(seq(ncol(M)), function(i) {MI <- M[,i]; i_avail <- which(!is.na(MI)); M[,i][i_avail] <<- ref_med_srt[i_avail][rank(MI[i_avail])] } ) 
	invisible(M)
	}

norm_gq <- function(M, pf, ...) { # modified MRS
	idx <- tapply(seq(pf), pf, function(x) x)
	if (length(pf)<=1) return(M)
	#if (length(idx)==1) return(normalizeQuantiles(M))
	imax <- which.max(sapply(idx, length)) # for reference
	ref_med <- apply(M[, idx[[imax]]], 1, function(x) median(x, na.rm=TRUE))
	ref_med_srt <- sort(ref_med)
	idx[imax] <- NULL
	lapply(idx, function(i) {MTMP <- sapply(i, function(x) ref_med_srt[rank(M[,x])]); M[,i] <<- MTMP - apply(MTMP, 1, median) + ref_med } )
	invisible(M)
	}

norm_qd <- function(M, nbin, ...) { # quantile discretization algorithm
	#lapply(seq(ncol(M)), function(i) {ra <- rank(M[,i]); rlt<-as.integer(ra/(length(ra)/nbin)); M[,i] <- rlt - median(rlt)} )
	#lapply(seq(ncol(M)), function(i) {ra <- rank(M[,i]); rlt<-ceiling(ra/(length(ra)/nbin)); M[,i] <- rlt - median(rlt)} )
	ref <- c(-1*((nbin/2)-1):0, 0:((nbin/2)-1))
	ref <- ref[ceiling(seq(nrow(M))/(nrow(M)/nbin))]
	lapply(seq(ncol(M)), function(i) M[,i] <<- ref[rank(M[,i])])
	invisible(M)
	}

norm_qdMod <- function(M, nbin, ...) { # NA-keeping quantile discretization algorithm
	ref <- c(-1*((nbin/2)-1):0, 0:((nbin/2)-1))
	ref <- ref[ceiling(seq(nrow(M))/(nrow(M)/nbin))]
	lapply(seq(ncol(M)), function(i) {MI <- M[, i]; i_avail <- !is.na(MI); M[,i][i_avail] <<- ref[i_avail][rank(MI[i_avail])] } )
	invisible(M)
	}

normXPF <- function(M, pf, mtd, nbin, grp, wd) {
	switch(mtd, 
		mrs=, mrsMod=norm_mrsMod, 
		gq=norm_gq, 
		qd=, qdMod=norm_qdMod, 
		#qd=, qdMod=function(M,...) norm_qdMod(logValue(M), nbin=nbin), 
		scale=, quantile=function(M,...) normalizeBetweenArrays(M, method=mtd),
		vsn=function(M,...) 2^normalizeBetweenArrays(M, method=mtd),
		Tquantile=function(M, grp, ...) {for (g in unique(grp)) M[, grp==g] <- normalizeQuantiles(M[, grp==g]); M}, 
		PCA=function(M, wd) {source(paste(wd, 'normPCA.R', sep=.Platform$file.sep)); 2^NormPCA(logValue(M))$ND},
		function(M,...) M)(M=M, pf=pf, nbin=nbin, grp=grp, wd=wd)
	#if (mtd %in% c('mrs', 'mrsMod', 'qd', 'qdMod', 'gq') )
	#	return(switch(mtd, mrs=norm_mrs, mrsMod=norm_mrsMod, qd=norm_qd, qdMod=norm_qdMod, gq=norm_gq)(M=M, pf=pf, nbin=nbin))
	#else if (mtd %in%
	#	return(normalizeBetweenArrays(M)) #return(normalizeQuantiles(M))
	#else return(M)
	}

MyLogMean <- function(x, na.rm=TRUE) {
	x[x<=0] <- 1
	exp(mean(log(x), na.rm=na.rm))
	}

logValue <- function(M) {
	#flt <- M <= 0 | is.na(M)
	#if (any(flt)) M[flt] <- min(M[!flt])/2 # change non-positive values to half of the mininum of positive value
	flt <- which(M <= 0 | is.na(M))
	if (any(flt)) M[flt] <- min(M[-flt])/2 # change non-positive values to half of the mininum of positive value
	log2(M)
	}

analyzeSingleChannels <- function(DTList) {
	# use data (exprSet or matrix), contrasts (a vector of str), replicate, space in DTList
	DT <- if (is.null(DTList$RGMatrix)) DTList$data else DTList$RGMatrix
	if (class(DT) == 'ExpressionSet') {
		grp <- pData(DT)$group #DT@phenoData@pData$group
		DT <- exprs(DT) #exprs(DT)
		}
	else grp <- DTList$group
	if (is.null(DTList$need_log_transform) || DTList$need_log_transform) DT <- logValue(DT) # log transform
	#grp_nm <- levels(factor(DT@phenoData@pData$group_name))
	grp_nm <- names(grp)
	if (is.null(grp_nm)) {
		#grp_nm <- paste('group', factor(grp), sep='') #paste('group', levels(factor(grp)), sep='')
		grp_nm <- paste('group', grp, sep='') } 
	else { # try to get unique name for unique grp in the same order
		#nmtmp <- c()
		#for (i in seq(grp)) nmtmp[i] <- grp_nm[i]
		#grp_nm <- nmtmp[sort(unique(grp))] #levels(factor(DT@phenoData@pData$group_name))
		#grp_nm <- grp_nm[match(sort(unique(grp)), grp)]
		}
	#DesignMat <- model.matrix(~ -1+factor(grp) )
	#colnames(DesignMat) <- grp_nm
	#ContrastMat <- makeContrasts(contrasts=if(is.null(DTList$contrasts_orig)) DTList$contrasts else DTList$contrasts_orig, levels=grp_nm)
	u <- unique(grp_nm)
	u <- sort(u)
	f <- factor(grp_nm, levels=u)
	DesignMat <- model.matrix(~ -1+f)
	colnames(DesignMat) <- u
	ContrastMat <- makeContrasts(contrasts=if(is.null(DTList$contrasts_orig)) DTList$contrasts else DTList$contrasts_orig, levels=DesignMat)
	# check replicate
	genes <- DTList$genes
	ndups <- DTList$replicate
	space <- DTList$space
	if (is.null(DTList$removed_dups) || !DTList$removed_dups) {
		if (!is.null(ndups) && ndups>1) {
			if (is.null(space)) space <- 1
			corval <- try(duplicateCorrelation(DT, DesignMat, ndups=ndups, spacing=space)$consensus.correlation, silent=TRUE)
			if (('try-error' %in% class(corval)) || is.nan(corval) || corval>1 || corval<0) corval <- NULL
			genes <- rmDups4DF(DTList$genes, ndups, space)
			DTList$gpos4dups <- genes$idx
			genes <- genes$data
			}
		else {
			ndups <- space <- 1
			corval <- NULL
			genes <- DTList$genes
			#gnms <- if (DTList$XPF && DTList$match_probe) DTList$xpf_names else  genes[, 'unique_id']
			gnms <- if (is.null(genes$xpf_names)) genes[, 'unique_id'] else genes$xpf_names
			tmpM <- meanDupsIrregular(DT, geneM=genes, gnms=gnms)
			genes <- tmpM$geneM
			DT <- tmpM$M
			DTList$gpos4dups <- tmpM$gpos
			}
		}
	else ndups <- space <- 1
	fit <- lmFit(DT, DesignMat, ndups=ndups, spacing=space, correlation=corval)
	fit <- contrasts.fit(fit, ContrastMat)
	fit <- eBayes(fit)
	
	fit$genes <- genes

	colnames(fit$p.value) <- paste('p_value(', colnames(fit$p.value), ')', sep='')
	#if (DTList$XPF) {# are all columns has the same length?
	#	if (ndups>1) xpfnms <- rmDups4DF(DTList$xpf_names, ndups, space)
	#	rltb <- cbind(DTList$xpf_names, fit$p.value, F=fit$F, 'p_value(F test)'=fit$F.p.value)
	#	}
	#else {
	#	if (ndups>1) fit$genes <- rmDups4DF(fit$genes, ndups, space)
	#	rltb <- cbind(fit$genes, fit$p.value, F=fit$F, 'p_value(F test)'=fit$F.p.value)
	#	}
	#if (ndups>1) genes <- rmDups4DF(genes, ndups, space)
	DTList$fit <- fit
	return(LimmaResult(DTList, contrasts=if(is.null(DTList$contrasts_orig)) DTList$contrasts else DTList$contrasts_orig, use_ratio=FALSE))

	M <- shrinkDups(DTList)
	DTList$M <- M$M
	DTList$geneM <- M$geneM
	DTList$gpos4dups <- M$gpos
	DTList$dif_result <- LimmaResult(fit, contrasts=if(is.null(DTList$contrasts_orig)) DTList$contrasts else DTList$contrasts_orig, use_ratio=FALSE )
	DTList$dif_pvalue <- fit$F.p.value

	return(DTList)

	pval <- rbind(fit$p.value, p.adjust(fit$p.value, method='fdr'))
	dim(pval) <- c(nrow(pval)/2, ncol(pval)*2)
	colnames(pval) <- paste(c('p_value(', 'p_valFDR('), rep(colnames(fit$p.value), each=2), ')', sep='')
	rltb <- cbind(genes, F=fit$F, 'p_value(F test)'=fit$F.p.value, 'p_valFDR(F test)'=p.adjust(fit$F.p.value, method='fdr'), pval)
	#save(fit, file='/home/xxia/temp/inqInt_fit_single.Rdata')
	invisible(rltb)
	}

meanDups_old <- function(M, ndups=1, space=1) {
	if (ndups==1) return(M)
	n <- ncol(M)
	sts <- lapply(1:n, function(x) (x-1)*ndups + seq(ndups))
	M <- unwrapdups(M, ndups, space)
	M <- sapply(sts, function(x) {apply(M[, x], 1, mean)} )
	}

meanDups <- function (M, ndups = 1, spacing = 1) {
    if (ndups == 1) return(M)
    M <- as.matrix(M)
	rn <- rownames(M)
	cn <- colnames(M)
    nspots <- dim(M)[1]
    nslides <- dim(M)[2]
    ngroups <- nspots/ndups/spacing
    dim(M) <- c(spacing, ndups, ngroups, nslides)
    #M <- aperm(M, perm = c(1, 3, 2, 4))
    #dim(M) <- c(spacing * ngroups, ndups * nslides)
	M <- apply(M, c(1,3,4), mean)
	dim(M) <- c(spacing*ngroups, nslides)
	if (!is.null(rn)) rownames(M) <- rmDups(rn, ndups, spacing)
	if (!is.null(cn)) colnames(M) <- cn
    invisible(M)
	}

rmDups <- function(M, ndups=1, spacing=1) {
    if (ndups == 1) return(M)
    M <- as.matrix(M)
	rn <- rownames(M)
	cn <- colnames(M)
    nspots <- dim(M)[1]
    nslides <- dim(M)[2]
    ngroups <- nspots/ndups/spacing
    dim(M) <- c(spacing, ndups, ngroups, nslides)
	M <- M[,1,,]
	dim(M) <- c(spacing*ngroups, nslides)
	if (!is.null(rn)) rownames(M) <- rmDups(rn, ndups, spacing)
	if (!is.null(cn)) colnames(M) <- cn
	invisible(M)
	}

rmDups4DF <- function(DF, ndups=1, spacing=1) {
	# DF is a data frame
	if (ndups == 1) return(DF)
	idx <- rmDups(seq(nrow(DF)), ndups, spacing)
	invisible(list(data=DF[idx,], idx=idx))
	}

mkRGList <- function(params) {
	# assume all pf are two channels
	M <- exprs(params$data) # data is a ExpressionSet
	db_pf_ary_N_to_use <- params$db_pf_ary_N
	contrasts <- params$contrasts_orig <- params$contrasts
	ref <- params$ref_name
	# make targets first
	nm_grps <- db_pf_ary_N_to_use
	if (length(nm_grps)==1) 
		names(nm_grps) <- NULL # don't need dbnm if just one db is used
	nm_grps <- lapply(nm_grps, function(x) {names(x) <- NULL; x}) # remove platform name
	ary_nms <- unlist(unlist(nm_grps, recursive=FALSE), recursive=FALSE)
	ary_nms <- lapply(ary_nms, function(x) 1)
	ary_nms <- names(unlist(ary_nms))
	nm_grps <-unlist(nm_grps)
	#targets <- t(matrix(nm_grps, nrow=2, dimnames=list(c('Cy3', 'Cy5'), ary_nms)))
	targets <- matrix(nm_grps, ncol=2, byrow=TRUE, dimnames=list(ary_nms, c('Cy3', 'Cy5')))
	nm_grps <- names(nm_grps)
	posG <- as.logical(seq(ncol(M)) %% 2)
	nm_G <- nm_grps[posG]
	nm_R <- nm_grps[!posG]
	colnames(M) <- params$col_IDs
	G <- M[, nm_G]
	R <- M[, nm_R]
	RG <- new("RGList", list(R=R, G=G, genes=params$genes, printer=params$printer))
		
	# select ref here
	DesignMat <- try(modelMatrix(targets, ref=ref))
	# validate DesignMat
	if ('try-error' %in% class(DesignMat) || any(apply(!DesignMat, 1, all)) || any(apply(!DesignMat, 2, all)) ) { 
		use_ratio <- FALSE
		# with rows or cols all equal to zero
		# seperate channels
		targetsC <- targetsA2C(targets)
		u <- unique(targetsC$Target)
		f <- factor(targetsC$Target, levels=u)
		DesignMat <- model.matrix(~0+f)
		colnames(DesignMat) <- u
		ContrastMat <- makeContrasts(contrasts=contrasts, levels=DesignMat)
		}
	else { # use ratio
		use_ratio <- TRUE
		# remove ref name from contrasts
		#contrasts <- sub(paste('-[[:space:]]*', ref, sep=''), '', contrasts) 
		#contrasts <- sub(paste(ref, '[[:space:]]*-', sep=''), '', contrasts) 
		# remove " - ref"
		contrasts <- gsub(paste('\\s*-\\s*\\b', ref, '\\b\\s*', sep=''), '', contrasts, perl=TRUE) 
		# remove leading "ref"
		contrasts <- gsub(paste('^\\s*\\+?\\s*\\b',ref, '\\b\\s*\\+?\\s*', sep=''), '', contrasts) 
		# remove middle " + ref"
		contrasts <- gsub(paste('\\s*\\+?\\s*\\b',ref, '\\b\\s*', sep=''), '', contrasts) 
		# make contrast matrix
		ContrastMat <- makeContrasts(contrasts=contrasts, levels=DesignMat)
		}
	params$use_ratio <- use_ratio
	#params$data <- RG
	params$RG <- RG
	params$targets <- targets
	params$design <- DesignMat
	params$contrasts <- ContrastMat
	params$bg_correct <- params$norm_in_array <- params$norm_in_pf <- 'none'
	#params$norm_in_array <- params$norm_in_array[[dbnm]][[pf]]
	#params$norm_in_pf <- params$norm_in_pf[[dbnm]][[pf]]

	logWithString(paste('\nuse_ratio:', use_ratio, '\n'))
	logWithTable(DesignMat)
	logWithTable(ContrastMat)

	invisible(params)
	}


analyzeDualChannels <- function(DTList) {
	RG <- DTList$data
	if (!('RGList' %in% class(RG))) { # make RGList
		DTList <- mkRGList(DTList)
		RG <- DTList$RG
		}
	#bg_correct <- DTList$bg_correct
	#norm_in_array <- DTList$norm_in_array
	#norm_in_pf <- DTList$norm_in_pf
	DesignMat <- DTList$design
	ContrastMat <- DTList$contrasts
	ndups <- DTList$replicate
	space <- DTList$space
	use_ratio <- DTList$use_ratio
	#DTList <<- DTList; return(DTList)
	#if (norm_in_pf == 'vsn') MA <- normalizeBetweenArrays(RG, method=norm_in_pf)
	#else {
	#	MA <- normalizeWithinArrays(RG, method=norm_in_array, bc.method=bg_correct)
	#	if (norm_in_pf != 'none') MA <- normalizeBetweenArrays(MA, method=norm_in_pf)
	#	}
	MA <- MA.RG(RG)
	#RG <- RG.MA(MA)

	doSingle <- function() {
		# make grp
		grp_nm <<- grp_nm <- as.vector(DTList$targets)
		grp_nms <- sort(unique(grp_nm))
		grp_idx <- seq(grp_nms)
		names(grp_idx) <- grp_nms
		grp <- grp_idx[grp_nm]
		names(grp) <- grp_nm
		DTList$group <- grp
		#DTList$genes <- RG$genes
		#DTList$printer <- RG$printer
		# makd data matrix
		RG <- RG.MA(MA)
		DTList$genes <- RG$genes
		DT <- cbind(RG$G, RG$R)
		colnames(DT) <- grp_nm
		#DTList$data <- DT
		DTList$RGMatrix <- DT
		DTList$removed_dups <- RG$removed_dups
		DTList$gpos4dups <- RG$gpos4dups
		return(analyzeSingleChannels(DTList))
		}

	if (!use_ratio) {
		# make a mean for within-array replicates
		if (!is.null(ndups) && ndups>1) {
			if (is.null(space)) space <- 1
			#MA$M <- meanDups(MA$M, ndups, space)
			#MA$A <- meanDups(MA$A, ndups, space)
			MA <- avedups(MA, ndups=ndups, spacing=space)
			}
		corval <- try(intraspotCorrelation(MA, DesignMat)$consensus, silent=TRUE)  # calculate correlation between two channels
		#corval <- 0.57 # 3
		if (!('try-error' %in% class(corval)) && !is.nan(corval) && corval<1 && corval>-1){
			fit <- try(lmscFit(MA, DesignMat, correlation=corval))
			if ('try-error' %in% class(fit)) return(doSingle()) }
		else return(doSingle()) # use analyzeSingleChannels
		}
	else {
		if (!is.null(ndups) && ndups>1) {
			if (is.null(space)) space <- 1
			corval <- try(duplicateCorrelation(MA, DesignMat, ndups=ndups, spacing=space)$consensus.correlation)
			if ('try-error' %in% class(corval)) return(doSingle())
			#corval <- 0.60
			}
		else {
			ndups <- space <- 1
			corval <- NULL 
			#gnms <- if (DTList$XPF && DTList$match_probe) DTList$xpf_names else  DTList$genes[, 'unique_id']
			gnms <- if (is.null(DTList$genes$xpf_names)) DTList$genes[, 'unique_id'] else DTList$genes$xpf_names
			tmpM <- meanDupsIrregular(MA$M, geneM=MA$genes, gnms=gnms)
			MA$M <- tmpM$M
			MA$genes <- tmpM$geneM
			tmpM <- meanDupsIrregular(MA$A, gpos=tmpM$gpos)
			MA$A <- tmpM$M
			MA$removed_dups <- TRUE
			MA$gpos4dups <- tmpM$gpos

			}
		fit <- try(lmFit(MA, DesignMat, ndups=ndups, spacing=space, correlation=corval))
		if ('try-error' %in% class(fit)) return(doSingle())
		}
	# may need lmscFit here
	#RG <<- RG; MA <<- MA; DesignMat <<- DesignMat; ContrastMat <<- ContrastMat; ndups <<- ndups; space <<- space; corval <<- corval
	fit <- try(contrasts.fit(fit, ContrastMat))
	if ('try-error' %in% class(fit)) return(doSingle())
	fit <- try(eBayes(fit))
	if ('try-error' %in% class(fit)) return(doSingle())
	#colnames(fit$p.value) <- DTList$contrasts_orig
	#if (ndups>1) fit$genes <- rmDups4DF(fit$genes, ndups, space)
	fit$corval <- corval
	#save(fit, file='/home/xxia/temp/inqInt_fit.Rdata')
	#colnames(fit$p.value) <- paste('p_value(', colnames(fit$p.value), ')', sep='')
	DTList$fit <- fit
	if (!use_ratio && !is.null(ndups) && ndups==1) DTList$gpos4dups <- tmpM$gpos
	return(LimmaResult(DTList, contrasts=DTList$contrasts_orig, use_ratio=TRUE))

	M <- shrinkDups(DTList)
	DTList$M <- M$M
	fit$MEAN <- apply(M$M, 1, mean, na.rm=TRUE)
	DTList$geneM <- M$geneM
	DTList$gpos4dups <- M$gpos
	DTList$dif_result <- LimmaResult(fit, contrasts=DTList$contrasts_orig, use_ratio=TRUE)
	DTList$dif_pvalue <- fit$F.p.value
	return(DTList)
	}

getAverageM <- function(M, grps, fun=mean, prefix='Average value (mean of ') {
	# mean of all channels
	MEAN <- if (identical(fun, mean)) rowMeans(cbind(M)) else apply(M, 1, fun, na.rm=TRUE) 
	# mean of each group
	uni_grps <- sort(unique(grps))
	MEAN <- if (identical(fun, mean)) cbind(MEAN, sapply(uni_grps, function(x) rowMeans(cbind(M[, grps==x])))) else cbind(MEAN, sapply(uni_grps, function(x) apply(cbind(M[, grps==x]), 1, fun, na.rm=TRUE)))
	colnames(MEAN) <- paste(prefix, c('all channels', paste('group', uni_grps, sep='')), ')', sep='')
	MEAN
	}

LimmaResult <- function(DTList, contrasts, use_ratio=TRUE) {
	fit <- DTList$fit
	M <- shrinkDups(DTList)
	grps <- if (is.null(DTList$group)) pData(DTList$data)$group else DTList$group
	fit$MEAN <- getAverageM(M$M, grps) 
	DTList$M <- M$M
	DTList$geneM <- M$geneM
	DTList$gpos4dups <- M$gpos

	pval <- rbind(fit$coef, fit$p.value, apply(fit$p.value, 2, function(x) p.adjust(x, method='fdr')) )
	dim(pval) <- c(nrow(pval)/3, ncol(pval)*3)
	colnames(pval) <- paste(c('M(', 'p_value(', 'p_valFDR('), rep(contrasts, each=3), ')', sep='')
	if (use_ratio) {
		if (is.null(fit$MEAN)) rltb <- cbind(fit$genes, 'F(by ratio)'=fit$F, 'p_value(F test)'=fit$F.p.value, 'p_valFDR(F test)'=p.adjust(fit$F.p.value, method='fdr'), pval)
		else rltb <- cbind(fit$genes, fit$MEAN, 'F(by ratio)'=fit$F, 'p_value(F test)'=fit$F.p.value, 'p_valFDR(F test)'=p.adjust(fit$F.p.value, method='fdr'), pval)
		}
	else {
		if (is.null(fit$MEAN)) rltb <- cbind(fit$genes, 'F(by intensity)'=fit$F, 'p_value(F test)'=fit$F.p.value, 'p_valFDR(F test)'=p.adjust(fit$F.p.value, method='fdr'), pval)
		else rltb <- cbind(fit$genes, fit$MEAN, 'F(by intensity)'=fit$F, 'p_value(F test)'=fit$F.p.value, 'p_valFDR(F test)'=p.adjust(fit$F.p.value, method='fdr'), pval)
		}
	#invisible(rltb)
	DTList$fit <- NULL
	DTList$dif_result <- rltb
	DTList$dif_pvalue <- fit$F.p.value
	return(DTList)
	}

analyzeXPF <- function(DTList) { # no use now
	user_params <- DTList # used by mpmdb_code.R for wd
	source(file.path(DTList$wd, 'mpmdb_code.R')) # or paste(DTList$wd, 'mpmdb_code.R', sep=.Platform$file.sep)
	norOpt <- DTList$norm_x_pf
	nBin <- DTList$nbin
	anaOpt <- DTList$analysis_method
	DT <- exprs(DTList$data)
	pData <- pData(DTList$data)
	if (!(norOpt %in% c("unNor", "mrs", "qd", "gq", "mrsMod", "qdMod")) ) norOpt <- 'unNor'
	DT <- crossPlatformNormalization(norOpt=norOpt, unNorDT=DT, pData=pData, nBin=nBin)
	# DT <- crossPlatformAnalysis(anaOpt="ANOVA", norDT=DT)
	
	# analyze XPF
	
	res <- t(apply(DT, 1, prob.test))
	res <- metaAna(DT,TRUE)
	invisible(res)
	}

getExprs <- function(DTList) {
	M <- exprs(DTList$data)
	if (!(DTList$norm_x_pf %in% c('qd', 'qdMod')) && (is.null(DTList$need_log_transform) || DTList$need_log_transform) ) M <- logValue(M)
	}

shrinkDups <- function(DTList, M=exprs(DTList$data)) {
	if (missing(M) && !(DTList$XPF && DTList$norm_x_pf %in% c('qd', 'qdMod')) && (is.null(DTList$need_log_transform) || DTList$need_log_transform) ) M <- logValue(M)
	#if (DTList$XPF && DTList$match_probe) {
	#	geneM <- cbind(DTList$genes, xpf_names=DTList$xpf_names)
	#	gnms <- DTList$xpf_names }
	#else {
	#	geneM <- DTList$genes
	#	gnms <- geneM[, 'unique_id'] }
	geneM <- DTList$genes
	gnms <- if (is.null(geneM$xpf_names)) geneM[, 'unique_id'] else geneM$xpf_names 
	gpos <- DTList$gpos4dups

	# replicate
	replicate <- DTList$replicate
	if (is.null(replicate)) replicate <- 1
	if (replicate>1) { # regular replicate
		space <- DTList$space
		if (is.null(space)) space <- 1
		#block_rep <- rep(1:length(pfs), each=replicate) #gl(replicate, 1, length(grps))
		#pfs <- rep(pfs, each=replicate)
		#arys <- rep(arys, each=replicate)
		#grps <- rep(grps, each=replicate)
		#M <- unwrapdups(M, replicate, space) # now with ndups * n_col_orig columns
		M <- meanDups(M, replicate, space) 
		geneM <- rmDups4DF(geneM, replicate, space) # remove replicate gene names
		gpos <- geneM$idx
		geneM <- geneM$data
		#rlt <- apply(M, 1, fun)
		#rlt <- list(M=M, geneM=geneM)
		rlt <- list(M=M, geneM=geneM, gpos=gpos)
		}
	else { # irregular replicate or not replicate
		rlt <- meanDupsIrregular(M, geneM=geneM, gnms=gnms, gpos=gpos)
		}
	invisible(rlt)	
	}

meanDupsIrregular <- function(M, geneM=NULL, gnms=NULL, gpos=NULL) {
	# check if there's replicate
	getMean <- function(i) {
		if (length(i) == 1) return(M[i,])
		return(colMeans(cbind(M[i,]), na.rm=TRUE))
		return(apply(M[i,], 2, mean, na.rm=TRUE))
		}
	if (is.null(gpos)) { # use gpos prior to gnms
		if (is.null(gnms)) return(list(M=M, geneM=geneM))
		uninms <- unique(gnms)
		if (length(gnms) != length(uninms)) { # irregular replicate #rlt <- apply(M, 1, fun)		
			fgpos <- factor(gnms, levels=uninms)
			gpos <- tapply(seq(gnms), fgpos, function(x) x) # gpos is a list of pos, with uninm as names
			}
		else return(list(M=M, geneM=geneM)) #no dups 
		}
	cols <- if(is.null(dim(M))) 1 else ncol(M)
	cnm <- colnames(M)
	M <- sapply(gpos, getMean) # get mean value of replicates
	M <- if (cols == 1) cbind(M) else t(M)
	colnames(M) <- cnm
	if (!is.null(geneM)) {
		unipos <- sapply(gpos, function(x) x[1])
		geneM <- geneM[unipos, ]}
	list(M=M, geneM=geneM, gpos=gpos)
	}

getRatioM <- function(DTList) {
	M <- DTList$M # M should have been log-transformed
	pD <- pData(DTList$data)
	grps <- factor(paste('group', pD$group, sep=''))
	glv = levels(grps)
	grp_n <- length(glv)
	if (grp_n != 2) return(NULL) # should be two groups
	grp_sum <- table(grps)
	if (grp_sum[1] != grp_sum[2]) return(NULL) # each groups should have the same number of columns
	site_g1 <- grps == glv[1]
	site_g2 <- !site_g1
	ratio_by <- DTList$ratio_by
	if (ratio_by == 'data_order') return(list(M=cbind(M[,site_g2] - M[,site_g1]), ratio_by=ratio_by, site_g2=site_g2, site_g1=site_g1, order_g1=seq(which(site_g1))))
	dic <- c('array'='array_id', 'platform'='platform_id', 'dye'='dye', 'individual'='individual_id', 'sample'='sample_id')
	nms <- if (ratio_by=='auto') names(dic) else ratio_by
	for (ratio_by in nms) {
		clnm <- pD[[dic[ratio_by]]]
		#if (any(sort(clnm[site_g1]) != sort(clnm[site_g2]))) next # less strict: only require that each block has same number in every group
		if (any(table(grps, clnm)!=1)) next # strict requirement: each block has 1 in each group
		rank_g1 <- match(clnm[site_g1], clnm[site_g2])
		M <- M[,site_g2] - (M[,site_g1])[,rank_g1]
		colnames(M) <- clnm[site_g2]
		return(list(M=M, ratio_by=ratio_by, site_g2=site_g2, site_g1=site_g1, order_g1=rank_g1))
		}
	return(NULL)
	
	if (DTList$use_ratio && grp_n==2) {
		glv = levels(grps)
		chs <- pD$channel_No
		arychs <- paste(arys, chs)
		if (length(arychs) == length(unique(arychs)) ) { # all are unique channels
			site_g1 <- grps == glv[1]
			site_g2 <- !site_g1			
			#if (sum(site_g1) == sum(site_g2) && sort(arys[site_g1]) == sort(arys[site_g2])) { # Both groups have the same number of columns, two channels of all arys were distributed into two groups.
			if (sum(site_g1) == sum(site_g2) && length(setdiff(arys[site_g1], arys[site_g2]))==0) { # Both groups have the same number of columns, two channels of all arys were distributed into two groups.
				contrasts <- strsplit(DTList$contrasts, '-') # now contrasts is a list of vectors
				contrasts <- lapply(contrasts, function(x) gsub('(^ +)|( +$)', '', x)) # remove blank
				if (all(sapply(contrasts, function(x) length(x)==2 && all(sort(x) == glv)))) {
					#use_ratio <- TRUE
					ary1 <- as.vector(arys[site_g1])
					ary2 <- as.vector(arys[site_g2])
					rank_g2 <- match(ary2, ary1) # or as.integer(factor(ary1, levels=ary2))
					
					# get group factor for mixed model
					grp <- grp_s <- NULL
					if (is.null(grp) && use_pf){
						grp1 <- as.vector(pfs[site_g1])
						if (all(grp1 == as.vector(pfs[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'platform'
						} 
					if (is.null(grp) && use_samp){
						grp1 <- as.vector(samps[site_g1])
						if (all(grp1 == as.vector(samps[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'sample'
						} 
					if (use_ind){
						grp1 <- as.vector(inds[site_g1])
						if (all(grp1 == as.vector(inds[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'individual'
						} 					

					# get data
					M1 <- M[, site_g1]
					M2 <- M[, site_g2][, rank_g2]
					#colnames(M1) <- ary1
					#colnames(M2) <- ary2
					if (contrasts[1] == glv[1]) { # group1 -group2
						M <- M1 - M2 # M1 - M2[, ary1]
						}
					else { # group2 - group1
						M <- M2 - M1 #M2[, ary1] - M1
						}
					fun_fixed <- function(x) {
						fpm <- try(t.test(x), silent=TRUE)
						#fpm <- try(eval(mdl), silent=TRUE)
						if ('try-error' %in% class(fpm)) fp <- c(mean(x), NA)
						else fp <- c(fpm$estimate, fpm$p.value)
						}
					fun_mixed <- function(x) {
						fpm <- try(lme(x~1, random=~1 | grp ), silent=TRUE)
						#fpm <- try(eval(mdl), silent=TRUE)
						if ('try-error' %in% class(fpm)) fp <- c(NA, NA)
						else {
							fp <- try(anova(fpm), silent=TRUE)
							if ('try-error' %in% class(fp)) fp <- c(fpm$coefficients$fixed, NA)
							else {
								fp <- if(is.null(fp$'p-value')) c(fpm$coefficients$fixed, NA) else c(fpm$coefficients$fixed, fp$'p-value'[1])
								}
							}
						}
					if (!is.null(grp)) {
						fun <- fun_mixed #mdl <- parse(text='lme(x~1, random=~1 | grp )')
						mdl_s <- c('M', paste('p_value(F test: lme(x~1, random=~1 |', grp_s, ')'),  'p_valFDR(F test)')
						}
					else {
						fun <- fun_fixed #mdl <- parse(text='lm(x~1)')
						mdl_s <- c('M', 'p_value(paired t-test)', 'p_valFDR(paired t test)')
						}

					nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
					rlt <- computeM(M, fun, c(liblme), min_proc=nproc )
					#colnames(rlt) <- c('p_value(F test)', paste('p_value(', DTList$contrasts, ')', sep=''))
					rlt <- cbind(rlt, p.adjust(rlt[,2], method='fdr'))
					#dim(rlt) <- c(nrow(rlt)/2, ncol(rlt)*2)
					#colnames(rlt) <- c('M', 'p_value(F test:lme(M~1, random=~1 | group)', 'p_valFDR(F test)')
					colnames(rlt) <- mdl_s #c('M', mdl_s, 'p_valFDR(F test)')
					rlt <- cbind(geneM, rlt)
					return(invisible(rlt))
					}
				}
			}
		}
	}


doFdrPerm <- function(M) {
	# the first half number of columns are M values and the rest are p values
	cn <- ncol(M)/2
	rn <- nrow(M)
	M <- cbind(M, cbind(apply(cbind(M[,(cn+1):(cn+cn)]), 2, function(x) p.adjust(x, method='fdr'))))
	dim(M) <- c(rn, cn, 3)
	M <- aperm(M, c(1, 3, 2))
	dim(M) <- c(rn, cn*3)
	M	
	}


computeSeq <- function(S, fun, pkgs=c(), min_proc=1, srcfun=lapply, parfun=parLapply) {
	# the same to the one in mytools/parMatrix.R
	#return(srcfun(S, fun))
	if (!require(snow)) 
		rlt <- srcfun(S, fun)
	else {
		#for (pkg in pkgs) eval(parse(text=paste('require(', pkg, ')')))
		if (FALSE && getClusterOption("type")=='MPI' && (is.loaded("mpi_initialize") || require(Rmpi)) && mpi.universe.size()<2)
			rlt <- srcfun(S, fun)
		else {
			#cl <- try(makeCluster(switch(getClusterOption("type"), MPI=max(min_proc, as.integer(mpi.universe.size()/2)), PVM=min_proc, SOCK=rep(Sys.getenv('HOSTNAME'), min_proc) ) ))
			cl_tp <- getClusterOption("type")
			if (cl_tp=='MPI' && !is.loaded("mpi_initialize") ) require(Rmpi)
			else if (cl_tp=='PVM') require(rpvm)
			nproc <- switch(cl_tp, MPI=if(is.character(min_proc)) length(min_proc) else max(min_proc, as.integer(mpi.universe.size()/1)), PVM=if(is.character(min_proc)) length(min_proc) else max(min_proc, as.integer(nrow(.PVM.config()))), SOCK=if(is.character(min_proc)) min_proc else rep(HOSTNAME, min_proc) )
			if ((is.numeric(nproc) && nproc <= 1) || (is.character(nproc) && length(nproc)<=1)) 
				rlt <- srcfun(S, fun)
			else {
				cl <- try(makeCluster(nproc ), silent=TRUE)
				if ('try-error' %in% class(cl) ) #(class(cl)[[1]]=='try-error')
					rlt <- srcfun(S, fun)
				else {
					for (pkg in pkgs) {
						#clusterCall(cl, library, pkg) # clusterEvalQ(cl, library(muStat))
						pkgstr <- c('clusterEvalQ(cl, library(', pkg,'))')
						#clusterEvalQ(cl, eval(parse(text=paste(pkgstr, collapse='')))) }
						eval(parse(text=paste(pkgstr, collapse=''))) }
					#rlt <- parApply(cl, M, 1, fun)
					rlt <- parfun(cl, S, fun)
					stopCluster(cl)
					}
				}
			}
		}

	#if (is.null(dim(rlt))) rlt <- as.matrix(rlt)
	#else rlt <- t(rlt)
	invisible(rlt)
	}

computeM <- function(M, fun, pkgs=c(), min_proc=1) {
	# the same to the one in mytools/parMatrix.R
	if (!require(snow)) 
		rlt <- apply(M, 1, fun)
	else {
		#for (pkg in pkgs) eval(parse(text=paste('require(', pkg, ')')))
		if (FALSE && getClusterOption("type")=='MPI' && (is.loaded("mpi_initialize") || require(Rmpi)) && mpi.universe.size()<2)
			rlt <- apply(M, 1, fun)
		else {
			#cl <- try(makeCluster(switch(getClusterOption("type"), MPI=max(min_proc, as.integer(mpi.universe.size()/2)), PVM=min_proc, SOCK=rep(Sys.getenv('HOSTNAME'), min_proc) ) ))
			cl_tp <- getClusterOption("type")
			if (cl_tp=='MPI' && !is.loaded("mpi_initialize") ) require(Rmpi)
			else if (cl_tp=='PVM') require(rpvm)
			nproc <- switch(cl_tp, MPI=if(is.character(min_proc)) length(min_proc) else max(min_proc, as.integer(mpi.universe.size()/1)), PVM=if(is.character(min_proc)) length(min_proc) else max(min_proc, as.integer(nrow(.PVM.config()))), SOCK=if(is.character(min_proc)) min_proc else rep(HOSTNAME, min_proc) )
			if ((is.numeric(nproc) && nproc <= 1) || (is.character(nproc) && length(nproc)<=1))  # cannot use is.integer since is.ineger(3) is FALSE
				rlt <- apply(M, 1, fun)
			else {
				cl <- try(makeCluster(nproc ), silent=TRUE)
				if ('try-error' %in% class(cl) ) #(class(cl)[[1]]=='try-error')
					rlt <- apply(M, 1, fun)
				else {
					for (pkg in pkgs) {
						#clusterCall(cl, library, pkg) # clusterEvalQ(cl, library(muStat))
						pkgstr <- c('clusterEvalQ(cl, library(', pkg,'))')
						#clusterEvalQ(cl, eval(parse(text=paste(pkgstr, collapse='')))) }
						eval(parse(text=paste(pkgstr, collapse=''))) }
					if (nrow(M)<=30000) rlt <- parApply(cl, M, 1, fun)
					else {
						idxlist <- splitList(seq(nrow(M)), floor(nrow(M)/10000))
						rlt <- NULL
						for (i in seq(idxlist)) { # the length of idx must no less than 10000
							if (i>1) { # restart cluster to reduce memory leaking chance.
								stopCluster(cl)
								cl <- makeCluster(nproc )
								for (pkg in pkgs) {
									pkgstr <- c('clusterEvalQ(cl, library(', pkg,'))')
									eval(parse(text=paste(pkgstr, collapse=''))) }
								}
							idx <- idxlist[[i]]
							rltmp <- parApply(cl, rbind(M[idx,]), 1, fun)
							if (is.null(dim(rltmp))) rlt <- c(rlt, rltmp)  
							else rlt <- cbind(rlt, rltmp)
							}
						}
					#rlt <- parRapply(cl, M, fun) # error happens sometimes
					stopCluster(cl)
					}
				}
			}
		}

	if (is.null(dim(rlt))) {if (nrow(M)==1) rlt <- rbind(rlt) else rlt <- as.matrix(rlt) }
	else rlt <- t(rlt)
	invisible(rlt)
	}

.Last <- function() { 
	traceback()
	if (is.loaded("mpi_initialize")){ 
		if (mpi.comm.size(1) > 0){ 
			#print("Please use mpi.close.Rslaves() to close slaves.") 
			mpi.close.Rslaves() } 
		#print("Please use mpi.quit() to quit R") 
		.Call("mpi_finalize") 
		} 
	}

doANOVA_user_ratio <- function(DTList) {
	RM <- getRatioM(DTList) # Ratio are group2 - group1, in the order of group2
	if (is.null(RM)) return(NULL)
	M <- RM$M; site_g2 <- RM$site_g2; site_g1 <- RM$site_g1; order_g1 <- RM$order_g1
	anova_factor <- DTList$anova_factor
	if (anova_factor=='user_model') uf_in_model <- DTList$uf_in_model
	else uf_in_model <- DTList$uf_name
	uf_dt <- DTList$uf_dt[, uf_in_model]
	conds <- function(x) {
		# should have at least 2 levels
		if (length(levels(x)) < 2) return(FALSE)
		# all values (ratio) should came from the same factor value -same array, same dye, ...
		if (any(x[site_g2] != x[site_g1][order_g1])) return(FALSE)
		# each factor value should have replicates -- only for factor, not for numeric variable
		#if (any(table(x[site_g2]) < 2)) return(FALSE)
		return(TRUE)
		}
	if (ncol(uf_dt)>0 && all(apply(uf_dt, 2, conds)) ) uf_dt <- uf_dt[site_g2,]

	nmdic <- DTList$uf_nmdic
	#nmdic['1'] <- '(Intercept)'
	if (anova_factor == 'factors_by_user') {
		# make model
		i_fixed <- uf_type == 'fixed'
		f_fixed <- c('1', uf_name[i_fixed])
		f_mixed <- uf_name[!i_fixed]
		mixed <- ifelse(length(f_mixed)>0, TRUE, FALSE)
		has_intercept <- TRUE; has_group <- FALSE
		s_fixed <- paste(f_fixed, collapse=' + ')
		s_mixed <- if(length(f_mixed)>0) paste(', random = ~', paste(paste('1 |', f_mixed), collapse=' + ') ) else ''
		mdl <- paste(if(length(f_mixed>0)) 'm <- lme(x ~ ' else 'm <- lm(x ~ ', s_fixed, s_mixed, ', data = uf_dt)', sep='')

		mdl_disp <- substr(mdl, 6, nchar(mdl)) # or sub('m <- ', '', mdl) 
		for (nm in names(nmdic)) mdl_disp <- gsub(paste('\\b', nm, '\\b', sep=''), nmdic[nm], mdl_disp) # capitalize
		mdl_disp <- sub(', data = uf_dt', '', mdl_disp)
		mdl <- parse(text=mdl)

		}
	else { # must be 'user_model'
		mdl <- parse(text=DTList$user_model)
		mdl_disp <- DTList$user_model_disp
		#mdl_disp <- gsub(paste('\\b1\\b', sep=''), nmdic['1'], mdl_disp)
		has_group <- DTList$has_group; if (has_group) return(NULL)
		has_intercept <- DTList$has_intercept; if (!has_intercept) return(NULL)
		mixed <- DTList$is_mixed_model
		if (! has_group) contrast_pairs <-NULL
		}
		
	fun_anova_fix <- function(x) { # x is ratio # fixed model: lm
		uf_dt$x <- x
		fit <- try(eval(mdl), silent=TRUE)
		if ('try-error' %in% class(fit)) return(NA)
		f_rnms <- attr(m$terms, 'term.labels')
		f_num <- length(f_rnms)
		pv <- summary(fit)$coefficients[1,4] 
		if (is.null(pv)) return(NA)
		fit <- anova(fit)
		if (is.null(fit$Pr) || !nrow(fit)) return(c(pv, rep(NA, f_num)))
		return(c(pv, fit[f_rnms,]$Pr))
		}
	fun_anova_mix <- function(x) { # x is ratio
		uf_dt$x <- x
		fit <- try(eval(mdl), silent=TRUE)
		if ('try-error' %in% class(fit)) return(NA)
		f_rnms <- c('(Intercept)', attr(m$terms, 'term.labels'))
		f_num <- length(f_rnms)
		fit <- anova(fit)
		if (is.null(fit$'p-value') || !nrow(fit)) return(rep(NA, f_num))
		return(fit[f_rnms,]$'p-value')
		}
	fun_t <- function(x) { # x is intensity
		pv <- try(glht(eval(parse(text='lm(x ~ group)')), linfct=mcp(group=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) return(rep(NA, length(contrast_pairs)*2) )
		if (is.null(pv$test)) pv <- summary(pv)
		return(c(pv$test$coefficients, pv$test$pvalues))
		}

	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	fun_anova <- if (mixed) fun_anova_mix else fun_anova_fix
	if (n_proc == 1 || (nrow(M)<N_para && !mixed) || (nrow(M)<N_para_mix && mixed) ) { # don't use parallel computation if no much data
		rlt_F <- apply(M, 1, fun_anova)
		#rlt <- apply(M[1:10,], 1, fun_anova)
		#rlt <- cbind(rlt[rep(1:10, length=nrow(M)),])
		if (nrow(M) <= 1) rlt_F <- rbind(rlt_F)
		else if (!is.null(dim(rlt_F))) rlt_F <- t(rlt_F)
		else rlt_F <- cbind(rlt_F)
		}
	else
		rlt_F <- cbind(computeM(M, fun_anova, c(liblme), min_proc=nproc ))
	
	# determine f_rnms
	if (anova_factor == 'factors_by_user') f_rnms <- c('Group', f_fixed[2:length(f_fixed)])
	else { # find fixed names
		x <- NULL
		for (i in seq(nrow(rlt_F))) if(!all(is.na(rlt_F[i,]))) { x <- M[i,]; break}
		if (is.null(x)) return(paste('Bad model:', mdl_disp))
		uf_dt$x <- x
		eval(mdl)
		#f_rnms <- if(mixed) names(m$coefficients$fixed) else names(m$coefficients)
		f_rnms <- c('Group', attr(m$terms, 'term.labels')) #if(is_mixed) names(m$coefficients$fixed) else names(m$coefficients)
		}
	# capitalize
	#nmdic['1'] <- NULL # nmdic is not a list, but a vector with names
	for (nm in names(nmdic)) if (nm != '1') f_rnms <- gsub(paste('\\b', nm, '\\b', sep=''), nmdic[nm], f_rnms)

	rlt_F <- rbind(rlt_F, apply(rlt_F, 2, function(x) p.adjust(x, method='fdr')))
	dim(rlt_F) <- c(nrow(rlt_F)/2, ncol(rlt_F)*2)
	f_rnms <- rep(f_rnms, each=2)
	f_rnms[1:2] <- paste(c('p_value(', 'p_valFDR('), f_rnms[1], c(paste(' - F test: ', mdl_disp, ', paired by ', RM$ratio_by, sep=''), ' - F test'), ')', sep='')
	f_rnms[3:length(f_rnms)] <- paste(c('p_value(', 'p_valFDR('), f_rnms[3:length(f_rnms)], ' - F test)', sep='')
	colnames(rlt_F) <- f_rnms
	# mutiple comparison
	group <- factor(paste('group', pData(DTList$data)$group, sep=''))
	#contrast_pairs <- paste(DTList$contrasts, '= 0')
	contrast_pairs <- if (is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'
	if (is.null(contrast_pairs)) rlt <- cbind(DTList$geneM, 'Average value (geometric mean)'=DTList$MEAN, rlt_F)
	else {
		M <- DTList$M
		if (n_proc == 1 || nrow(M)<N_para ) { # for test purpose
			rlt <- apply(M, 1, fun_t)
			if (nrow(M) <= 1) rlt <- rbind(rlt)
			else if (!is.null(dim(rlt))) rlt <- t(rlt)
			else rlt <- cbind(rlt)
			}
		else
			rlt <- computeM(M, fun_t, c('multcomp'), min_proc=nproc )
		rlt <- doFdrPerm(rlt)
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep=''))
		rlt <- cbind(DTList$geneM, 'Average value (geometric mean)'=DTList$MEAN, rlt_F, rlt) 
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- rlt_F[,1]

	invisible(DTList)
	}

doANOVA_ratio <- function(DTList) {
	RM <- getRatioM(DTList) # Ratio are group2 - group1, in the order of group2
	if (is.null(RM)) return(NULL)
	M <- RM$M; site_g2 <- RM$site_g2; site_g1 <- RM$site_g1; order_g1 <- RM$order_g1

	pD <- pData(DTList$data)
	pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	arys <- factor(paste('Array', pD$array_id, sep='_'))
	dyes <- factor(pD$dye)
	inds <- factor(paste('Individual', pD$individual_id, sep='_'))
	samps <- factor(paste('Samp', pD$sample_id, sep='_'))
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- 2
	#contrast_pairs <- paste(DTList$contrasts, '= 0')
	contrast_pairs <- if (is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'

	conds <- function(x) {
		# should have at least 2 levels
		if (length(levels(x)) < 2) return(FALSE)
		# all values (ratio) should came from the same factor value -same array, same dye, ...
		if (any(x[site_g2] != x[site_g1][order_g1])) return(FALSE)
		# each factor value should have replicates
		if (any(table(x[site_g2]) < 2)) return(FALSE)
		return(TRUE)
		}
	use_pf <- ifelse((is.null(DTList$anova_platform) || DTList$anova_platform) && conds(pfs), TRUE, FALSE) 
	use_ary <- ifelse((is.null(DTList$anova_array) || DTList$anova_array) && conds(arys), TRUE, FALSE)
	use_dye <- ifelse((is.null(DTList$anova_dye) || DTList$anova_dye) && conds(dyes), TRUE, FALSE)
	use_ind <- ifelse((is.null(DTList$anova_individual) || DTList$anova_individual) && conds(inds), TRUE, FALSE)
	use_samp <- ifelse((is.null(DTList$anova_sample) || DTList$anova_sample) && conds(samps), TRUE, FALSE)	

	# don't use the ratioed factor
	switch(RM$ratio_by, 'array'=use_ary<-FALSE, 'platform'=use_pf<-FALSE, 'dye'=use_dye<-FALSE, 'individual'=use_ind<-FALSE, 'sample'=use_samp<-FALSE)

	# factor effects: pf > samp > ind > ary > dye
	dic <- c(use_pf='pfs', use_dye='dyes', use_ary='arys', use_ind='inds', use_samp='samps')
	dicnm <- names(dic)
	ln <- length(dic)
	# filter factor length by site_g2
	for (nm in dicnm) if (get(nm)) assign(dic[nm], get(dic[nm])[site_g2])
	for (i in 1:(ln-1)) 
		if (get(dicnm[i])) 
			for (j in (i+1):ln) 
				if (get(dicnm[j]) && mean(tapply(get(dic[dicnm[j]]), get(dic[dicnm[i]]), length))<2) assign(dicnm[j], FALSE)

	fun_anova_onePval4Intercept <- function(x) { # x is ratio
		pv <- try(summary(eval(mdl)))
		if ('try-error' %in% class(pv)) return(NA)
		if (is.null(pv$tTable)) pv <- pv$coefficients[1,4] # fixed model: lm 
		else pv <- pv$tTable[1] # mixed mode: lme
		if (is.null(pv)) pv <- NA
		return(pv)
		}
	fun_anova_fix <- function(x) { # x is ratio # fixed model: lm
		fit <- try(eval(mdl), silent=TRUE)
		if ('try-error' %in% class(fit)) return(NA)
		pv <- summary(fit)$coefficients[1,4] 
		if (is.null(pv)) return(NA)
		fit <- anova(fit)
		if (is.null(fit$Pr)) return(c(pv, rep(NA, nrow(fit)-1)))
		#return(c(pv, fit$Pr[1:(nrow(fit)-1)]))
		return(c(pv, fit[f_rnms[-1],]$Pr))
		}
	fun_anova_mix <- function(x) { # x is ratio
		fit <- try(eval(mdl), silent=TRUE)
		if ('try-error' %in% class(fit)) return(NA)
		fit <- anova(fit)
		if (is.null(fit$'p-value')) return(NA)
		return(fit[f_rnms,]$'p-value')
		}
	fun_t <- function(x) { # x is intensity
		pv <- try(glht(eval(parse(text='lm(x ~ grps)')), linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) return(rep(NA, length(contrast_pairs)*2) )
		if (is.null(pv$test)) pv <- summary(pv)
		return(c(pv$test$coefficients, pv$test$pvalues))
		}
	#funtest <- fun_anova
	funtest <- function() if (use_ary || use_ind) fun_anova_mix else fun_anova_fix
	
	mkMdl <- function() {
		mix <- use_ary || use_ind
		mdlstr <- c(if(mix) 'm <- lme(x ~ 1' else 'm <- lm(x ~ 1', 
			ifelse(use_pf, ' + pfs', ''), 
			ifelse(use_samp, ' + samps', ''), 
			ifelse(use_dye, ' + dyes', ''), 
			if(mix) c(', random = ~', 
				ifelse(use_ind, ifelse(FALSE && use_samp, ' 1 | samps/inds', ' 1 | inds'), ''), 
				if (use_ary) c(ifelse(use_ind, ' +', ''), ifelse(FALSE && use_pf, ' 1 | pfs/arys', '1 | arys')) else '') 
			else '', 
			')' )
		dic_rep <- c('m <- '='', 'pfs'='Platform', 'samps'='Sample', 'inds'='Individual', 'arys'='Array', 'dyes'='Dye')
		mdl_s <- mdlstr
		for (nm in names(dic_rep)) mdl_s <- gsub(nm, dic_rep[nm], mdl_s) # gsub replace all ocurrances while sub only replace the first
		list(mdl=parse(text=paste(mdlstr, collapse='')), mdl_s=paste(mdl_s, collapse=''))
		}

	# test and adjust the model
	M1 <- M[1,]
	M1[is.na(M1)] <- mean(M1, na.rm=TRUE)
	f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
	mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1)))

	use_strs <- c('use_dye', 'use_ary', 'use_ind', 'use_samp', 'use_pf')
	#use_str_vals <- sapply(use_strs, get) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	use_str_vals <- sapply(use_strs, function(x) get(x, pos=-1) ) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	use_strs <- use_strs[use_str_vals]
	str_n <- length(use_strs)
	if (badmdl && str_n>=1) # try to disable one
		for (use_str in use_strs) {
			assign(use_str, FALSE); 
			f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
			mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1))) #[1]); 
			if(badmdl) assign(use_str, TRUE) else break
			}
	if (badmdl && str_n>=2) # try to disable two
		for (i1 in seq(str_n-1)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n)) {
				assign(use_strs[i2], FALSE); 
				f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
				mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1))) #[1]); 
				if(badmdl) assign(use_strs[i2], TRUE) else break
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=3) # try to disable three
		for (i1 in seq(str_n-2)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-1)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n)) {
					assign(use_strs[i3], FALSE); 
					f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
					mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1))) #[1]); 
					if(badmdl) assign(use_strs[i3], TRUE) else break
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=4) # try to disable four
		for (i1 in seq(str_n-3)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-2)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n-1)) {
					assign(use_strs[i3], FALSE); 
					for (i4 in seq(i3+1, str_n)) {
						assign(use_strs[i4], FALSE); 
						f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
						mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1))); #[1]); 
						if (badmdl) assign(use_strs[i4], TRUE) else break
						}
					if (badmdl) assign(use_strs[i3], TRUE) else break 
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=5) {
		use_ary <- use_dye <- use_ind <- use_samp <- use_pf <- FALSE
		f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
		mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- any(is.na(funtest()(M1)));
		}
	if (badmdl) return(NULL)

	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	# ANOVA
	mixed <- use_ary || use_ind
	fun_anova <- funtest()
	if (n_proc == 1 || (nrow(M)<N_para && !mixed) || (nrow(M)<N_para_mix && mixed) ) { # don't use parallel computation if no much data
		rlt <- apply(M, 1, fun_anova)
		#rlt <- apply(M[1:10,], 1, fun_anova)
		#rlt <- cbind(rlt[rep(1:10, length=nrow(M)),])
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		}
	else
		rlt <- cbind(computeM(M, fun_anova, c(liblme), min_proc=nproc ))

	#rlt_F <- cbind(rlt, p.adjust(rlt, method='fdr'))
	rlt_F <- rbind(rlt, apply(rlt, 2, function(x) p.adjust(x, method='fdr')))
	dim(rlt_F) <- c(nrow(rlt), ncol(rlt)*2)
	f_rnms <- c('(Intercept)', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
	f_fixed <- c('Group', 'Platform', 'Sample', 'Dye')[c(TRUE, use_pf, use_samp, use_dye)]
	f_fixed <- rep(f_fixed, each=2)
	#colnames(rlt_F) <- c(paste('p_value(F test: ', mdl_s, ', paired by ', RM$ratio_by, ')', sep=''), 'p_valFDR(F test)')
	#colnames(rlt_F) <- paste(c('p_value(', 'p_valFDR('), f_fixed, c(paste(' - F test: ', mdl_s, ', paired by ', RM$ratio_by, ')', sep=''), ' - F test)'), sep='')
	cnm_grp <- c(paste('p_value(Group - F test: ', mdl_s, ', paired by ', RM$ratio_by, ')', sep=''), 'p_valFDR(Group - F test)')
	if (length(f_fixed)>2) cnm_grp <- c(cnm_grp, paste(c('p_value(', 'p_valFDR('), f_fixed[-c(1,2)], ' - F test)', sep='') )
	colnames(rlt_F) <- cnm_grp
	# mutiple comparison
	if (is.null(contrast_pairs)) rlt <- cbind(DTList$geneM, DTList$MEAN, rlt_F)
	else {
		M <- DTList$M
		if (n_proc == 1 || nrow(M)<N_para ) { # for test purpose
			rlt <- apply(M, 1, fun_t)
			if (nrow(M) <= 1) rlt <- rbind(rlt)
			else if (!is.null(dim(rlt))) rlt <- t(rlt)
			else rlt <- cbind(rlt)
			}
		else
			rlt <- computeM(M, fun_t, c('multcomp'), min_proc=nproc )
		rlt <- doFdrPerm(rlt)
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep=''))
		rlt <- cbind(DTList$geneM, DTList$MEAN, rlt_F, rlt)
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- rlt_F[,1]

	invisible(DTList)
	}

doANOVA_user <- function(DTList) {
	uf_name <- DTList$uf_name
	uf_type <- DTList$uf_type
	uf_value <- DTList$uf_value
	uf_dt <- as.data.frame(uf_value)
	colnames(uf_dt) <- uf_name

	pD <- pData(DTList$data)
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))

	pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	arys <- factor(paste('Array', pD$array_id, sep='_'))
	dyes <- factor(pD$dye)
	inds <- factor(paste('Individual', pD$individual_id, sep='_'))
	samps <- factor(paste('Samp', pD$sample_id, sep='_'))
	f_db <- data.frame('group'=grps, 'array'=arys, 'dye'=dyes, 'platform'=pfs, 'individual'=inds, 'sample'=samps)
	fnm_db <- setdiff(colnames(f_db), uf_name)
	if (length(fnm_db)>0) uf_dt <- cbind(uf_dt, f_db[, fnm_db])
	DTList$uf_dt <- uf_dt
	anova_factor <- DTList$anova_factor

	contrast_pairs <- if (grp_n < 2 || is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'

	if (DTList$use_ratio && grp_n==2 && !(anova_factor=='user_model' && (DTList$has_group || !DTList$has_intercept))) {
		rlt <- doANOVA_user_ratio(DTList)
		if (!is.null(rlt)) return(rlt)
		}

	nmdic <- DTList$uf_nmdic
	if (anova_factor == 'factors_by_user') {
		# make model
		has_group <- grp_n > 1
		has_intercept <- TRUE
		i_fixed <- uf_type == 'fixed'
		f_fixed <- if (has_group) c('group', uf_name[i_fixed]) else uf_name[i_fixed]
		f_mixed <- uf_name[!i_fixed]
		mixed <- ifelse(length(f_mixed)>0, TRUE, FALSE)
		s_fixed <- paste(f_fixed, collapse=' + ')
		s_mixed <- if(length(f_mixed)>0) paste(', random = ~', paste(paste('1 |', f_mixed), collapse=' + ') ) else ''
		mdl <- paste(if(length(f_mixed>0)) 'm <- lme(x ~ ' else 'm <- lm(x ~ ', s_fixed, s_mixed, ', data = uf_dt)', sep='')

		mdl_disp <- substr(mdl, 6, nchar(mdl)) # or sub('m <- ', '', mdl) 
		for (nm in names(nmdic)) mdl_disp <- gsub(paste('\\b', nm, '\\b', sep=''), nmdic[nm], mdl_disp) # capitalize
		mdl_disp <- sub(', data = uf_dt', '', mdl_disp)
		mdl <- parse(text=mdl)

		}
	else { # must be 'user_model'
		mdl <- parse(text=DTList$user_model)
		mdl_disp <- DTList$user_model_disp
		has_group <- DTList$has_group
		has_intercept <- DTList$has_intercept
		mixed <- DTList$is_mixed_model
		if (! has_group) contrast_pairs <-NULL
		}

	fun <- function(x) {
		uf_dt$x <- x
		pv <- try(eval(mdl), silent=TRUE)
		if ('try-error' %in% class(pv)) return(NA)
		is_mixed <- !is.null(m$coefficients$mixed) # or class(m) != 'lm'
		f_rnms <- attr(m$terms, 'term.labels') #if(is_mixed) names(m$coefficients$fixed) else names(m$coefficients)
		f_num <- length(f_rnms) + has_intercept
		if (has_intercept && is_mixed) f_rnms <- c('(Intercept)', f_rnms)
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- rep(NA, f_num)
		else {
			if(is_mixed) fp <- if(is.null(fp$'p-value') || !nrow(fp)) rep(NA, f_num) else fp[f_rnms,]$'p-value'
			else fp <- if(is.null(fp$Pr) || !nrow(fp)) rep(NA, f_num) else c(if(has_intercept) summary(m)$coef[1,4] else c(), fp[f_rnms,]$Pr)
			}
		# multiple comparison
		if (is.null(contrast_pairs)) return(fp)
		if (is_mixed) {
			m <- lm(x~group, data=uf_dt)
			pv <- try(glht(m, linfct=mcp(group=contrast_pairs)), silent=TRUE)}
		else {
			pv <- try(glht(m, linfct=mcp(group=contrast_pairs)), silent=TRUE)
			if ('try-error' %in% class(pv)) {
				m <- lm(x~group, data=uf_dt)
				pv <- try(glht(m, linfct=mcp(group=contrast_pairs)), silent=TRUE)
				}
			}
		if ('try-error' %in% class(pv)) rlt <- rep(NA, length(contrast_pairs)*2)
		else {
			if (is.null(pv$test)) pv <- summary(pv)
			rlt <- c(pv$test$coefficients, pv$test$pvalues)
			}
		return(c(rlt, fp))
		}

	M <- DTList$M
	geneM <- DTList$geneM
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	if (n_proc == 1 || (nrow(M)<N_para && !mixed) || (nrow(M)<N_para_mix && mixed) ) { # don't use parallel computation if no much data
		rlt <- apply(M, 1, fun)
		#rlt <- apply(M[1:10,], 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		#rlt <- cbind(rlt[rep(1:10,length=nrow(M)), ])
		}
	else
		rlt <- computeM(M, fun, c(liblme, 'multcomp'), min_proc=nproc )

	if (!is.null(contrast_pairs)) {
		i_contrast <- seq(length(contrast_pairs)*2)	
		#rlt_F <- cbind(rlt[, ncol(rlt)], p.adjust(rlt[, ncol(rlt)], method='fdr'))
		rlt_F <- cbind(rlt[,-i_contrast]) }
	else rlt_F <- rlt

	# check result
	if (all(is.na(rlt_F))) return(paste('Unsuitable model:', mdl_disp))

	# determine f_rnms
	if (anova_factor == 'factors_by_user') f_rnms <- c('(Intercept)', f_fixed)
	else { # find fixed names
		x <- NULL
		for (i in seq(nrow(rlt_F))) if(!all(is.na(rlt_F[i,]))) { x <- M[i,]; break}
		#if (is.null(x)) return(paste('Bad model:', mdl_disp))
		uf_dt$x <- x
		eval(mdl)
		#f_rnms <- if(mixed) names(m$coefficients$fixed) else names(m$coefficients)
		f_rnms <- attr(m$terms, 'term.labels') #if(is_mixed) names(m$coefficients$fixed) else names(m$coefficients)
		if (has_intercept) f_rnms <- c('(Intercept)', f_rnms)
		}
	# capitalize
	for (nm in names(nmdic)) f_rnms <- gsub(paste('\\b', nm, '\\b', sep=''), nmdic[nm], f_rnms)

	
	if (has_group) i_main <- match('Group', f_rnms) 
	else if (has_intercept && ncol(rlt_F)>1) i_main <- 2
	else i_main <- 1
	DTList$dif_pvalue <- rlt_F[, i_main]

	rlt_F <- rbind(rlt_F, apply(rlt_F, 2, function(x) p.adjust(x, method='fdr')))
	dim(rlt_F) <- c(nrow(rlt), ncol(rlt_F)*2)
	f_rnms <- rep(f_rnms, each=2)
	i_main <- (i_main-1)*2 + 1
	f_tail <- rep(' - F test)', length(f_rnms))
	f_tail[i_main] <- paste(' - F test: ', mdl_disp, ')', sep='')
	f_rnms <- paste(c('p_value(', 'p_valFDR('), f_rnms, f_tail, sep='') 
	colnames(rlt_F) <- f_rnms

	if (!is.null(contrast_pairs)) {
		#rlt <- doFdrPerm(rlt[, -ncol(rlt)])
		rlt <- doFdrPerm(rlt[, i_contrast])
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep=''))
		rlt <- cbind(geneM, DTList$MEAN, rlt_F, rlt) }
	else rlt <- cbind(geneM, DTList$MEAN, rlt_F)

	DTList$dif_result <- rlt

	invisible(DTList)
	}

doANOVA <- function(DTList) { #, analysis_method=DTList$analysis_method) {
	fun_nlme_onePval4group <- function(x) {  
		#pv <- try(summary(glht(eval(mdl), linfct=mcp(grps=contrast_pairs))), silent=TRUE)
		# get F p-value
		pv <- try(eval(mdl$mdl_nlme))
		if ('try-error' %in% class(pv)) {
			return(rep(NA, length(contrast_pairs)*2+1))
			fp <- NA
			m <- lm(x~grps)
			}
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- NA
		else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp['grps',]$Pr ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
		#else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp$Pr[2] ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
		if ('lme' %in% class(m)) m <- lm(x~grps)
		# multiple comparison
		pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) rlt <- rep(NA, length(contrast_pairs)*2) #return(rep(NA, length(contrast_pairs)*2+1))
		else {
			if (is.null(pv$test)) pv <- summary(pv)
			rlt <- c(pv$test$coefficients, pv$test$pvalues)
			}
		return(c(rlt, fp))
		}
	fun_nlme <- function(x) {  
		#pv <- try(summary(glht(eval(mdl), linfct=mcp(grps=contrast_pairs))), silent=TRUE)
		# get F p-value
		pv <- try(eval(mdl$mdl_nlme), silent=TRUE)
		if ('try-error' %in% class(pv)) {
			return(rep(NA, length(contrast_pairs)*2+n_fixed))
			}
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- rep(NA, n_fixed)
		else fp <- if(class(m)=='lm') { if(is.null(fp$Pr) || !nrow(fp)) rep(NA, n_fixed) else fp[f_rnms,]$Pr  #fp$Pr[-nrow(fp)] } # the last one is for residuals
				}else { if(is.null(fp$'p-value') || !nrow(fp)) rep(NA, n_fixed) else fp[f_rnms,]$'p-value' } #fp$'p-value'[-1] } # the first p-value is for Intercept
		# multiple comparison
		if (is.null(contrast_pairs)) return(fp)
		if ('lme' %in% class(m)) {
			m <- lm(x~grps)
			pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE) }
		else {
			pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE) 
			if ('try-error' %in% class(pv)) {
				m <- lm(x~grps)
				pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE) }
			}
		if ('try-error' %in% class(pv)) rlt <- rep(NA, length(contrast_pairs)*2) #return(rep(NA, length(contrast_pairs)*2+1))
		else {
			if (is.null(pv$test)) pv <- summary(pv)
			rlt <- c(pv$test$coefficients, pv$test$pvalues)
			}
		return(c(rlt, fp))
		}
	fun <- fun_nlme

	funtest <- function(x) {  
		mdltmp <- try(eval(mdl$mdl_nlme))
		if ('try-error' %in% class(mdltmp)) return(rep(NA, length(contrast_pairs)+1))
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- NA
		else fp <- if(class(m)=='lm') { if(is.null(fp$Pr) || !nrow(fp) || any(is.na(fp[f_rnms,]$Pr)) ) NA else fp[f_rnms,]$Pr 
				}else { if(is.null(fp$'p-value') || !nrow(fp) || any(is.na(fp[f_rnms,]$'p-value')) ) NA else fp[f_rnms,]$'p-value' }
		if (is.null(fp)) fp <- NA
		return(fp)
		#return(c(fp, pv$test$pvalues))
		}

	#XPF <- DTList$XPF
	#DT <- DTList$data
	pD <- pData(DTList$data)

	GM <- shrinkDups(DTList) # now data were log-transformed
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M
	DTList$MEAN <- MEAN
	DTList$geneM <- geneM

	anova_factor <- DTList$anova_factor
	if (!is.null(anova_factor) && anova_factor %in% c('factors_by_user', 'user_model') ) # 'groups_only', 'factors_in_db'
		return(doANOVA_user(DTList))

	#group <- factor(pD$group)
	#group <- factor(gl(2, 4, labels=c('a','b')))
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))
	use_grp <- grp_n > 1

	if (DTList$use_ratio && grp_n==2) {
		rlt <- doANOVA_ratio(DTList)
		if (!is.null(rlt)) return(rlt)
		}
	
	#M <- exprs(DT)
	#if (!(DTList$norm_x_pf %in% c('qd', 'qdMod')) && (is.null(DTList$need_log_transform) || DTList$need_log_transform) ) M <- logValue(M) # log transform
	pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	arys <- factor(paste('Array', pD$array_id, sep='_'))
	dyes <- factor(pD$dye)
	inds <- factor(paste('Individual', pD$individual_id, sep='_'))
	samps <- factor(paste('Samp', pD$sample_id, sep='_'))
	contrast_pairs <- if (grp_n < 2 || is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'

	#conds <- function(x) length(levels(x)) > 1 && any(tapply(x, x, length)>1) # or more conservatively, use all?
	# level number > 1, and more than a half levels has more than 1 occurrences 
	if (anova_factor == 'groups_only') use_pf <- use_ary <- use_dye <- use_ind <- use_samp <- FALSE
	else { # must be 'factors_in_db'
		conds <- function(x) length(levels(x)) > 1 && ((feq<-tapply(x, x, length)>1) && sum(feq)*2 >= length(feq) )
		use_pf <- ifelse((is.null(DTList$anova_platform) || DTList$anova_platform) && conds(pfs), TRUE, FALSE) 
		use_ary <- ifelse((is.null(DTList$anova_array) || DTList$anova_array) && conds(arys), TRUE, FALSE)
		use_dye <- ifelse((is.null(DTList$anova_dye) || DTList$anova_dye) && conds(dyes), TRUE, FALSE)
		use_ind <- ifelse((is.null(DTList$anova_individual) || DTList$anova_individual) && conds(inds), TRUE, FALSE)
		use_samp <- ifelse((is.null(DTList$anova_sample) || DTList$anova_sample) && conds(samps), TRUE, FALSE)
	}

	# further filter - should has different levels in a group
	if (use_pf && grp_n == length(unique(paste(grps, pfs)))) use_pf <- FALSE
	if (use_ary && grp_n == length(unique(paste(grps, arys)))) use_ary <- FALSE
	if (use_dye && grp_n == length(unique(paste(grps, dyes)))) use_dye <- FALSE
	if (use_ind && grp_n == length(unique(paste(grps, inds)))) use_ind <- FALSE
	if (use_samp && grp_n == length(unique(paste(grps, samps)))) use_samp <- FALSE

	# factor effects: pf > samp > ind > ary > dye
	if (use_pf) { # check ary, dye, ind and samp
		if (use_dye && mean(tapply(dyes, pfs, length))<2) use_dye <- FALSE 
		if (use_ary && mean(tapply(arys, pfs, length))<2) use_ary <- FALSE 
		if (use_ind && mean(tapply(inds, pfs, length))<2) use_ind <- FALSE 
		if (use_samp && mean(tapply(samps, pfs, length))<2) use_samp <- FALSE 
		}
	if (use_samp) {
		if (use_dye && mean(tapply(dyes, samps, length))<2) use_dye <- FALSE 
		if (use_ary && mean(tapply(arys, samps, length))<2) use_ary <- FALSE 
		if (use_ind && mean(tapply(inds, samps, length))<2) use_ind <- FALSE 
		}
	if (use_ind) {
		if (use_dye && mean(tapply(dyes, inds, length))<2) use_dye <- FALSE 
		if (use_ary && mean(tapply(arys, inds, length))<2) use_ary <- FALSE 
		}
	if (use_ary && use_dye && mean(tapply(dyes, arys, length))<2) use_dye <- FALSE 

	mkMdl_nlme <- function() { # use lme in nmle
		mix <- use_ary || use_ind
		mdlstr <- c(if(mix) 'm <- lme(x ~ 1' else 'm <- lm(x ~ 1', 
			ifelse(use_grp, ' + grps', ''),
			ifelse(use_pf, ' + pfs', ''), 
			ifelse(use_samp, ' + samps', ''), 
			ifelse(use_dye, ' + dyes', ''), 
			if(mix) c(', random = ~', 
				ifelse(use_ind, ifelse(FALSE && use_samp, ' 1 | samps/inds', ' 1 | inds'), ''), 
				if (use_ary) c(ifelse(use_ind, ' +', ''), ifelse(FALSE && use_pf, ' 1 | pfs/arys', '1 | arys')) else '') 
			else '', 
			')' )
		mdlstr_s <- c(if(mix) 'lme(x ~ 1' else 'lm(x ~ 1', 
			ifelse(use_grp, ' + Group', ''),
			ifelse(use_pf, ' + Platform', ''), 
			ifelse(use_samp, ' + Sample', ''), 
			ifelse(use_dye, ' + Dye', ''), 
			if(mix) c(', random = ~', 
				ifelse(use_ind, ifelse(FALSE && use_samp, '1 | Sample/Individual', '1 | Individual'), ''), 
				if (use_ary) c(ifelse(use_ind, ' +', ''), ifelse(FALSE && use_pf, ' 1 | Platform/Array', ' 1 | Array')) else '' ) 
			else '', 
			')' )
		
		mdl <- parse(text=paste(mdlstr, collapse=''))
		mdl_s <- paste(mdlstr_s, collapse='')
		list(mdl=mdl, mdl_s=mdl_s)
		}

	mkMdl <- function() {
		m_nlme <- mkMdl_nlme()
		list(mdl=list(mdl_nlme=m_nlme$mdl), mdl_s=m_nlme$mdl_s)
		}

	# test and adjust the model
	M1 <- M[1,]
	M1[is.na(M1)] <- mean(M1, na.rm=TRUE)
	#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
	f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
	mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1])

	use_strs <- c('use_dye', 'use_ary', 'use_ind', 'use_samp', 'use_pf')
	#use_str_vals <- sapply(use_strs, get) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	use_str_vals <- sapply(use_strs, function(x) get(x, pos=-1) ) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	use_strs <- use_strs[use_str_vals]
	str_n <- length(use_strs)
	if (badmdl && str_n>=1) # try to disable one
		for (use_str in use_strs) {
			assign(use_str, FALSE); 
			#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
			f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
			mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
			if(badmdl) assign(use_str, TRUE) else break
			}
	if (badmdl && str_n>=2) # try to disable two
		for (i1 in seq(str_n-1)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n)) {
				assign(use_strs[i2], FALSE); 
				#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
				f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
				mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
				if(badmdl) assign(use_strs[i2], TRUE) else break
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=3) # try to disable three
		for (i1 in seq(str_n-2)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-1)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n)) {
					assign(use_strs[i3], FALSE); 
					#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
					f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
					mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
					if(badmdl) assign(use_strs[i3], TRUE) else break
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=4) # try to disable four
		for (i1 in seq(str_n-3)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-2)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n-1)) {
					assign(use_strs[i3], FALSE); 
					for (i4 in seq(i3+1, str_n)) {
						assign(use_strs[i4], FALSE); 
						#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
						f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
						mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
						if (badmdl) assign(use_strs[i4], TRUE) else break
						}
					if (badmdl) assign(use_strs[i3], TRUE) else break 
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=5 && use_grp) {
		use_ary <- use_dye <- use_ind <- use_samp <- use_pf <- FALSE
		#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
		f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
		mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]);
		}
	if (badmdl) return('Bad data set for any linear model!')


	if (IN_DEBUG_MODE) mdl <<- mdl
	#f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(TRUE, use_pf, use_samp, use_dye)]
	f_rnms <- c('grps', 'pfs', 'samps', 'dyes')[c(use_grp, use_pf, use_samp, use_dye)]
	#f_fixed <- c('Group', 'Platform', 'Sample', 'Dye')[c(TRUE, use_pf, use_samp, use_dye)]
	f_fixed <- c('Group', 'Platform', 'Sample', 'Dye')[c(use_grp, use_pf, use_samp, use_dye)]
	n_fixed <- length(f_fixed)
	mixed <- use_ary || use_ind

	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	if (n_proc == 1 || (nrow(M)<N_para && !mixed) || (nrow(M)<N_para_mix && mixed) ) { # don't use parallel computation if no much data
		rlt <- apply(M, 1, fun)
		#rlt <- apply(M[1:10,], 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		#rlt <- cbind(rlt[rep(1:10,length=nrow(M)), ])
		}
	else
		rlt <- computeM(M, fun, c(liblme, 'multcomp'), min_proc=nproc )

	if (!is.null(contrast_pairs)) {
		i_contrast <- seq(length(contrast_pairs)*2)	
		#rlt_F <- cbind(rlt[, ncol(rlt)], p.adjust(rlt[, ncol(rlt)], method='fdr'))
		rlt_F <- cbind(rlt[,-i_contrast]) }
	else rlt_F <- rlt

	if (ncol(rlt_F) > 0) { # in case that just one group exists
		rlt_F <- rbind(rlt_F, apply(rlt_F, 2, function(x) p.adjust(x, method='fdr')))
		dim(rlt_F) <- c(nrow(rlt), ncol(rlt_F)*2)
		f_fixed <- rep(f_fixed, each=2)
		#colnames(rlt_F) <- c(paste('p_value(F test: ', mdl_s, ')', sep=''), 'p_valFDR(F test)')
		#colnames(rlt_F) <- paste(c('p_value(', 'p_valFDR('), f_fixed, c(paste(' - F test: ', mdl_s, ')', sep=''), ' - F test)'), sep='')
		#cnm_grp <- c(paste('p_value(Group - F test: ', mdl_s, ')', sep=''), 'p_valFDR(Group - F test)')
		cnm_grp <- c(paste('p_value(', f_fixed[1], ' - F test: ', mdl_s, ')', sep=''), paste('p_valFDR(', f_fixed[1], ' - F test)'))
		if (length(f_fixed)>2) cnm_grp <- c(cnm_grp, paste(c('p_value(', 'p_valFDR('), f_fixed[-c(1,2)], ' - F test)', sep='') )
		colnames(rlt_F) <- cnm_grp
		}

	if (is.null(contrast_pairs)) rlt <- cbind(geneM, MEAN, rlt_F)
	else {
		#rlt <- doFdrPerm(rlt[, -ncol(rlt)])
		rlt <- doFdrPerm(rlt[, i_contrast])
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep=''))
		rlt <- cbind(geneM, MEAN, rlt_F, rlt) 
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- if (ncol(rlt_F)>0) rlt_F[,1] else rlt[,2]

	invisible(DTList)
	}

doANOVA_too_long <- function(DTList) { #, analysis_method=DTList$analysis_method) {
	fixedANOVA <- function(x) { #, mpf=XPF) {
		#pv <- try(summary(glht(m <- ifelse(mpf, lm(x ~ grps + pfs), lm(x ~ grps) ), linfct=mcp(grps=contrasts))))
		pv <- try(summary(glht(m <- eval(mdl), linfct=mcp(grps=contrasts))), silent=TRUE)
		if ('try-error' %in% class(pv)) {
			AVx <<- x; AVgrps <<-grps; AVarys <<- arys; AVpfs <<- pfs; AVcont <<- contrasts;
			stop('Error in fixed effects model')
			}
		fp <- anova(m)
		fp <- ifelse(is.null(fp$Pr), NA, fp$Pr[1] )
		return(c(fp, pv$test$pvalues))
		}
	mixedANOVA <- function(x) { #, mpf=XPF) {
		#m <- lme(x ~ grps + arys, random= ~arys | pfs)
		#pv <- try(summary(glht(aov(m), linfct=mcp(grps=contrasts))))
		#pv <- try(summary(glht(aov(m <- lme(x ~ grps + arys, random= ~arys | pfs)), linfct=mcp(grps=contrasts))))
		pv <- try(summary(glht(aov(m <- eval(mdl)), linfct=mcp(grps=contrasts))), silent=TRUE)
		if ('try-error' %in% class(pv)) {
			AVx <<- x; AVgrps <<-grps; AVarys <<- arys; AVpfs <<- pfs; AVcont <<- contrasts;
			stop('Error in mixed effects model')
			}
		fp <- anova(m)
		fp <- ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[1] )
		return(c(fp, pv$test$pvalues))
		}
	#fun <- switch(analysis_method, Fixed_ANOVA=fixedANOVA, Mixed_ANOVA=mixedANOVA)
	
	#require(multcomp)
	fun_both <- function(x) {  
		#pv <- try(summary(glht(eval(mdl), linfct=mcp(grps=contrast_pairs))), silent=TRUE)
		pv <- try(glht(eval(mdl$mdl_lme4), linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) rlt <- rep(NA, length(contrast_pairs)*2) #return(rep(NA, length(contrast_pairs)*2+1))
		else {
			if (is.null(pv$test)) pv <- summary(pv)
			rlt <- c(pv$test$coefficients, pv$test$pvalues)
			}
		# get F p-value
		if ('lmer' %in% class(m)) {
			pv <- try(eval(mdl$mdl_nlme))
			if ('try-error' %in% class(pv)) return(c(rlt, NA))
			#m <- lm(x~grps)
			}
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- NA
		else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp['grps',]$Pr ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
		#else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp$Pr[2] ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
		return(c(rlt, fp))
		}

	fun_nlme <- function(x) {  
		#pv <- try(summary(glht(eval(mdl), linfct=mcp(grps=contrast_pairs))), silent=TRUE)
		# get F p-value
		pv <- try(eval(mdl$mdl_nlme))
		if ('try-error' %in% class(pv)) {
			return(rep(NA, length(contrast_pairs)*2+1))
			fp <- NA
			m <- lm(x~grps)
			}
		else {
			fp <- try(anova(m), silent=TRUE)
			if ('try-error' %in% class(fp)) fp <- NA
			else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp['grps',]$Pr ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
			#else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp$Pr[2] ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) ) # the first p-value is for Intercept
			if ('lme' %in% class(m)) m <- lm(x~grps)
			}
		# multiple comparison
		pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) rlt <- rep(NA, length(contrast_pairs)*2) #return(rep(NA, length(contrast_pairs)*2+1))
		else {
			if (is.null(pv$test)) pv <- summary(pv)
			rlt <- c(pv$test$coefficients, pv$test$pvalues)
			}
		return(c(rlt, fp))
		}
	fun <- fun_nlme

	funtest <- function(x) {  
		##pv <- try(summary(glht(eval(mdl), linfct=mcp(grps=contrast_pairs))), silent=TRUE)
		#mdltmp <- try(eval(mdl$mdl_lme4))
		##mdl <- try(eval(mdl), silent=TRUE)
		#if ('try-error' %in% class(mdltmp)) return(rep(NA, length(contrast_pairs)+1))
		#pv <- try(glht(mdltmp, linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		#if ('try-error' %in% class(pv)) return(rep(NA, length(contrast_pairs)+1))
		#if (is.null(pv$test)) pv <- summary(pv)
		#if ('lmer' %in% class(m)) mdltmp <- try(eval(mdl$mdl_nlme))

		mdltmp <- try(eval(mdl$mdl_nlme))
		if ('try-error' %in% class(mdltmp)) return(rep(NA, length(contrast_pairs)+1))
		fp <- try(anova(m), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- NA
		else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp['grps',]$Pr ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) )
		#else fp <- ifelse( class(m)=='lm',  ifelse(is.null(fp$Pr), NA, fp$Pr[2] ), ifelse(is.null(fp$'p-value'), NA, fp$'p-value'[2] ) )
		if (is.null(fp)) fp <- NA
		return(fp)
		#return(c(fp, pv$test$pvalues))
		}

	#XPF <- DTList$XPF
	#DT <- DTList$data
	pD <- pData(DTList$data)

	GM <- shrinkDups(DTList) # now data were log-transformed
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M

	pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	arys <- factor(paste('Array', pD$array_id, sep='_'))
	dyes <- factor(pD$dye)
	inds <- factor(paste('Individual', pD$individual_id, sep='_'))
	samps <- factor(paste('Samp', pD$sample_id, sep='_'))
	#group <- factor(pD$group)
	#group <- factor(gl(2, 4, labels=c('a','b')))
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))
	#M <- exprs(DT)
	#if (!(DTList$norm_x_pf %in% c('qd', 'qdMod')) && (is.null(DTList$need_log_transform) || DTList$need_log_transform) ) M <- logValue(M) # log transform
	contrast_pairs <- paste(DTList$contrasts, '= 0') #contrasts <- 'groupb - groupa = 0'

	# make model, use pf, array(random), dye, samp(random)?
	# mdl <- expression(lme(...)) # mdl will be used by fixedANOVA, mixedANOVA as mdl <- eval(mdl)


	#conds <- function(x) length(levels(x)) > 1 && any(tapply(x, x, length)>1) # or more conservatively, use all?
	# level number > 1, and more than a half levels has more than 1 occurrences 
	conds <- function(x) length(levels(x)) > 1 && ((feq<-tapply(x, x, length)>1) && sum(feq)*2 >= length(feq) )
	use_pf <- ifelse((is.null(DTList$anova_platform) || DTList$anova_platform) && conds(pfs), TRUE, FALSE) 
	use_ary <- ifelse((is.null(DTList$anova_array) || DTList$anova_array) && conds(arys), TRUE, FALSE)
	use_dye <- ifelse((is.null(DTList$anova_dye) || DTList$anova_dye) && conds(dyes), TRUE, FALSE)
	use_ind <- ifelse((is.null(DTList$anova_individual) || DTList$anova_individual) && conds(inds), TRUE, FALSE)
	use_samp <- ifelse((is.null(DTList$anova_sample) || DTList$anova_sample) && conds(samps), TRUE, FALSE)

	# further filter - should has different levels in a group
	if (use_pf && grp_n == length(unique(paste(grps, pfs)))) use_pf <- FALSE
	if (use_ary && grp_n == length(unique(paste(grps, arys)))) use_ary <- FALSE
	if (use_dye && grp_n == length(unique(paste(grps, dyes)))) use_dye <- FALSE
	if (use_ind && grp_n == length(unique(paste(grps, inds)))) use_ind <- FALSE
	if (use_samp && grp_n == length(unique(paste(grps, samps)))) use_samp <- FALSE

	# factor effects: pf > samp > ind > ary > dye
	if (use_pf) { # check ary, dye, ind and samp
		#this_n <- length(levels(pfs))
		if (use_dye && mean(tapply(dyes, pfs, length))<2) use_dye <- FALSE #this_n == length(unique(paste(pfs, dyes)))) use_dye <- FALSE
		if (use_ary && mean(tapply(arys, pfs, length))<2) use_ary <- FALSE #this_n == length(unique(paste(pfs, arys)))) use_ary <- FALSE
		if (use_ind && mean(tapply(inds, pfs, length))<2) use_ind <- FALSE #this_n == length(unique(paste(pfs, inds)))) use_ind <- FALSE
		if (use_samp && mean(tapply(samps, pfs, length))<2) use_samp <- FALSE #this_n == length(unique(paste(pfs, samps)))) use_samp <- FALSE
		}
	if (use_samp) {
		#this_n <- length(levels(samps))
		if (use_dye && mean(tapply(dyes, samps, length))<2) use_dye <- FALSE #this_n == length(unique(paste(samps, dyes)))) use_dye <- FALSE
		if (use_ary && mean(tapply(arys, samps, length))<2) use_ary <- FALSE #this_n == length(unique(paste(samps, arys)))) use_ary <- FALSE
		if (use_ind && mean(tapply(inds, samps, length))<2) use_ind <- FALSE #this_n == length(unique(paste(samps, inds)))) use_ind <- FALSE
		}
	if (use_ind) {
		#this_n <- length(levels(inds))
		if (use_dye && mean(tapply(dyes, inds, length))<2) use_dye <- FALSE #this_n == length(unique(paste(inds, dyes)))) use_dye <- FALSE
		if (use_ary && mean(tapply(arys, inds, length))<2) use_ary <- FALSE #this_n == length(unique(paste(inds, arys)))) use_ary <- FALSE
		}
	if (use_ary && use_dye && mean(tapply(dyes, arys, length))<2) use_dye <- FALSE #length(levels(dyes)) == length(unique(paste(dyes, arys)))) use_ary <- FALSE

	#use_ratio <- FALSE
	if (DTList$use_ratio && grp_n==2) {
		rlt <- doANOVA_ratio(DTList)
		if (!is.null(rlt)) return(rlt)
		}

	if (FALSE && DTList$use_ratio && grp_n==2) {
		glv = levels(grps)
		chs <- pD$channel_No
		arychs <- paste(arys, chs)
		if (length(arychs) == length(unique(arychs)) ) { # all are unique channels
			site_g1 <- grps == glv[1]
			site_g2 <- !site_g1
			#if (sum(site_g1) == sum(site_g2) && sort(arys[site_g1]) == sort(arys[site_g2])) { # Both groups have the same number of columns, two channels of all arys were distributed into two groups.
			if (sum(site_g1) == sum(site_g2) && length(setdiff(arys[site_g1], arys[site_g2]))==0) { # Both groups have the same number of columns, two channels of all arys were distributed into two groups.
				contrasts <- strsplit(DTList$contrasts, '-') # now contrasts is a list of vectors
				contrasts <- lapply(contrasts, function(x) gsub('(^ +)|( +$)', '', x)) # remove blank
				if (all(sapply(contrasts, function(x) length(x)==2 && all(sort(x) == glv)))) {
					#use_ratio <- TRUE
					ary1 <- as.vector(arys[site_g1])
					ary2 <- as.vector(arys[site_g2])
					rank_g2 <- match(ary2, ary1) # or as.integer(factor(ary1, levels=ary2))
					
					# get group factor for mixed model
					grp <- grp_s <- NULL
					if (is.null(grp) && use_pf){
						grp1 <- as.vector(pfs[site_g1])
						if (all(grp1 == as.vector(pfs[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'platform'

						mdl <- 'lm(x ~ pfs)'

						} 
					if (is.null(grp) && use_samp){
						grp1 <- as.vector(samps[site_g1])
						if (all(grp1 == as.vector(samps[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'sample'

						mdl <- 'lm(x ~ samps)'
						} 
					if (use_ind){
						grp1 <- as.vector(inds[site_g1])
						if (all(grp1 == as.vector(inds[site_g2])[rank_g2])) grp <- grp1
						grp_s <- 'individual'

						mdl <- 'lme(x ~ 1, random = 1 | inds)'
						} 					

					# get data
					M1 <- M[, site_g1]
					M2 <- M[, site_g2][, rank_g2]
					#colnames(M1) <- ary1
					#colnames(M2) <- ary2
					if (contrasts[1] == glv[1]) { # group1 -group2
						M <- M1 - M2 # M1 - M2[, ary1]
						}
					else { # group2 - group1
						M <- M2 - M1 #M2[, ary1] - M1
						}
					fun_fixed <- function(x) {
						fpm <- try(t.test(x), silent=TRUE)
						#fpm <- try(eval(mdl), silent=TRUE)
						if ('try-error' %in% class(fpm)) fp <- c(mean(x), NA)
						else fp <- c(fpm$estimate, fpm$p.value)
						}
					fun_mixed <- function(x) {
						fpm <- try(lme(x~1, random=~1 | grp ), silent=TRUE)
						#fpm <- try(eval(mdl), silent=TRUE)
						if ('try-error' %in% class(fpm)) fp <- c(NA, NA)
						else {
							fp <- try(anova(fpm), silent=TRUE)
							if ('try-error' %in% class(fp)) fp <- c(fpm$coefficients$fixed, NA)
							else {
								fp <- if(is.null(fp$'p-value')) c(fpm$coefficients$fixed, NA) else c(fpm$coefficients$fixed, fp$'p-value'[1])
								}
							}
						}
					if (!is.null(grp)) {
						fun <- fun_mixed #mdl <- parse(text='lme(x~1, random=~1 | grp )')
						mdl_s <- c('M', paste('p_value(F test: lme(x~1, random=~1 |', grp_s, ')'),  'p_valFDR(F test)')
						}
					else {
						fun <- fun_fixed #mdl <- parse(text='lm(x~1)')
						mdl_s <- c('M', 'p_value(paired t-test)', 'p_valFDR(paired t test)')
						}

					nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
					rlt <- computeM(M, fun, c(liblme), min_proc=nproc )
					#colnames(rlt) <- c('p_value(F test)', paste('p_value(', DTList$contrasts, ')', sep=''))
					rlt <- cbind(rlt, p.adjust(rlt[,2], method='fdr'))
					#dim(rlt) <- c(nrow(rlt)/2, ncol(rlt)*2)
					#colnames(rlt) <- c('M', 'p_value(F test:lme(M~1, random=~1 | group)', 'p_valFDR(F test)')
					colnames(rlt) <- mdl_s #c('M', mdl_s, 'p_valFDR(F test)')
					rlt <- cbind(geneM, MEAN, rlt)
					return(invisible(rlt))
					}
				}
			}
		}


	mkMdl_nlme <- function() { # use lme in nmle
		mix <- use_ary || use_ind
		mdlstr <- c(if(mix) 'm <- lme(x ~ grps' else 'm <- lm(x ~ grps', 
			ifelse(use_pf, ' + pfs', ''), 
			ifelse(use_samp, ' + samps', ''), 
			ifelse(use_dye, ' + dyes', ''), 
			if(mix) c(', random = ~', 
				ifelse(use_ind, ifelse(FALSE && use_samp, ' 1 | samps/inds', ' 1 | inds'), ''), 
				if (use_ary) c(ifelse(use_ind, ' +', ''), ifelse(FALSE && use_pf, ' 1 | pfs/arys', '1 | arys')) else '') 
			else '', 
			')' )
		mdlstr_s <- c(if(mix) 'lme(x ~ group' else 'lm(x ~ group', 
			ifelse(use_pf, ' + platform', ''), 
			ifelse(use_samp, ' + sample', ''), 
			ifelse(use_dye, ' + dyes', ''), 
			if(mix) c(', random = ~', 
				ifelse(use_ind, ifelse(FALSE && use_samp, '1 | sample/individual', '1 | individual'), ''), 
				if (use_ary) c(ifelse(use_ind, ' +', ''), ifelse(FALSE && use_pf, ' 1 | platform/array', ' 1 | array')) else '' ) 
			else '', 
			')' )
		
		mdl <- parse(text=paste(mdlstr, collapse=''))
		mdl_s <- paste(mdlstr_s, collapse='')
		list(mdl=mdl, mdl_s=mdl_s)
		}

	mkMdl_lme4 <- function() { # now use lmer in lme4
		mix <- use_ary || use_ind
		mdlstr <- c(if(mix) 'm <- lmer(x ~ grps' else 'm <- lm(x ~ grps', 
			ifelse(use_pf, ' + pfs', ''), 
			ifelse(use_samp, ' + samps', ''), 
			ifelse(use_ind, ifelse(FALSE && use_samp, ' + (1 | samps/inds', ' + (1 | inds)'), ''), 
			ifelse(use_dye, ' + dyes', ''), 
			ifelse(use_ary, ifelse(FALSE && use_pf, ' + (1 | pfs/arys)', ' + (1 | arys)'), ''), 
			')' )
		mdlstr_s <- c(if(mix) 'lmer(x ~ group' else 'lm(x ~ group', 
			ifelse(use_pf, ' + platform', ''), 
			ifelse(use_samp, ' + sample', ''), 
			ifelse(use_ind, ifelse(FALSE && use_samp, ' + (1 | sample/individual', ' + (1 | individual)'), ''), 
			ifelse(use_dye, ' + dye', ''), 
			ifelse(use_ary, ifelse(FALSE && use_pf, ' + (1 | platform/array)', ' + (1 | array)'), ''), 
			')' )
		
		mdl <- parse(text=paste(mdlstr, collapse=''))
		mdl_s <- paste(mdlstr_s, collapse='')
		list(mdl=mdl, mdl_s=mdl_s)
		}
	
	#mkMdl <- if (use_lme4) mkMdl_lme4 else mkMdl_nlme
	mkMdl <- function() {
		m_nlme <- mkMdl_nlme()
		#m_lme4 <- mkMdl_lme4()
		#list(mdl=list(mdl_nlme=m_nlme$mdl, mdl_lme4=m_lme4$mdl), mdl_s=m_lme4$mdl_s)
		list(mdl=list(mdl_nlme=m_nlme$mdl), mdl_s=m_nlme$mdl_s)
		}

	#if (analysis_method == 'Fixed_ANOVA') {
	#	mdl <- ifelse(XPF, expression(lm(x ~ grps + pfs)), expression(lm(x ~ grps)) )
	#	}
	#else {
	#	require(nlme)
	#	#mdl <- expression(lme(x ~ grps + arys, random= ~arys | pfs))
	#	mdlstr <- c('lme(x ~ grps')
	#	if (use_dye) mdlstr <- c(mdlstr, ' + dyes')
	#	if (length(levels(samps)) > 1) mdlstr <- c(mdlstr, ' + samps')
	#	mdl <- parse(paste(mdlstr, collapse=''))
	#	}
	
	# test and adjust the model
	M1 <- M[1,]
	M1[is.na(M1)] <- mean(M1, na.rm=TRUE)

	mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1])

	#while ({mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; is.na(funtest(M1)[1])}) {
	#	if (use_ary) use_ary <- FALSE
	#	else if (use_dye) use_dye <- FALSE
	#	else if (use_ind) use_ind <- FALSE
	#	else if (use_samp) use_samp <- FALSE
	#	else if (use_pf) use_pf <- FALSE
	#	else break
	#	}

	use_strs <- c('use_dye', 'use_ary', 'use_ind', 'use_samp', 'use_pf')
	#use_str_vals <- sapply(use_strs, get) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	use_str_vals <- sapply(use_strs, function(x) get(x, pos=-1) ) #function(x) eval(parse(text=x))) #c(use_ary, use_dye, use_ind, use_samp, use_pf)
	#use_str_vals <- sapply(use_strs, get) 
	#use_str_vals <- sapply(use_strs, function(x) get(x, pos=-3) ) 
	use_strs <- use_strs[use_str_vals]
	str_n <- length(use_strs)
	if (badmdl && str_n>=1) # try to disable one
		for (use_str in use_strs) {
			assign(use_str, FALSE); 
			mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
			if(badmdl) assign(use_str, TRUE) else break
			}
	if (badmdl && str_n>=2) # try to disable two
		for (i1 in seq(str_n-1)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n)) {
				assign(use_strs[i2], FALSE); 
				mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
				if(badmdl) assign(use_strs[i2], TRUE) else break
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=3) # try to disable three
		for (i1 in seq(str_n-2)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-1)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n)) {
					assign(use_strs[i3], FALSE); 
					mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
					if(badmdl) assign(use_strs[i3], TRUE) else break
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=4) # try to disable four
		for (i1 in seq(str_n-3)) {
			assign(use_strs[i1], FALSE)
			for (i2 in seq(i1+1, str_n-2)) {
				assign(use_strs[i2], FALSE)
				for (i3 in seq(i2+1, str_n-1)) {
					assign(use_strs[i3], FALSE); 
					for (i4 in seq(i3+1, str_n)) {
						assign(use_strs[i4], FALSE); 
						mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]); 
						if (badmdl) assign(use_strs[i4], TRUE) else break
						}
					if (badmdl) assign(use_strs[i3], TRUE) else break 
					}
				if (badmdl) assign(use_strs[i2], TRUE) else break 
				}
			if (badmdl) assign(use_strs[i1], TRUE) else break 
			}
	if (badmdl && str_n>=5) {
		use_ary <- use_dye <- use_ind <- use_samp <- use_pf <- FALSE
		mdl <- mkMdl(); mdl_s <- mdl$mdl_s; mdl <- mdl$mdl; badmdl <- is.na(funtest(M1)[1]);
		}
	if (badmdl) return('Bad data set for any linear model!')


	if (IN_DEBUG_MODE) mdl <<- mdl
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	if (nproc == 1) { # for test purpose
		rlt <- apply(M, 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		}
	else
		rlt <- computeM(M, fun, c(liblme, 'multcomp'), min_proc=nproc )
	
	#save(mdl, file='/tmp/mdl.Rdata')
	#rlt <- computeM(M[1:100,], fun, c(liblme, 'multcomp'), min_proc=nproc )
	#write.table(rlt, file='/tmp/rlt.txt', sep='\t', quote=FALSE, row.names=FALSE)
	#rlt <- rlt[rep(1:100, length=nrow(M)), ]
	
	#colnames(rlt) <- c('p_value(F test)', paste('p_value(', DTList$contrasts, ')', sep=''))

	#rlt_F <- cbind('p_value(F test)'=rlt[, ncol(rlt)], 'p_valFDR(F test)'=p.adjust(rlt[, ncol(rlt)], method='fdr'))
	rlt_F <- cbind(rlt[, ncol(rlt)], p.adjust(rlt[, ncol(rlt)], method='fdr'))
	colnames(rlt_F) <- c(paste('p_value(F test: ', mdl_s, ')', sep=''), 'p_valFDR(F test)')
	#rlt_F <- c("cbind('p_value(F test: ", mdl_s, ")'=rlt[, ncol(rlt)], 'p_valFDR(F test)'=p.adjust(rlt[, ncol(rlt)], method='fdr')")
	#rlt_F <- eval(parse(text=paste(rlt_F, collapse='')))

	if (is.null(contrast_pairs)) rlt <- cbind(geneM, MEAN, rlt_F)
	else {
		if (FALSE) { # might be slower
			i_M <- floor(ncol(rlt)/2) # column number is 2 * comparison_paris(T test) + 1 (F test)
			rlt_M <- cbind(NULL, rlt[, 1:i_M]) # use cbind to make it keep as a matrix
			#colnames(rlt_ratio) <- paste('M(', DTList$contrasts, ')', sep='')
			rlt_p <- cbind(NULL, rlt[, (i_M+1):(ncol(rlt)-1)]) # use cbind to make it keep as a matrix
			rlt <- rbind(rlt_M, rlt_p, cbind(NULL, apply(rlt_p, 2, function(x) p.adjust(x, method='fdr'))))
			dim(rlt) <- c(nrow(rlt)/3, ncol(rlt)*3)
			}
		else { # might be faster
			rlt <- doFdrPerm(cbind(rlt[, -ncol(rlt)]))
			#cn <- ncol(rlt)-1
			#rlt <- rlt[, 1:cn]
			#cn <- cn/2
			#rn <- nrow(rlt)
			#rlt <- cbind(rlt, cbind(apply(rlt[,(cn+1):(cn+cn)], 2, function(x) p.adjust(x, method='fdr'))))
			#dim(rlt) <- c(rn, cn, 3)
			#rlt <- aperm(rlt, c(1, 3, 2))
			#dim(rlt) <- c(rn, cn*3)
			}

		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts, each=3), ')', sep=''))
		rlt <- cbind(geneM, MEAN, rlt_F, rlt)
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- rlt_F[,1]

	invisible(DTList)
	}

getBlock <- function(DTList) {
	pD <- pData(DTList$data)
	grps_str <- paste('group', pD$group, sep='')
	grps <- factor(grps_str)
	glv = levels(grps)
	grp_n <- length(glv)


	site_g1 <- grps == glv[1]
	site_g2 <- !site_g1
	ratio_by <- DTList$ratio_by
	if (ratio_by == 'data_order') { # make blocks
		blk <- grps_str
		for (k in glv) {
			site <- which(grps_str==k)
			blk[site] <- paste('blk_', seq(site), sep='')
			}
		pD$blk <- blk
		}
	dic <- c('array'='array_id', 'platform'='platform_id', 'dye'='dye', 'individual'='individual_id', 'sample'='sample_id', 'data_order'='blk')
	nms <- if (ratio_by=='auto') names(dic) else ratio_by

	# decide paired and idx
	paired <- FALSE
	idx <- NULL
	blk_nm <- NULL
	if (grp_n == 2) {
		grp_sum <- table(grps)
		if (grp_sum[1] == grp_sum[2]) { # each groups should have the same number of columns
			for (ratio_by in nms) {
				blk_tmp <- pD[[dic[ratio_by]]]
				ord1 <- order(blk_tmp[site_g1])
				ord2 <- order(blk_tmp[site_g2])
				#if (all(sort(blk_tmp[site_g1]) == sort(blk_tmp[site_g2]))) { # less strict: only require that each block has same number in every group
				#if (all(blk_tmp[site_g1][ord1] == blk_tmp[site_g2][ord2])) { # a little faster?
				if (all(table(grps, blk_tmp)==1)) { # strict requirement: each block has 1 in each group
					paired <- TRUE
					idx <- c(which(site_g1)[ord1], which(site_g2)[ord2])
					blk_nm <- paste('paired by', ratio_by)
					break
					} 
				}
			}
		}

	# choose the method that let the number of blocks that appear in all groups should be the biggest
	num_max <- 0
	blk <- NULL
	if (! paired) { # then try blocks
		for (ratio_by in nms) {
			blk_tmp <- pD[[dic[ratio_by]]]
			# find the number of blocks that appear in all groups
			num_tmp <- sum(apply(table(blk_tmp, grps), 1, function(x) all(x)>0))
			if (num_tmp > num_max) {
				num_max <- num_tmp
				blk <- blk_tmp
				blk_nm <- paste('blocked by', ratio_by)
				}
			}
		}

	return(list(blocks=blk, paired=paired, idx=idx, block_nm=blk_nm))
	}
	
nonPara <- function(DTList) {
	#require(muStat)
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	pD <- pData(DTList$data)
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))
	#pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	#conds <- function(x) length(levels(x)) > 1 && ((feq<-tapply(x, x, length)>1) && sum(feq)*2 >= length(feq) )
	#use_pf <- ifelse(conds(pfs), TRUE, FALSE)
	#blk <- if(use_pf) pfs else NULL
	blk <- if (DTList$use_ratio) getBlock(DTList) else NULL
	paired <- if (is.null(blk$paired)) FALSE else blk$paired
	blocks <- blk$blocks
	new_idx <- blk$idx
	if (paired) { # get the index in order to sort x in both groups into the same order
		grps <- grps[new_idx]
		blocks <- blocks[new_idx]
		}
	
	GM <- shrinkDups(DTList) # now data were log-transformed
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M

	#frm <- parent.frame()
	#prentice_test <- prentice.test
	#fun <- function(x) prentice.test(x, grps, blk)$p.value
	contrast_pairs <- if (grp_n < 2 || is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'
	fun <- function(x) {
		if (paired) x <- x[new_idx]
		fp <- prentice.test(x, grps, blocks=blocks, paired=paired)$p.value
		if (is.null(contrast_pairs)) return(fp)
		pv <- try(glht(eval(parse(text='lm(x ~ grps)')), linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) return(c(rep(NA, length(contrast_pairs)*2), fp))
		if (is.null(pv$test)) pv <- try(summary(pv), silent=TRUE)
		if ('try-error' %in% class(pv)) return(c(rep(NA, length(contrast_pairs)*2), fp))
		return(c(pv$test$coefficients, pv$test$pvalues, fp))
		}

	if (n_proc == 1 || nrow(M) < N_para) { # don't use parallel computation if no much data

		rlt <- apply(M, 1, fun)
		#rlt <- apply(M[1:10,], 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		#rlt <- rlt[rep(1:10, length=nrow(M)), ]
		}
	else
		rlt <- computeM(M, fun, c('muStat', 'multcomp'), min_proc=nproc)
		#rlt <- computeM(M[1:100,], fun, c('muStat', 'multcomp'), min_proc=nproc )
		#rlt <- t(apply(M[1:100,], 1, fun))
		#rlt <- rlt[rep(1:100, length=nrow(M)), ]

	#return(rlt)
	#rlt <- computeM(M, fun)
	#rlt <- as.matrix(apply(M, 1, fun))
	#rlt <- t(as.matrix(apply(M, 1, fun)))
	
	#require(snow)
	#cl <- try(makeCluster(2))
	##mpi.remote.exec('source("inqIntensity.R")')
	#if (class(cl)[[1]]=='try-error')
	#	rlt <- apply(M, 1, fun)
	#else {
	#	#clusterCall(cl, library, 'muStat')
	#	#clusterEvalQ(cl, library(muStat))
	#	clusterEvalQ(cl, eval(parse(text=paste('library(', 'muStat',')'))))
	#	rlt <- parApply(cl, M, 1, fun)
	#	stopCluster(cl)
	#	}
	#if (is.null(dim(rlt))) rlt <- as.matrix(rlt)
	#else rlt <- t(rlt)

	# get ratio (M)
	#rlt_M <- t(apply(M, 1, function(x) tapply(x, grps, mean)))
	#colnames(rlt_M) <- paste('M(', colnames(rlt_M), ')', sep='')

	#rlt <- cbind(rlt, p.adjust(rlt, method='fdr'))
	#colnames(rlt) <- c('p_value(non-parametric test)', 'p_valFDR(non-parametric test)')
	#rlt <- cbind(geneM, rlt_M, rlt)
	
	#rlt <- cbind(rlt, p.adjust(rlt[, ncol(rlt)], method='fdr'))
	#colnames(rlt) <- c(paste('M(', DTList$contrasts, ')', sep=''), if (is.null(blk$block_nm)) 'p_value(non-parametric test)' else paste('p_value(non-parametric test - ', blk$block_nm, ')', sep=''), 'p_valFDR(non-parametric test)')[1:ncol(rlt)]
	rlt_F <- cbind(rlt[, ncol(rlt)], p.adjust(rlt[, ncol(rlt)], method='fdr'))
	colnames(rlt_F) <- c(if (is.null(blk$block_nm)) 'p_value(non-parametric test)' else paste('p_value(non-parametric test - ', blk$block_nm, ')', sep=''), 'p_valFDR(non-parametric test)')
	if (is.null(contrast_pairs)) rlt <- cbind(geneM, MEAN, rlt_F)
	else {
		rlt <- doFdrPerm(cbind(rlt[, -ncol(rlt)]))
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts, each=3), ')', sep=''))
		rlt <- cbind(geneM, MEAN, rlt_F, rlt)
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- rlt_F[,1]

	invisible(DTList)
	}

pairedTTest <- function(M, nproc=1) { # lm(x~1)
	if (is.null(M)) return(NULL)
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	fun <- function(x) {
		rlt <- try(t.test(x), silent=TRUE)
		if ('try-error' %in% class(rlt)) pv <- c(mean(x), NA)
		else pv <- c(rlt$estimate, rlt$p.value)
		}
	if (n_proc == 1 || nrow(M) < N_para) { # don't use parallel computation if no much data
		rlt <- apply(M, 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		M <- doFdrPerm(rlt)
		}
	else
		M <- doFdrPerm(computeM(M, fun, min_proc=nproc))
	colnames(M) <- c('M(Ratio)', 'p-value(paired t-test)', 'pFDR(paired t-test)')
	M
	}

doTTest <- function(DTList) {
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	pD <- pData(DTList$data)
	pfs <- factor(paste('Pf', pD$platform_id, sep='_'))
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))
	
	GM <- shrinkDups(DTList) # now data were log-transformed
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M
	
	# paired test
	if (DTList$use_ratio && length(levels(grps))==2) RM <- getRatioM(DTList)$M
	else RM <- NULL
	if (!is.null(RM)) RM <- pairedTTest(RM, nproc=nproc) # paired t-test

	contrast_pairs <- if (grp_n < 2 || is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'
	fun <- function(x) {
		fp <- try(anova(eval(parse(text='m <- lm(x ~ grps)'))), silent=TRUE)
		if ('try-error' %in% class(fp)) fp <- NA
		else fp <- ifelse(is.null(fp$Pr), NA, fp['grps',]$Pr ) 
		#else fp <- ifelse(is.null(fp$Pr), NA, fp$Pr[2] ) # the first p-value is for Intercept

		if (is.null(contrast_pairs)) return(fp)
		#pv <- try(glht(eval(parse(text='lm(x ~ grps)')), linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		pv <- try(glht(m, linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) return(c(rep(NA, length(contrast_pairs)*2), fp))
		pv <- try(summary(pv)$test, silent=TRUE)
		if ('try-error' %in% class(pv)) return(c(rep(NA, length(contrast_pairs)*2), fp))
		return(c(pv$coefficients, pv$pvalues, fp))
		}

	if (n_proc == 1 || nrow(M) < N_para) { # don't use parallel computation if no much data
		rlt <- apply(M, 1, fun)
		if (nrow(M) <= 1) rlt <- rbind(rlt)
		else if (!is.null(dim(rlt))) rlt <- t(rlt)
		else rlt <- cbind(rlt)
		M <- rlt #doFdrPerm(rlt)
		}
	else
		M <- computeM(M, fun, c('muStat', 'multcomp'), min_proc=nproc)
	
	rlt_F <- cbind(M[, ncol(M)], p.adjust(M[, ncol(M)], method='fdr'))
	colnames(rlt_F) <- c('p_value(Intensity ~ groups)', 'p_valFDR(Intensity ~ groups)')
	if (ncol(M) > 1) {
		M <- doFdrPerm(cbind(M[, -ncol(M)]))
		colnames(M) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep='')) 
		rlt <- if(is.null(RM)) cbind(geneM, MEAN, rlt_F, M) else cbind(geneM, MEAN, RM, rlt_F, M)
		}
	else 
		rlt <- if(is.null(RM)) cbind(geneM, MEAN, rlt_F) else cbind(geneM, MEAN, RM, rlt_F)


	DTList$dif_result <- rlt
	DTList$dif_pvalue <- if (is.null(RM)) rlt_F[,1] else RM[,2]

	invisible(DTList)
	}

doSAM <- function(DTList) {
	require(siggenes)
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	pD <- pData(DTList$data)
	blocks <- pD$group
	grps <- factor(paste('group', pD$group, sep=''))
	grp_n <- length(levels(grps))
	
	GM <- shrinkDups(DTList) # now data were log-transformed
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M

	# check paired data
	blk <- NULL
	new_idx <- NULL
	paired <- FALSE
	if (DTList$use_ratio && length(levels(grps))==2) {
		blk <- if (DTList$use_ratio) getBlock(DTList) else NULL
		if (blk$paired) {
			blocks <- seq(length(blocks)/2)
			blocks <- c(blocks, -blocks)
			new_idx <- blk$idx
			paired <- TRUE
			}
		}

	contrast_pairs <- if (grp_n < 2 || is.null(DTList$contrasts_simple) || length(DTList$contrasts_simple)<1) NULL else paste(DTList$contrasts_simple, '= 0') #contrasts <- 'groupb - groupa = 0'
	fun <- function(x) {
		pv <- try(glht(eval(parse(text='lm(x ~ grps)')), linfct=mcp(grps=contrast_pairs)), silent=TRUE)
		if ('try-error' %in% class(pv)) return(rep(NA, length(contrast_pairs)*2) )
		if (is.null(pv$test)) pv <- try(summary(pv), silent=TRUE)
		if ('try-error' %in% class(pv)) return(rep(NA, length(contrast_pairs)*2) )
		return(c(pv$test$coefficients, pv$test$pvalues))
		}

	rlt_F <- sam(if(paired) M[, new_idx] else M, blocks, rand=123)@p.value
	rlt_F <- cbind(rlt_F, p.adjust(rlt_F, method='fdr'))
	colnames(rlt_F) <- c(if (paired) paste('p_value(SAM - ', blk$block_nm, ')', sep='') else 'p_value(SAM)', 'p_valFDR(SAM)')
	
	if (is.null(contrast_pairs)) rlt <- cbind(geneM, MEAN, rlt_F) 
	else {
		if (n_proc > 1 && nrow(M) >= N_para)
			rlt <- computeM(M, fun, c('muStat', 'multcomp'), min_proc=nproc)
		else {
			rlt <- apply(M, 1, fun)
			#rlt <- t(apply(M[1:100, ], 1, fun))
			#rlt <- rlt[rep(1:100, length=nrow(M)), ]
			if (nrow(M) <= 1) rlt <- rbind(rlt)
			else if (!is.null(dim(rlt))) rlt <- t(rlt)
			else rlt <- cbind(rlt)
			}
		rlt <- doFdrPerm(rlt)
		colnames(rlt) <- c(paste(c('M(', 'p_value(', 'p_valFDR('), rep(DTList$contrasts_simple, each=3), ')', sep=''))
		rlt <- cbind(geneM, MEAN, rlt_F, rlt)
		}

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- rlt_F[,1]

	invisible(DTList)
	}

doFold <- function(DTList) {
	nproc <- if(is.null(DTList$nproc)) 1 else DTList$nproc
	n_proc <- if (is.character(nproc)) length(nproc) else nproc
	pD <- pData(DTList$data)
	#grps <- factor(paste('group', pD$group, sep=''))
	grps <- paste('group', pD$group, sep='')
	
	GM <- shrinkDups(DTList) # now data were log-transformed
	DTList$gpos4dups <- GM$gpos
	M <- GM$M
	MEAN <- getAverageM(M, pD$group)
	geneM <- GM$geneM
	rm(GM)
	gc()
	DTList$M <- M

	for (gnm in unique(grps)) assign(gnm, rowMeans(cbind(M[, which(grps==gnm)])))
	rlt <- cbind(sapply(DTList$contrasts, function(cnt) eval(parse(text=cnt))))
	rlt <- rbind(rlt, 2^rlt)
	dim(rlt) <- c(nrow(rlt)/2, ncol(rlt)*2)
	colnames(rlt) <- paste(c('M(', 'Fold change('), rep(DTList$contrasts, each=2), ')', sep='')

	rlt <- cbind(geneM, MEAN, rlt)

	DTList$dif_result <- rlt
	DTList$dif_pvalue <- NULL #rlt_F[,1]

	invisible(DTList)
	}

saveExpInfo <- function(DTList) {
	pD <- pData(DTList$data)
	#try(write.table(pD, file=mkFn(DTList$result_dir, DTList$req_name, '_exp_info.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
	try(write.table(pD, file=mkFn(DTList$result_dir, 'exp_info.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
	}

retData <- function(DTList) {
	# save RData
	# if (!is.null(DTList$result_dir)) try({MPList <- DTList; save(MPList, file=paste(DTList$result_dir, ifelse(substr(DTList$result_dir,nchar(DTList$result_dir),nchar(DTList$result_dir))=='/', '', '/'), DTList$req_name, '_MPList.Rdata', sep=''))})
	# get gene M
	#geneM <- if (DTList$XPF && DTList$match_probe) cbind(DTList$genes, xpf_names=DTList$xpf_names) else DTList$genes
	geneM <- DTList$genes
	# get data M
	M <- DTList$data
	#if ('RGList' %in% class(M)) {
	#	colnames(M$R) <- paste('R', colnames(M$R), sep='_')
	#	colnames(M$G) <- paste('G', colnames(M$G), sep='_')
	#	M <- cbind(M$R, M$G)
	#	}
	#else M <- exprs(M)

	# write information from pD
	pD <- pData(DTList$data)
	#try(write.table(pD, file=mkFn(DTList$result_dir, DTList$req_name, '_exp_info.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)

	M <- exprs(M) #assayData(M) 
	MEAN <- getAverageM(M, pD$group, fun=MyLogMean, prefix='Average Intensity (geometric mean of ')
	invisible(cbind(geneM, MEAN, M))
	}

analyzeDTList <- function(DTList) {
	#if (DTList$XPF) 
	#	return(analyzeXPF(DTList))
	#else
	#	if (class(DTList$data) == 'exprSet') return(analyzeSingleChannels(DTList))
	#	else # should be RGList
	#		return(analyzeDualChannels(DTList))
	if (class(DTList$data) == 'RGList') return(analyzeDualChannels(DTList))
	#pe <- parent.frame()
	#eval('library(nlme)', pe)
	#eval('library(multcomp)', pe)
	# analyze
	analysis_method <- DTList$analysis_method
	if (analysis_method == 'LIMMA') { 
		if (DTList$use_ratio && DTList$has_two_chs && DTList$ratio_by=='array') return(analyzeDualChannels(DTList)) # ratio_by "array" only
		return(analyzeSingleChannels(DTList))
		}
	else if (analysis_method %in% c('ANOVA', 'Fixed_ANOVA', 'Mixed_ANOVA')) return(doANOVA(DTList)) 
	else if (analysis_method == 'ttest') return(doTTest(DTList))
	else if (analysis_method == 'nonPara') return(nonPara(DTList))
	else if (analysis_method == 'SAM') return(doSAM(DTList))
	else if (analysis_method == 'fold') return(doFold(DTList))
	#else if (analysis_method == 'get_data') return(retData(DTList))

	}

mkRltTable <- function(rlt) { # not used now
	if (FALSE && rlt$XPF && rlt$match_probe)
		rltb <- cbind(rlt$xpf_names, rlt$p.value, F=rlt$F, 'p_value(F test)'=rlt$F.p.value)
	else
		rltb <- cbind(rlt$genes, rlt$p.value, F=rlt$F, 'p_value(F test)'=rlt$F.p.value)
	#save(rltb, file='/home/xxia/temp/inqInt_fitb.Rdata')
	invisible(rltb)
	}

plotHeatMap <- function(x, main_title='HEATMAP', dendrogram='both', fun=hclust, LOG=TRUE, ...) {
	require(gplots)
	y <- data.matrix(x)
	if (LOG) y <- log2(y) # log10(y)
	#dist.x <- dist(y, method='euclidean', diag=TRUE)
	#dist.y <- dist(t(y), method='euclidean', diag=TRUE)
	#clust.x <- hclust(dist.x, method='centroid')
	#clust.y <- hclust(dist.y, method='centroid')
	rownames(y) <- sub('(?<=.{20}).{4,}', '\\.\\.\\.', rownames(y), perl=TRUE)
	colnames(y) <- sub('(?<=.{20}).{4,}', '\\.\\.\\.', colnames(y), perl=TRUE)
	mx <- max(nchar(colnames(y)))/2 + 3 + 1
	my <- max(nchar(rownames(y)))/3 + 2 + 1
	#my <- max(nchar(rownames(y)))/2.5 + 2 
	rc <- rainbow(nrow(y), start=0, end=0.4)
	cc <- rainbow(ncol(y), start=0, end=0.4)
	#hv <- heatmap(y, hclustfun=fun, col=greenred(75), scale='row', RowSideColors=rc, ColSideColors=cc, key=TRUE, symkey=FALSE, density.info='none', trace='none', cexRow=0.5, xlab='Samples', ylab='Genes', main=main_title)
	#hv <- heatmap(y, hclustfun=fun, col=greenred(75), scale='row', RowSideColors=rc, ColSideColors=cc, key=TRUE, symkey=FALSE, density.info='none', trace='none', cexRow=0.5, xlab='Samples', ylab='Genes', main=main_title)
	#hv <- heatmap.2(y, hclustfun=fun, col=greenred(75), scale='row', dendrogram=dendrogram, RowSideColors=rc, ColSideColors=cc, key=TRUE, symkey=FALSE, density.info='none', trace='none', xlab='Samples', ylab='Genes', main=main_title, margins=c(mx, my), cexRow=0.8, cexCol=1.5, ...)
	hv <- heatmap.2(y, hclustfun=fun, col=greenred(75), scale='row', dendrogram=dendrogram, RowSideColors=rc, ColSideColors=cc, key=TRUE, symkey=FALSE, density.info='none', trace='none', xlab=NULL, ylab=NULL, main=main_title, margins=c(mx, my), cexRow=0.8, cexCol=1.2, ...)
	}

groupM <- function(M, group=NULL) {
	if (is.null(group)) return(M)
	uni_grp <- sort(unique(group))
	if (length(uni_grp)>=2) { # use group only there 2 or more groups exist
		M <- sapply(uni_grp, function(x) rowMeans(cbind(M[, group==x])))
		colnames(M) <- group <- uni_grp
		}
	invisible(M) 
	}

clustM <- function(M, fn=NULL, plot_pdf=FALSE) {
	if (is.null(fn)) X11() 
	else {
		if (plot_pdf) pdf(fn, pointsize=15, width=min(16, 4+ncol(M)/3), height=min(48, 4 + max(nchar(colnames(M)))/12 + ncol(M)*0.2))
		else bitmap(fn, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=min(16, 4+ncol(M)/3), height=min(48, 4 + max(nchar(colnames(M)))/12 + ncol(M)*0.2) )
		}
	#plot(hclust(dist(t(M))), xlab='', sub='')
	hcd <- try(hclust(dist(t(M))))
	if ('try-error' %in% class(hcd)) {
		plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
		text(5,6, 'Failed in clustering analysis!')
		}
	else plot(hclust(dist(t(M))), xlab='', sub='')
	dev.off()
	}

heatmapM <- function(M, fn=NULL, plot_pdf=FALSE, r_max=5000) {
	nr <- nr_orig <- nrow(M)
	fail <- FALSE
	if (nr > r_max) {
		nr <- 5
		fail <- TRUE}
	if (is.null(fn)) X11() 
	else {
		if (plot_pdf) pdf(fn, pointsize=15, width=min(16, 4+ncol(M)/3), height=min(48, 4 + max(nchar(colnames(M)))/15 + log2(nr*1.5)))
		else bitmap(fn, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=min(16, 4+ncol(M)/3), height=min(48, 4 + max(nchar(colnames(M)))/15 + log2(nr)*1.5) )
		}
	if (fail) {
		plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
		text(5,6, paste('I won\'t plot heat map for too many probes (over ', nr_orig, ' offered!)', sep=''))
		}
	else {
		rlt <- try(plotHeatMap(M, LOG=FALSE))
		if ('try-error' %in% class(rlt)) {
			plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
			text(5,6, 'Failed in plotting heat map! \nPerhaps too many probes have been used?')
			}
		}
	dev.off()
	}

doCOA <- function(M, grps, coa_num=5, fn_gene=NULL, fn_chart=NULL, plot_pdf=FALSE) {
	require(made4)
	require(ade4)
	if (is.null(fn_chart)) X11() 
	else {
		if (plot_pdf) pdf(fn_chart, pointsize=15, width=16, height=16)
		else bitmap(fn_chart, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=16, height=16 )
		}
	rlt <- try(ord(M, type='coa'))
	n_grp <- length(unique(grps))
	#colors <- c('red','blue','yellow','green', 'brown', 'grey', 'pink', 'purple')
	#plot(rlt, classvec=grps, arraycol=colors[rep(seq(colors), length=n_grp)], n=coa_num, genecol='grey3')
	if ('try-error' %in% class(rlt)) {
		plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
		text(5,6, 'Failed in Correspondence Analysis!')
		}
	else plot(rlt, classvec=grps, n=coa_num)
	dev.off()
	if (is.null(fn_gene)) return()
	g1p <- topgenes(rlt, axis=1, end='pos', n=coa_num)
	g1n <- topgenes(rlt, axis=1, end='neg', n=coa_num)
	g2p <- topgenes(rlt, axis=2, end='pos', n=coa_num)
	g2n <- topgenes(rlt, axis=2, end='neg', n=coa_num)
	rlt <- data.frame(axis=c('X pos', 'X neg', 'Y pos', 'Y neg'), genes=c(paste(g1p, collapse=','), paste(g1n, collapse=','), paste(g2p, collapse=','), paste(g2n, collapse=',')))
	write.table(rlt, file=fn_gene, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t')
	}

doBGA <- function(M, grps, bga_num=5, fn_gene=NULL, fn_chart=NULL, plot_pdf=FALSE) {
	require(made4)
	require(ade4)
	if (is.null(fn_chart)) X11() 
	else {
		if (plot_pdf) pdf(fn_chart, pointsize=15, width=16, height=16)
		else bitmap(fn_chart, type=if (plot_pdf) 'pdfwrite' else 'png256', pointsize=15, width=16, height=16 )
		}
	rlt <- bga(M, type='coa', classvec=grps)
	n_grp <- length(unique(grps))
	#colors <- c('red','blue','yellow','green', 'brown', 'grey', 'pink', 'purple')
	#plot(rlt, classvec=grps, arraycol=colors[rep(seq(colors), length=n_grp)], n=coa_num, genecol='grey3')
	if ('try-error' %in% class(rlt)) {
		plot(1:10, axes=FALSE, xlab='', ylab='', type='n')
		text(5,6, 'Failed in Between Group Analysis!')
		}
	else plot(rlt, n=bga_num)
	dev.off()
	if (is.null(fn_gene)) return()
	g1p <- topgenes(rlt, axis=1, end='pos', n=bga_num)
	g1n <- topgenes(rlt, axis=1, end='neg', n=bga_num)
	g2p <- topgenes(rlt, axis=2, end='pos', n=bga_num)
	g2n <- topgenes(rlt, axis=2, end='neg', n=bga_num)
	rlt <- data.frame(axis=c('X pos', 'X neg', 'Y pos', 'Y neg'), genes=c(paste(g1p, collapse=','), paste(g1n, collapse=','), paste(g2p, collapse=','), paste(g2n, collapse=',')))
	write.table(rlt, file=fn_gene, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t')
	}

aveVec <- function(V, n=3, fun=median) { # replace the elements with the median of its n neighbours including itself
	if (n<=1) return(V)
	n_prefix <- (n-1) %/% 2
	n_post <- n - 1 - n_prefix # n_post - n_prefix == 0 or 1
	ln <- length(V)
	V <- c(if (n_prefix>0) V[(ln-n_prefix+1):ln] else NULL, V, if (n_post>0) V[1:n_post] else NULL)
	sapply(seq(n_prefix+1, n_prefix+ln), function(i, n1=n_prefix, n2=n_post) fun(V[(i-n1):(i+n2)]))
	}

getTnToken <- function(A, idxPosi, idxNeg, tn_threshold_M=1.5, tn_threshold_A=0.5, M=NULL, p=NULL) {
	# get transposon postion
	if (is.null(tn_threshold_M) || tn_threshold_M <= 0) tn_threshold_M <- log2(1.5)
	else tn_threshold_M <- log2(tn_threshold_M)

	nPosi <- length(idxPosi)
	nNeg  <- length(idxNeg)
	A_cut <- quantile(A, tn_threshold_A)[[1]] #quantile(A, 2/3)[[1]]  #8.178628
	M_cut <- tn_threshold_M #1 #log(2, 2)
	n <- length(A)
	Tn_token <- rep(as.integer(NA), n)
	M_med <- if (is.null(M)) NULL else rep(NA, n)
	p_med <- if (is.null(p)) NULL else rep(NA, n)
	# positive strand
	A_pos <- A[idxPosi]
	#Tn_pos <- apply(array(c(A_pos[nPosi], A_pos[1:(nPosi-1)],     A_pos,
	#	A_pos[2:nPosi], A_pos[1],		A_pos[3:nPosi], A_pos[1:2]), c(nPosi, 4)), 1,
	#	function(x, Acut=A_cut, Mcut=M_cut) if(x[1]>Acut && x[1]<(x[2]+Mcut) && x[2]>(x[3]+Mcut) && x[2]>(x[4]+Mcut)) TRUE else FALSE)
	# use less memory but maybe a little slower
	Tn_pos <- c(A_pos[nPosi], A_pos, A_pos[1:2])
	#Tn_pos <- sapply(seq(nPosi), function(i, x=Tn_pos, Acut=A_cut, Mcut=M_cut) x[i]>Acut && x[i]<(x[i+1]+Mcut) && x[i+1]>(x[i+2]+Mcut) && x[i+1]>(x[i+3]+Mcut) ) # A1 > Acut
	Tn_pos <- sapply(seq(nPosi), function(i, x=Tn_pos, Acut=A_cut, Mcut=M_cut) x[i+1]>Acut && x[i]<(x[i+1]+Mcut) && x[i+1]>(x[i+2]+Mcut) && x[i+1]>(x[i+3]+Mcut) ) # A2 > Acut
	idx <- which(Tn_pos) # idx is the index in the positive strand
	if (!is.null(p) && length(idx)>0) {
		p_pos <- p[idxPosi]
		p_pos <- c(p_pos, p_pos[1:4])
		A_pos <- c(A_pos, A_pos[1:4])
		p_med[idxPosi[idx]] <- p_med[idxPosi[idx-1]] <- sapply(idx, function(i) { 
			#pos <- idxPosi[i:min(i+4, length(idxPosi))]
			#median(p[pos][which(A[pos]>A_cut)], na.rm=TRUE)
			median(p_pos[i:(i+4)][which(A[i:(i+4)]>A_cut)], na.rm=TRUE)
			} ) 
		}
	if (!is.null(M) && length(idx)>0) {
		M_pos <- M[idxPosi]
		M_pos <- c(M_pos, M_pos[1:4])
		if (length(A_pos) == nPosi) A_pos <- c(A_pos, A_pos[1:4])
		M_med[idxPosi[idx]] <- M_med[idxPosi[idx-1]] <- sapply(idx, function(i) { 
			#pos <- idxPosi[i:min(i+4, length(idxPosi))]
			#median(M[pos][which(A[pos]>A_cut)], na.rm=TRUE)
			median(M_pos[i:(i+4)][which(A[i:(i+4)]>A_cut)], na.rm=TRUE)
			} )
		}
	Tn_token[idxPosi[idx-1]] <- as.integer(1) #0.5
	#Tn_token[idxPosi[idx]] <- as.integer(1) #0.5
	Tn_token[idxPosi[idx]] <- as.integer(2) #1  Actually this one is A2 !!!!!!
	#Tn_token[idxPosi[idx+1]] <- as.integer(2) #1 # use A2 as the location of transposon!!!
	# negative strand
	A_pos <- A[idxNeg]
	Tn_pos <- apply(array(c(A_pos[c((nNeg-1), nNeg)], A_pos[1:(nNeg-2)],   A_pos[nNeg], A_pos[-nNeg], 
		A_pos,    A_pos[2:nNeg], A_pos[1]),  c(nNeg, 4)),   1,
		function(x, Acut=A_cut, Mcut=M_cut) x[3]>Acut && x[4]<(x[3]+Mcut) && x[3]>(x[1]+Mcut) && x[3]>(x[2]+Mcut) )
		#function(x, Acut=A_cut, Mcut=M_cut) x[4]>Acut && x[4]<(x[3]+Mcut) && x[3]>(x[1]+Mcut) && x[3]>(x[2]+Mcut) )
	# use less memory but maybe a little slower
	#Tn_pos <- c(A_pos[c(nNeg-1, nNeg)], A_pos, A_pos[1])
	#Tn_pos <- sapply(seq(nNeg), function(i, x=Tn_pos, Acut=A_cut, Mcut=M_cut) if(x[i+3]>Acut && x[i+3]<(x[i+2]+Mcut) && x[i+2]>(x[i]+Mcut) && x[i+2]>(x[i+1]+Mcut)) TRUE else FALSE)
	idx <- which(Tn_pos)
	if (!is.null(p) && length(idx)>0) {
		p_pos <- p[idxNeg]
		p_pos <- c(p_pos[(nNeg-3):nNeg], p_pos)
		if (length(A_pos) == nNeg) A_pos <- c(A_pos[(nNeg-3):nNeg], A_pos)
		p_med[idxNeg[idx]] <- p_med[idxNeg[idx+1]] <- sapply(idx, function(i) { 
			#pos <- idxNeg[max(i-4, 1):i]
			#median(p[pos][which(A[pos]>A_cut)], na.rm=TRUE)
			median(p_pos[i:(i+4)][which(A[i:(i+4)]>A_cut)], na.rm=TRUE)
			} )
		}
	if (!is.null(M) && length(idx)>0) {
		M_pos <- M[idxNeg]
		M_pos <- c(M_pos[(nNeg-3):nNeg], M_pos)
		if (length(A_pos) == nNeg) A_pos <- c(A_pos[(nNeg-3):nNeg], A_pos)
		M_med[idxNeg[idx]] <- M_med[idxNeg[idx+1]] <- sapply(idx, function(i) { 
			#pos <- idxNeg[max(i-4, 1):i]
			#median(M[pos][which(A[pos]>A_cut)], na.rm=TRUE)
			median(M_pos[i:(i+4)][which(A[i:(i+4)]>A_cut)], na.rm=TRUE)
			} )
		}
	Tn_token[idxNeg[idx+1]] <- as.integer(-1) #-0.5
	#Tn_token[idxNeg[idx+3]] <- as.integer(-1) #-0.5
	Tn_token[idxNeg[idx]] <- as.integer(-2) #-1
	#Tn_token[idxNeg[idx+2]] <- as.integer(-2) #-1
	if (is.null(M) && is.null(p)) Tn_token else list(Tn_token=Tn_token, M_median=M_med, p_median=p_med)
	}

getGeneIdx_4_Steffen_only <- function(GeneInSect, getName=FALSE) { 
	# split combined names (nm + nm), and get all unique names started with PSLT, STM, or STMsR
	# skip other names like blank "", "IR nm - nm"
	#gns <- unique(GeneInSect)
	# probes in in single gene, only those defined by Steffen will a valid name
	#nm1 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*$)', gns, perl=TRUE, value=TRUE) # or accept any string which doesn't contain '+'
	idx1 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*$)', GeneInSect, perl=TRUE) # or accept any string which doesn't contain '+'
	nm1 <- GeneInSect[idx1]
	#nm2 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*\\+\\s*(PSLT|STMsR|STM)\\d+\\s*$)', gns, perl=TRUE, value=TRUE) # probes in overlapping genes
	idx2 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*\\+\\s*(PSLT|STMsR|STM)\\d+\\s*$)', GeneInSect, perl=TRUE) # probes in overlapping genes
	nm2 <- GeneInSect[idx2]
	nm3 <- unlist(strsplit(nm2, '\\s*+\\s*'))
	#RealGenes <- sort(unique(c(nm1, nm2)))
	# "split" is same to tapply(a, b, function(x) x)
	GeneIdx <- split(c(idx1, rep(idx2, each=2)), c(nm1, nm3)) # a list with geneNo as names and a vectors of idx as value
	if (getName) return(list(GeneIdx=GeneIdx, name_single=nm1, name_overlap=nm2))
	return(GeneIdx)
	}

getGeneIdx <- function(GeneInSect, getName=FALSE) { 
	# split combined names (nm + nm), and get all unique names started with PSLT, STM, or STMsR
	# skip other names like blank "", "IR nm - nm"
	#gns <- unique(GeneInSect)
	# probes in in single gene, only those defined by Steffen will a valid name
	#nm1 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*$)', gns, perl=TRUE, value=TRUE) # or accept any string which doesn't contain '+'
	#idx1 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*$)', GeneInSect, perl=TRUE) # or accept any string which doesn't contain '+'
	#nm1 <- GeneInSect[idx1]
	#nm2 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*\\+\\s*(PSLT|STMsR|STM)\\d+\\s*$)', gns, perl=TRUE, value=TRUE) # probes in overlapping genes
	idx2 <- grep('(^\\s*(PSLT|STMsR|STM)\\d+\\s*\\+\\s*(PSLT|STMsR|STM)\\d+\\s*$)', GeneInSect, perl=TRUE) # probes in overlapping genes
	nm2 <- GeneInSect[idx2]
	nm3 <- unlist(strsplit(nm2, '\\s*\\+\\s*'))
	idx1 <- if(length(idx2)>0) seq(GeneInSect)[-idx2] else seq(GeneInSect)# anything except those in nm2 will be a valid name
	nm1 <- GeneInSect[idx1]
	#RealGenes <- sort(unique(c(nm1, nm2)))
	# "split" is same to tapply(a, b, function(x) x)
	GeneIdx <- split(c(idx1, rep(idx2, each=2)), c(nm1, nm3)) # a list with geneNo as names and a vectors of idx as value
	if (getName) return(list(GeneIdx=GeneIdx, name_single=nm1, name_overlap=nm2))
	return(GeneIdx)
	}

countTns <- function(Tn_token, GeneM, DTPB, MetaM, MetaP, M, A, idxPosi, idxNeg, SigP, fn_tn, tn_threshold_A, p_median=NULL, M_median=NULL, idx_signal=NULL, GeneM_all=GeneM, DTPB_all=DTPB, MetaM_all=MetaM, MetaP_all=MetaP) {
	# save tn token
	n <- length(A)
	A_cut <- quantile(A, tn_threshold_A)[[1]] #quantile(A, 2/3)[[1]]  #8.178628
	idx <- which(!is.na(Tn_token))
	# -A3 : -2, -A4 : -1, A1 : 1, A2 : 2, after plus 3, -A3 : 1, -A4 : 2, A1 : 4, A2 : 5
	#Tn_token_str <- c('-A3', '-A4', NA, '+A1', '+A2')[Tn_token+3]
	#Tn_token_str <- c('"-A3"', '"-A4"', NA, '"+A1"', '"+A2"')[Tn_token+3]
	Tn_token_str <- Tn_token/2 
	n_idx <- length(idx)
	if (n_idx == 0) return(FALSE)
	Tnidx <- Tn_token[idx]
	Tnidx_str <- Tn_token_str[idx]
	gn <- GeneM[, 'gene_symbol']
	gnidx <- gn[idx]
	Midx <- M[idx]
	p_medix <- p_median[idx]
	M_medix <- M_median[idx]
	#g_start <- tapply(GeneM[, 'probe_start'], min)
	#g_end <- tapply(GeneM[, 'probe_end'], max)
	getTnNum_simple <- function(itmp) {  # treat XXXX+YYYY as a unique gene
		if (length(itmp)>0) {
			gnum <- tapply(gnidx[itmp], gnidx[itmp], length)
			tns <- as.vector(gnum[match(gnidx, names(gnum))])
			tns[which(is.na(tns))] <- 0
			}
		else tns <- rep(0, times=n_idx)
		tns
		}
	getTnNum <- function(itmp) { # consider XXXX+YYYY as two genes
		if (length(itmp) == 0) return(rep(0, times=n_idx))
		GnidxSect <- gnidx[itmp]
		RealGnidx <- getGeneIdx(GnidxSect, getName=TRUE)
		nm_s <- RealGnidx$name_single
		nm_ol <-RealGnidx$name_overlap
		if (length(RealGnidx$GeneIdx) == 0) return(rep(0, times=n_idx))
		gnum <- sapply(RealGnidx$GeneIdx, length)
		tns <- as.vector(gnum[match(gnidx, names(gnum))])
		if (length(nm_ol)>0) {
			#nms_ol <- matrix(unlist(strsplit(nm_ol, '\\s*\\+\\s*')), nrow=2)
			#gnum_ol <- gnum[match(nms_ol[1,], names(gnum))] + gnum[match(nms_ol[2,], names(gnum))]
			#tns[match(nm_ol, gnidx)] <- gnum_ol
			gnum_ol <- table(nm_ol)
			tns[match(names(gnum_ol), gnidx)] <- gnum_ol
			}
		tns[which(is.na(tns))] <- 0
		tns
		}
	getSeqNum <- function(itmp) {
		if (length(itmp) == 0) return(rep(0, times=n))
		GnSect <- gn[itmp]
		RealGn <- getGeneIdx(GnSect, getName=TRUE)
		nm_s <- RealGn$name_single
		nm_ol <-RealGn$name_overlap
		if (length(RealGn$GeneIdx) == 0) return(rep(0, times=n))
		gnum <- sapply(RealGn$GeneIdx, length)
		seqs <- as.vector(gnum[match(gn, names(gnum))])
		if (length(nm_ol)>0) {
			gnum_ol <- table(nm_ol)
			seqs[match(names(gnum_ol), gn)] <- gnum_ol
			}
		seqs[which(is.na(seqs))] <- 0
		seqs
		}
	ipos <- Tnidx == as.integer(2)
	ineg <- Tnidx == as.integer(-2)
	tn_pos <- getTnNum(which(ipos))
	tn_neg <- getTnNum(which(ineg)) #< -0.59999))
	#MetaMidx <- SubM(MetaM, idx) #if (length(idx)>1) cbind(MetaM[idx,]) else rbind(MetaM[idx,])
	#colnames(MetaMidx) <- colnames(MetaM)
	if (is.null(M)) {
		tmpM <- cbind(Transposon=Tnidx_str, Tn_pos=tn_pos, Tn_neg=tn_neg, Tn_both=tn_pos+tn_neg, p=MetaP[idx], A=A[idx], SubM(MetaM, idx), if (is.null(DTPB)) GeneM[idx,] else DTPB[idx,])
		}
	else {
		if (is.null(MetaP)) tn_pos_p_up <-  tn_pos_p_down <- tn_neg_p_up <- tn_neg_p_down <- NULL
		else {
			isp <- MetaP[idx] <= SigP
			ipu <- Midx > 0 & isp
			ipd <- Midx < 0 & isp
			tn_pos_p_up <- getTnNum(which(ipos & ipu))
			tn_pos_p_down <- getTnNum(which(ipos & ipd))
			tn_neg_p_up <- getTnNum(which(ineg & ipu))
			tn_neg_p_down <- getTnNum(which(ineg & ipd))
			pmed <- MetaP[idx] <= p_medix
			pmu <- Midx > 0 & pmed
			pmd <- Midx < 0 & pmed
			tn_pos_p_median_up <- getTnNum(which(ipos & pmu))
			tn_pos_p_median_down <- getTnNum(which(ipos & pmd))
			tn_neg_p_median_up <- getTnNum(which(ineg & pmu))
			tn_neg_p_median_down <- getTnNum(which(ineg & pmd))
			tn_both_p_median_up_vs_down <- (tn_pos_p_median_up + tn_neg_p_median_up) - (tn_pos_p_median_down + tn_neg_p_median_down)
			}
		#isu <- Midx >= 1
		#isd <- Midx <= -1
		#imu <- Midx < 1 & Midx >= log2(1.5) #0.5
		#imd <- Midx > -1 & Midx <= -log2(1.5) #0.5
		imu <- Midx >= log2(1.5)
		imd <- Midx <= -log2(1.5)
		#tn_pos_sig_up <- getTnNum(which(ipos & isu))
		#tn_pos_sig_down <- getTnNum(which(ipos & isd))
		tn_pos_med_up <- getTnNum(which(ipos & imu)) 
		tn_pos_med_down <- getTnNum(which(ipos & imd))
		#tn_neg_sig_up <- getTnNum(which(ineg & isu))
		#tn_neg_sig_down <- getTnNum(which(ineg & isd))
		tn_neg_med_up <- getTnNum(which(ineg & imu))
		tn_neg_med_down <- getTnNum(which(ineg & imd))
		mup <- Midx > 0 & Midx >= M_medix
		mdn <- Midx < 0 & Midx <= M_medix
		tn_pos_median_up <- getTnNum(which(ipos & mup))
		tn_pos_median_down <- getTnNum(which(ipos & mdn))
		tn_neg_median_up <- getTnNum(which(ineg & mup))
		tn_neg_median_down <- getTnNum(which(ineg & mdn))
		tn_both_M_median_up_vs_down <- (tn_pos_median_up + tn_neg_median_up) - (tn_pos_median_down + tn_neg_median_down)

		icut <- A >= A_cut
		i15u <- M >= log2(1.5)
		i15d <- M <= -log2(1.5)
		ipos <- ineg <- rep(FALSE, times=n)
		ipos[idxPosi] <- TRUE
		ineg[idxNeg] <- TRUE
		iposcut <- ipos & icut
		inegcut <- ineg & icut
		seq_pos <- getSeqNum(which(ipos))
		seq_pos_Acut <- getSeqNum(which(iposcut))
		seq_pos_Acut_1.5_up <- getSeqNum(which(iposcut & i15u))
		seq_pos_Acut_1.5_down <- getSeqNum(which(iposcut & i15d))
		seq_neg <- getSeqNum(which(ineg))
		seq_neg_Acut <- getSeqNum(which(inegcut))
		seq_neg_Acut_1.5_up <- getSeqNum(which(inegcut & i15u))
		seq_neg_Acut_1.5_down <- getSeqNum(which(inegcut & i15d))
		

		if (is.null(MetaP)) 
			tmpM <- cbind(Transposon=Tnidx_str, Tn_pos=tn_pos, Tn_neg=tn_neg, Tn_both=tn_pos+tn_neg, Tn_pos_up_M_median=tn_pos_median_up, Tn_pos_down_M_median=tn_pos_median_down, Tn_pos_up_1.5fold=tn_pos_med_up, Tn_pos_down_1.5fold=tn_pos_med_down, Tn_neg_up_M_median=tn_neg_median_up, Tn_neg_down_M_median=tn_neg_median_down, Tn_neg_up_1.5fold=tn_neg_med_up, Tn_neg_down_1.5fold=tn_neg_med_down, 
				Tn_both_M_median_up_vs_down=tn_both_M_median_up_vs_down, Tn_both_median_up_vs_down=tn_both_M_median_up_vs_down,
				Seq_pos=seq_pos[idx], Seq_pos_Acut=seq_pos_Acut[idx], Seq_pos_Acut_1.5fold_up=seq_pos_Acut_1.5_up[idx], Seq_pos_Acut_1.5fold_down=seq_pos_Acut_1.5_down[idx], Seq_neg=seq_neg[idx], Seq_neg_Acut=seq_neg_Acut[idx], Seq_neg_Acut_1.5fold_up=seq_neg_Acut_1.5_up[idx], Seq_neg_Acut_1.5fold_down=seq_neg_Acut_1.5_down[idx], 
				M=Midx, A=A[idx], SubM(MetaM, idx), if (is.null(DTPB)) GeneM[idx,] else DTPB[idx,]
				)
		else {
			tmpM <- cbind(Transposon=Tnidx_str, Tn_pos=tn_pos, Tn_neg=tn_neg, Tn_both=tn_pos+tn_neg, Tn_pos_up_p=tn_pos_p_up, Tn_pos_down_p=tn_pos_p_down, Tn_pos_up_p_median=tn_pos_p_median_up, Tn_pos_down_p_median=tn_pos_p_median_down, Tn_neg_up_p=tn_neg_p_up, Tn_neg_down_p=tn_neg_p_down, Tn_neg_up_p_median=tn_neg_p_median_up, Tn_neg_down_p_median=tn_neg_p_median_down, Tn_pos_up_M_median=tn_pos_median_up, Tn_pos_down_M_median=tn_pos_median_down, Tn_pos_up_1.5fold=tn_pos_med_up, Tn_pos_down_1.5fold=tn_pos_med_down, Tn_neg_up_M_median=tn_neg_median_up, Tn_neg_down_M_median=tn_neg_median_down, Tn_neg_up_1.5fold=tn_neg_med_up, Tn_neg_down_1.5fold=tn_neg_med_down, 
				Tn_both_p_median_up_vs_down=tn_both_p_median_up_vs_down, Tn_both_M_median_up_vs_down=tn_both_M_median_up_vs_down, Tn_both_median_up_vs_down=tn_both_p_median_up_vs_down + tn_both_M_median_up_vs_down,
				Seq_pos=seq_pos[idx], Seq_pos_Acut=seq_pos_Acut[idx], Seq_pos_Acut_1.5fold_up=seq_pos_Acut_1.5_up[idx], Seq_pos_Acut_1.5fold_down=seq_pos_Acut_1.5_down[idx], Seq_neg=seq_neg[idx], Seq_neg_Acut=seq_neg_Acut[idx], Seq_neg_Acut_1.5fold_up=seq_neg_Acut_1.5_up[idx], Seq_neg_Acut_1.5fold_down=seq_neg_Acut_1.5_down[idx], 
				p=MetaP[idx], M=Midx, A=A[idx], SubM(MetaM, idx), if (is.null(DTPB)) GeneM[idx,] else DTPB[idx,]
				)
			pnms <- c('Tn_pos_up_p', 'Tn_pos_down_p','Tn_neg_up_p', 'Tn_neg_down_p')
			colnames(tmpM)[match(pnms, colnames(tmpM))] <- paste(pnms, SigP, sep='_') 
			}
		}
	cnms <- colnames(tmpM)
	gcol <- setdiff(cnms, c('p', 'M', 'A', colnames(MetaM)))
	try(write.table(tmpM, file=fn_tn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))

	# write a version by gene_symbol
	fnln <- nchar(fn_tn)
	fn <- paste(substr(fn_tn, 1, fnln-4), '_by_gene', substr(fn_tn, fnln-3, fnln), sep='')
	unignidx <- unique(gnidx)
	idx1 <- match(unignidx, gnidx)
	#try(write.table(tmpM[idx1, gcol], file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
	# add more columns 
	addCols <- function(tmpM) {
		if (!('Seq_pos' %in% colnames(tmpM))) return(tmpM)
		iGM <- match(colnames(if (is.null(DTPB)) GeneM else DTPB)[1], gcol)
		gcol <- c(gcol[1:(iGM-1)], c('total_oligos', 'oligos_above_A', 'proportion_of_oligos_above_A', 'proportion_above_A_that_change', 'conclusion_of_change', 'probability_moderated'), gcol[iGM:length(gcol)])
		#tmpM <- tmpM[idx1, ]
		ton <- tmpM[, 'Seq_pos'] + tmpM[, 'Seq_neg']
		oba <- tmpM[, 'Seq_pos_Acut'] + tmpM[, 'Seq_neg_Acut']
		poba <- oba / ton
		nu <- tmpM[, 'Seq_pos_Acut_1.5fold_up'] + tmpM[, 'Seq_neg_Acut_1.5fold_up']
		nd <- tmpM[, 'Seq_pos_Acut_1.5fold_down'] + tmpM[, 'Seq_neg_Acut_1.5fold_down']
		pac <- (nu - nd) / oba
		pbinom <- dbinom(nu+2, nu+nd+4, 0.5)
		colud <- tmpM[, 'Tn_both_median_up_vs_down']
		rpu <- (colud > 1) & (colud / tmpM[, 'Tn_both'] > 0.2)
		rpd <- (colud < -1) & (colud / tmpM[, 'Tn_both'] < -0.2)
		tmov_pos <- colud > 0
		tmov_zero <- colud == 0
		tmov_neg <- colud < 0
		pt2 <- 0.2 * 0.5 / tn_threshold_A  # <- 0.2
		pt3 <- 0.3 * 0.5 / tn_threshold_A  # <- 0.3
		conclusion <- rep('Unchanged', nrow(tmpM))
		conclusion[which(rpu)] <- 'Unchanged (possibly up)'
		conclusion[which(rpd)] <- 'Unchanged (possibly down)'
		conclusion[which(pac >= pt3 & tmov_pos)] <- 'Up'
		conclusion[which(pac >= pt3 & tmov_zero)] <- 'Up not supported by Tn direction'
		conclusion[which(pac >= pt3 & tmov_neg)] <- 'Up contradicted by Tn direction'
		conclusion[which(pac <= -pt3 & tmov_neg)] <- 'Down'
		conclusion[which(pac <= -pt3 & tmov_zero)] <- 'Down not supported by Tn direction'
		conclusion[which(pac <= -pt3 & tmov_pos)] <- 'Down contradicted by Tn direction'
		conclusion[which(pac < pt3 & pac >= pt2 & tmov_pos)] <- 'Intermediate up'
		conclusion[which(pac < pt3 & pac >= pt2 & !tmov_pos)] <- 'Intermediate up not supported by Tn direction'
		conclusion[which(pac > -pt3 & pac <= -pt2 & tmov_neg)] <- 'Intermediate down'
		conclusion[which(pac > -pt3 & pac <= -pt2 & !tmov_neg)] <- 'Intermediate down not supported by Tn direction'
		conclusion[which(poba < pt2)] <- 'Transposons rare'
		conclusion[which(poba < pt2 & rpu)] <- 'Transposons rare (possibly up)'
		conclusion[which(poba < pt2 & rpd)] <- 'Transposons rare (possibly down)'
		conclusion[which(poba < pt2 & pac >= pt3 & tmov_pos)] <- 'Transposons rare (up)'
		conclusion[which(poba < pt2 & pac <= -pt3 & tmov_neg)] <- 'Transposons rare (down)'
		conclusion[which(poba < pt2 & pac < pt3 & pac >= pt2 & tmov_pos)] <- 'Transposons rare (intermediate up)'
		conclusion[which(poba < pt2 & pac > -pt3 & pac <= -pt2 & tmov_neg)] <- 'Transposons rare (intermediate down)'
		conclusion[which(tmpM[, 'Tn_both'] == 0)] <- 'No transposon'
		conclusion[which(ton < 10)] <- 'Not enough data'
		conclusion[which(ton < 10 & rpu)] <- 'Not enough data (possibly up)'
		conclusion[which(ton < 10 & rpd)] <- 'Not enough data (possibly down)'
		conclusion[which(ton < 10 & pac >= pt3 & tmov_pos)] <- 'Not enough data (up)'
		conclusion[which(ton < 10 & pac <= -pt3 & tmov_neg)] <- 'Not enough data (down)'
		conclusion[which(ton < 10 & pac < pt3 & pac >= pt2 & tmov_pos)] <- 'Not enough data (intermediate up)'
		conclusion[which(ton < 10 & pac > -pt3 & pac <= -pt2 & tmov_neg)] <- 'Not enough data (intermediate down)'
		tmpM <- cbind(tmpM, 'total_oligos'=ton, 'oligos_above_A'=oba, 'proportion_of_oligos_above_A'=poba, 'proportion_above_A_that_change'=pac, 'conclusion_of_change'=conclusion, 'probability_moderated'=pbinom)
		tmpM <- tmpM[, gcol]
		}
	#tmpM <- addCols(tmpM)

	try(write.table(addCols(tmpM[idx1,]), file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))

	# write a version with significant p value
	if (!is.null(MetaP)) {
		idx2 <- which(tmpM[,'p']<=SigP)
		if (length(idx2)>0) {
			#tmpM <- tmpM[idx, ]
			fn <- paste(substr(fn_tn, 1, fnln-4), '_p_', SigP, substr(fn_tn, fnln-3, fnln), sep='')
			try(write.table(tmpM[idx2, ], file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
			}
		}
	#rm(list=c('tmpM', 'Tnidx', 'gnidx', 'tn_pos', 'tn_neg', 'idx', 'Midx', 'ipos', 'ineg', 'isu', 'isd', 'imu', 'imd', 'tn_pos_sig_up', 'tn_pos_sig_down', 'tn_pos_med_up', 'tn_pos_med_down', 'tn_neg_med_up', 'tn_neg_med_down', 'tn_neg_sig_up', 'tn_neg_sig_down'))
	#if (!is.null(fn_log)) cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'saved transposon information\n', sep='\t'), filename=fn_log)

	# write a version with all probes
	#gns <- GeneM[, 'gene_symbol']
	gns <- GeneM_all[, 'gene_symbol']
	#idx_val <- match(gns, tmpM$gene_symbol) 
	idx_val <- match(gns, GeneM[idx, 'gene_symbol']) # use GeneM since "gene_symbol" may not be found in tmpM if DTPB is used.
	idx_loc <- which(!is.na(idx_val))
	idx_val <- idx_val[idx_loc]
	fn <- paste(substr(fn_tn, 1, fnln-4), '_all_probes', substr(fn_tn, fnln-3, fnln), sep='')
	#tmpM <- NULL
	#gc()
	#n <- length(Tn_token)
	n <- length(gns)
	#V <- function(v, v0=0) {tm <- rep(v0, n); tm[idx] <- v; tm}
	V <- function(v, v0=0) {tm <- rep(v0, n); tm[idx_loc] <- v[idx_val]; tm}
	W <- function(v, v0=NA) {if (is.null(idx_signal)) return(v); tm <- rep(v0, n); tm[idx_signal$idx] <- v; tm} # add filtered weak probes
	if (is.null(M)) 
		tmpM <- cbind(Transposon=W(Tn_token/2), Tn_pos=V(tn_pos), Tn_neg=V(tn_neg), Tn_both=V(tn_pos+tn_neg), 
			p=MetaP_all, A=W(A), MetaM_all, if (is.null(DTPB_all)) GeneM_all else DTPB_all)
	else {
		if (is.null(MetaP))
			tmpM <- cbind(Transposon=W(Tn_token_str), Tn_pos=V(tn_pos), Tn_neg=V(tn_neg), Tn_both=V(tn_pos+tn_neg), Tn_pos_up_M_median=V(tn_pos_median_up), Tn_pos_down_M_median=V(tn_pos_median_down), Tn_pos_up_1.5fold=V(tn_pos_med_up), Tn_pos_down_1.5fold=V(tn_pos_med_down), Tn_neg_up_M_median=V(tn_neg_median_up), Tn_neg_down_M_median=V(tn_neg_median_down), Tn_neg_up_1.5fold=V(tn_neg_med_up), Tn_neg_down_1.5fold=V(tn_neg_med_down), 
				#Tn_both_M_median_up_vs_down=V(tn_both_M_median_up_vs_down), Tn_both_median_up_vs_down=Tn_both_M_median_up_vs_down, #V(tn_both_M_median_up_vs_down),
				Tn_both_M_median_up_vs_down=V(tn_both_M_median_up_vs_down), Tn_both_median_up_vs_down=V(tn_both_M_median_up_vs_down),
				Seq_pos=W(seq_pos), Seq_pos_Acut=W(seq_pos_Acut), Seq_pos_Acut_1.5fold_up=W(seq_pos_Acut_1.5_up), Seq_pos_Acut_1.5fold_down=W(seq_pos_Acut_1.5_down), Seq_neg=W(seq_neg), Seq_neg_Acut=W(seq_neg_Acut), Seq_neg_Acut_1.5fold_up=W(seq_neg_Acut_1.5_up), Seq_neg_Acut_1.5fold_down=W(seq_neg_Acut_1.5_down), 
				M=W(M), A=W(A), MetaM_all, if (is.null(DTPB_all)) GeneM_all else DTPB_all
				)
		else
			tmpM <- cbind(Transposon=W(Tn_token_str), Tn_pos=V(tn_pos), Tn_neg=V(tn_neg), Tn_both=V(tn_pos+tn_neg), Tn_pos_up_p=V(tn_pos_p_up), Tn_pos_down_p=V(tn_pos_p_down), Tn_pos_up_p_median=V(tn_pos_p_median_up), Tn_pos_down_p_median=V(tn_pos_p_median_down), Tn_neg_up_p=V(tn_neg_p_up), Tn_neg_down_p=V(tn_neg_p_down), Tn_neg_up_p_median=V(tn_neg_p_median_up), Tn_neg_down_p_median=V(tn_neg_p_median_down), Tn_pos_up_M_median=V(tn_pos_median_up), Tn_pos_down_M_median=V(tn_pos_median_down), Tn_pos_up_1.5fold=V(tn_pos_med_up), Tn_pos_down_1.5fold=V(tn_pos_med_down), Tn_neg_up_M_median=V(tn_neg_median_up), Tn_neg_down_M_median=V(tn_neg_median_down), Tn_neg_up_1.5fold=V(tn_neg_med_up), Tn_neg_down_1.5fold=V(tn_neg_med_down), 
				Tn_both_p_median_up_vs_down=V(tn_both_p_median_up_vs_down), Tn_both_M_median_up_vs_down=V(tn_both_M_median_up_vs_down), Tn_both_median_up_vs_down=V(tn_both_p_median_up_vs_down + tn_both_M_median_up_vs_down),
				Seq_pos=W(seq_pos), Seq_pos_Acut=W(seq_pos_Acut), Seq_pos_Acut_1.5fold_up=W(seq_pos_Acut_1.5_up), Seq_pos_Acut_1.5fold_down=W(seq_pos_Acut_1.5_down), Seq_neg=W(seq_neg), Seq_neg_Acut=W(seq_neg_Acut), Seq_neg_Acut_1.5fold_up=W(seq_neg_Acut_1.5_up), Seq_neg_Acut_1.5fold_down=W(seq_neg_Acut_1.5_down), 
				p=MetaP_all, M=W(M), A=W(A), MetaM_all, if (is.null(DTPB_all)) GeneM_all else DTPB_all
				)
		}
	colnames(tmpM) <- cnms
	gcol <- setdiff(cnms, c('p', 'M', 'A', colnames(MetaM)))
	try(write.table(tmpM, file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))

	# write a version with all genes
	fn <- paste(substr(fn_tn, 1, fnln-4), '_all_genes', substr(fn_tn, fnln-3, fnln), sep='')
	#write.table(tmpM[match(unique(gns), gns),], file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t')
	# to make the "_all_genes" to be a superset of "_by_gene"
	othergns <- setdiff(unique(gns), unignidx)
	#try(write.table(tmpM[sort(c(match(othergns, gns), idx[idx1])), gcol], file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
	if (is.null(idx_signal)) 
		try(write.table(addCols(tmpM[sort(c(match(othergns, gns), idx[idx1])), gcol]), file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
	else
		try(write.table(addCols(tmpM[sort(c(match(othergns, gns), idx_signal$idx[idx[idx1]])), gcol]), file=fn, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
	tmpM <- NULL
	gc()
	return(TRUE)
	}

doBacCGH <- function(GeneM, R, G, M, A, fn_bacgh) {
	if (nrow(GeneM) < 3) return
	gn <- GeneM[, 'gene_symbol']
	idx <- tapply(seq(gn), gn, function(x) x)
	rlt <- sapply(idx, function(x) {
		gtmp <- rbind(GeneM[x, ]); 
		#c(min(gtmp['probe_start']), max(gtmp['probe_end']), paste(unique(unlist(gtmp['probe_strand'])), collapse='/'), length(x), apply(if(ncol(A)>1) rbind(A[x,]) else cbind(A[x,]), 2, median), apply(if(ncol(M)>1) rbind(M[x,]) else cbind(M[x,]), 2, median))
		c(min(gtmp['probe_start']), max(gtmp['probe_end']), length(x), apply(if(ncol(A)>1) rbind(A[x,]) else cbind(A[x,]), 2, median), apply(if(ncol(M)>1) rbind(M[x,]) else cbind(M[x,]), 2, median))
		})
	rlt <- cbind(names(idx), t(rlt))
	#colnames(rlt) <- c('gene_symbol', 'probe_start', 'probe_end', 'probe_strand', 'number of probes', paste('median A of array', seq(ncol(M))), paste('median M of array', seq(ncol(M))))
	colnames(rlt) <- c('gene_symbol', 'probe_start', 'probe_end', 'number of probes', paste('median A of array', seq(ncol(M))), paste('median M of array', seq(ncol(M))))
	try(write.table(rlt, file=fn_bacgh, col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'))
	rm(rlt)
	gc()
	}

insertIntoStr <- function(S, s, loc) { # insert s into S at loc
	paste(substr(S, 1, loc-1), s, substr(S, loc, nchar(S)), sep='')
	}

SubM <- function(M, idx) {
	if (is.null(dim(M))) return(M[idx])
	if (ncol(M) > 1 && length(idx) > 1) return(M[idx,])
	rnm <- rownames(M)[idx]
	cnm <- colnames(M)
	M <- if (length(idx)<2) rbind(M[idx,]) else cbind(M[idx,])
	dimnames(M) <- list(rnm, cnm)
	invisible(M)
	}

plotCGH <- function(MetaM, GeneM, DTPB, MetaP, grps, file_prefix, work_dir=NULL, plot_by=c('nucleotide','chromosome', 'probe', 'total')[1], nucleotide_num=10000, probe_num=1000, max_section=100, plot_pdf=FALSE, weak_perc=NULL, tn_analysis=NULL, p_label=TRUE, SigP=0.001, n_smooth=3, fun_smooth=median, fn_tn=NULL, fn_log=NULL, time_last=NULL, max_chart=NULL, debug_mode=FALSE, tn_threshold_M=NULL, tn_threshold_A=NULL, bac_cgh=NULL, fn_bacgh=NULL, other_params=NULL) {
	#source('/home/xxia/public_html/cgi-bin/webarray/plotCGH.R')
	if (is.null(time_last)) time_last <- Sys.time()
	#if (TRUE || is.null(debug_mode) || !debug_mode) {
	if (is.null(debug_mode) || !debug_mode) {
		if (is.null(work_dir)) source('plotCGH.R')
		else source(file.path(work_dir, 'plotCGH.R'))}
	else {
		if (is.null(work_dir)) { if (file.exists('plotCGH_new.R')) source('plotCGH_new.R') else source('plotCGH.R') }
		else if (file.exists(file.path(work_dir, 'plotCGH_new.R'))) source(file.path(work_dir, 'plotCGH_new.R'))
		else source(file.path(work_dir, 'plotCGH.R'))
		}
	# correct parameter values
	if (is.null(bac_cgh)) bac_cgh <- FALSE
	if (is.null(tn_analysis) || bac_cgh) tn_analysis <- FALSE
	n_smooth <- as.integer(n_smooth)
	if (length(n_smooth) < 1) n_smooth <- 1
	else n_smooth <- n_smooth[1]

	if (is.null(tn_threshold_A) || tn_threshold_A>=100 || tn_threshold_A<0) tn_threshold_A <- 0.5
	else if (tn_threshold_A >= 1 && tn_threshold_A<100) tn_threshold_A <- tn_threshold_A * 0.01
	#tn_threshold_A <- 0.2 * 0.5 / tn_threshold_A

	uni_grps <- unique(grps)
	n_grp <- length(uni_grps)
	if (n_grp < 2 && bac_cgh) return
	#MetaM <- normalizeQuantiles(MetaM) # normalization is not needed any more since M is not raw data.
	if (is.null(dim(MetaM))) MetaM <- cbind(MetaM)
	RawA <- rowMeans(MetaM, na.rm=TRUE) #apply(M, 1, mean, na.rm=TRUE)

	chr <- GeneM[, 'chromosome']
	probe_pos <- rowMeans(rbind(GeneM[, c('probe_start', 'probe_end')]), na.rm=TRUE) #apply(cbind(GeneM[, c('probe_start', 'probe_end')]), 1, mean, na.rm=TRUE)
	#ord <- if (plot_by == 'nucleotide') order(probe_pos) else order(chr, probe_pos) # by chromosome
	ord <- if (plot_by == 'chromsome') order(chr, probe_pos) else order(probe_pos)
	chr <- chr[ord]
	probe_pos <- probe_pos[ord]
	MetaM_all <- MetaM <- SubM(MetaM, ord) #if (length(ord)>1) cbind(MetaM[ord,]) else rbind(MetaM[ord,])
	GeneM_all <- GeneM <- GeneM[ord,]
	DTPB_all <- DTPB <- DTPB[ord,]
	MetaP_all <- MetaP <- MetaP[ord]
	RawA <- RawA[ord] # calculate it from R and G later

	sepWeak <- function(A) {
		if (!is.null(weak_perc) && weak_perc > 0 && weak_perc < 100) {
			if (weak_perc >= 1) weak_perc <- weak_perc/100
			idx <- A > quantile(A, weak_perc)[[1]]
			return(list(idx=which(idx), iweak=which(!idx)))
			}
		return(NULL)
		#return(list(idx=TRUE, iweak=FALSE))
		}
	# remove 2.5% (0.025) weakest spots 
	isep <- sepWeak(RawA)
	if (!is.null(isep)) {
		idx <- isep$idx
		MetaM <- SubM(MetaM, idx)
		GeneM <- GeneM[idx,]
		DTPB <- DTPB[idx,]
		MetaP <- MetaP[idx]
		chr <- chr[idx]
		probe_pos <- probe_pos[idx]
		}

	probe_strand <- GeneM[, 'probe_strand']
	gene_name <- GeneM[, 'gene_symbol']
	gene_strand <- GeneM[, 'gene_strand']
	Tn_token <- NULL

	if (bac_cgh) {
		G <- cbind(MetaM[, grps==1])
		R <- cbind(MetaM[, grps==2])
		nmM <- colnames(MetaM)
		nmM <- substr(nmM, 1, nchar(nmM)-2) # remove channel No.: '.1' and '.2'
		colnames(G) <- nmG <- nmM[grps==1]
		colnames(R) <- nmR <- nmM[grps==2]
		nmM <- nmR
		nmDif <- which(nmG != nmR)
		if (length(nmDif)>0) nmM[nmDif] <- paste(nmR[nmDif], nmG[nmDif], sep=' vs ')
		if (n_smooth > 1) 
			for (i in seq(ncol(R))) {
				R[,i] <- aveVec(R[,i], n=n_smooth, fun=fun_smooth)
				G[,i] <- aveVec(G[,i], n=n_smooth, fun=fun_smooth)
				}
		M <- R - G
		A <- (R+G)/2
		colnames(M) <- colnames(A) <- nmM
		doBacCGH(GeneM, R, G, M, A, fn_bacgh)
		#return()
		}
	else {
		idxPosi <- which(probe_strand == "+")
		idxNeg  <- which(probe_strand == "-")
		nPosi <- length(idxPosi)
		nNeg  <- length(idxNeg)
		if (nPosi<3 || nNeg<3) return()
		if (n_grp > 1) {
			# only plot with the first two groups
			G <- rowMeans(cbind(MetaM[, grps==1]), na.rm=TRUE) # the first group is used as the first channel (green)
			R <- rowMeans(cbind(MetaM[, grps==2]), na.rm=TRUE)
			if (n_smooth > 1) {
				### median of every three spots ### calculated for + & - seperately
				#dtmp <- R[idxPosi]
				#R.med[idxPosi] <- apply(cbind(c(dtmp[2:nPosi], dtmp[1]), dtmp, c(dtmp[nPosi], dtmp[1:(nPosi-1)])), 1, median)
				#R.med[idxPosi] <- apply(cbind(c(dtmp[-1], dtmp[1]), dtmp, c(dtmp[nPosi], dtmp[-nPosi])), 1, median)
				#R[idxPosi] <- apply(cbind(c(dtmp[-1], dtmp[1]), dtmp, c(dtmp[nPosi], dtmp[-nPosi])), 1, median)
				#dtmp  <- R[idxNeg]
				#R[idxNeg]  <- c(median(c(dtmp[1:2], dtmp[nNeg])), sapply(2:(nNeg-1), function(i) median(dtmp[(i-1):(i+1)])), median(c(dtmp[(nNeg-1):nNeg], dtmp[1])))
				R[idxPosi] <- aveVec(R[idxPosi], n=n_smooth, fun=fun_smooth)
				R[idxNeg] <- aveVec(R[idxNeg], n=n_smooth, fun=fun_smooth)
				
				#G.med <- G
				#dtmp <- G[idxPosi]
				#G[idxPosi] <- apply(array(c(dtmp[2:nPosi],dtmp[1],dtmp,dtmp[nPosi],dtmp[1:(nPosi-1)]), c(length(idxPosi),3)), 1, median)
				#dtmp  <- G[idxNeg]
				#G[idxNeg]  <- apply(array(c(dtmp[2:nNeg], dtmp[1], dtmp, dtmp[nNeg], dtmp[1:(nNeg-1)]),  c(length(idxNeg),3)), 1, median)
				G[idxPosi] <- aveVec(G[idxPosi], n=n_smooth, fun=fun_smooth)
				G[idxNeg] <- aveVec(G[idxNeg], n=n_smooth, fun=fun_smooth)
				}
			M <- R - G
			A <- (R+G)/2
			# get transposon postion
			Tn_token <- if(tn_analysis) getTnToken(A, idxPosi, idxNeg, tn_threshold_M, tn_threshold_A, M=M, p=MetaP) else NULL
			p_median <- Tn_token$p_median
			M_median <- Tn_token$M_median
			Tn_token <- Tn_token$Tn_token
			if (!is.null(Tn_token) && !is.null(fn_tn)) {
				saved_tns <- countTns(Tn_token, GeneM, DTPB, MetaM, MetaP, M, A, idxPosi, idxNeg, SigP, fn_tn, tn_threshold_A, p_median=p_median, M_median=M_median, idx_signal=isep, GeneM_all=GeneM_all, DTPB_all=DTPB_all, MetaM_all=MetaM_all, MetaP_all=MetaP_all)
				if (!is.null(fn_log)) cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if(saved_tns) 'saved transposon information\n' else 'no transposon information saved\n', sep='\t'), filename=fn_log)
				}
			}
		else { # n_grp == 1
			M <- G <- NULL
			R <- rowMeans(MetaM, na.rm=TRUE)
			if (n_smooth > 1) {
				R[idxPosi] <- aveVec(R[idxPosi], n=n_smooth, fun=fun_smooth)
				R[idxNeg] <- aveVec(R[idxNeg], n=n_smooth, fun=fun_smooth)
				}
			A <- R
			# get transposon postion
			Tn_token <- if(tn_analysis) getTnToken(A, idxPosi, idxNeg, tn_threshold_M, tn_threshold_A) else NULL
			if (!is.null(Tn_token) && !is.null(fn_tn)) {
				saved_tns <- countTns(Tn_token, GeneM, DTPB, MetaM, MetaP, M, A, idxPosi, idxNeg, SigP, fn_tn, tn_threshold_A, idx_signal=isep, GeneM_all=GeneM_all, DTPB_all=DTPB_all, MetaM_all=MetaM_all, MetaP_all=MetaP_all)
				if (!is.null(fn_log)) cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if(saved_tns) 'saved transposon information\n' else 'no transposon information saved\n', sep='\t'), filename=fn_log)
				}
			}
		}

	# use idx over here to filter weak probes
	rm(list=intersect(ls(), c('MetaM', 'GeneM', 'idxPosi', 'idxNeg'))) #, 'M', 'A'))) 
	gc()

	if (plot_by == 'nucleotide') {
		len_sect <- nucleotide_num #10000
		n_sect <- as.integer(max(probe_pos, na.rm=TRUE)/len_sect) + 1 
		#while (n_sect > max_section) {
		#	len_sect <- len_sect * 2
		#	n_sect <- as.integer(max(probePosition, na.rm=TRUE)/len_sect) + 1
		#	}
		if (n_sect > max_section) {
			n_sect <- max_section
			len_sect <- as.integer(max(probe_pos, na.rm=TRUE)/n_sect) + 1
			}
		}
	else if (plot_by == 'probe') {
		#n_sect <- as.integer(length(R)/10000) + 1
		#n_sect <- as.integer(length(R)/1000) + 1
		n_sect <- min(max_section, as.integer(length(R)/probe_num) + 1)
		len_sect <- as.integer(max(probe_pos, na.rm=TRUE)/n_sect) + 1 
		}
	else if (plot_by == 'total') {
		n_sect <- 1
		len_sect <- max(probe_pos, na.rm=TRUE) + 1
		}
	else { # by chromosome
		#if(p_label && !is.null(MetaP)) MetaP_orig <- MetaP
		#Tn_token_orig <- Tn_token
		for (achr in sort(unique(chr))) {
			idx <- which(chr==achr)
			if (length(idx) < 3) next
			#if (p_label && !is.null(MetaP)) MetaP <- MetaP_orig[idx] # plotGenome will call getSigIdxParam, which will use MetaP
			#Tn_token <- Tn_token_orig[idx]
			plotGenome(R[idx], G[idx], M[idx], A[idx], probe_pos[idx], probe_strand[idx], gene_name[idx], gene_strand[idx], paste(file_prefix, achr, sep='_'), len_sect=max(probe_pos[idx], na.rm=TRUE)+1, n_sect=1, plot_pdf=plot_pdf, tn_analysis=tn_analysis, tn_token=Tn_token[idx], getGeneIdx=getGeneIdx, p_label=p_label, MetaP=MetaP[idx], SigP=SigP, max_chart=max_chart, bac_cgh=bac_cgh, fn_log=fn_log, other_params=other_params)
			}
		return()
		}
	
	#if (!is.null(fn_log)) cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'before plotGeome\n', sep='\t'), filename=fn_log)
	plotGenome(R, G, M, A, probe_pos, probe_strand, gene_name, gene_strand, file_prefix=file_prefix, len_sect=len_sect, n_sect=n_sect, plot_pdf=plot_pdf, tn_analysis=tn_analysis, tn_token=Tn_token, getGeneIdx=getGeneIdx, p_label=p_label, MetaP=MetaP, SigP=SigP, max_chart=max_chart, bac_cgh=bac_cgh, fn_log=fn_log, other_params=other_params)
	}

mkFn <- function(fdir, ..., file_sep=.Platform$file.sep, sep='') {
	#file_sep <- .Platform$file.sep # file_sep will be used between fdir and ..., sep will be used among ...
	paste(fdir, ifelse(substr(fdir, nchar(fdir), nchar(fdir))==file_sep, '', file_sep), ..., sep=sep)
	}

logWithString <- function(s) if (IN_DEBUG_MODE) cat(s, file=DEBUG_FN, append=TRUE)
logWithTable <- function(s) if (IN_DEBUG_MODE) write.table(s, file=DEBUG_FN, row.names=TRUE, append=TRUE)

cat2File <- function(s, filename='', mode='a') {
	fp <- try(file(filename, mode), silent=TRUE)
	if ('try-error' %in% class(fp)) return()
	cat(s, file=fp)
	close(fp)
	}

analyzeMPMDB <- function(DTList, con=NULL) {
	#file_sep <- .Platform$file.sep
	if (!is.null(DTList$HOSTNAME)) HOSTNAME <<- DTList$HOSTNAME
	fn_time <- mkFn(DTList$result_dir, 'request_step.txt')
	cat2File('Time\tDifference\tEvent\n', fn_time, 'w')
	time_last<-Sys.time()
	cat2File(paste(time_last, '\tthe job was started\n', sep='\t'), filename=fn_time) # may fail to open file, so put time_last before this line.

	if (is.null(DTList$data)) {
		DTList <- try(readGrps(DTList, con))
		cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(DTList)) 'failed to get data\n' else 'got and preprocessed data\n', sep='\t'), filename=fn_time)
		if (!('try-error' %in% class(DTList))) saveExpInfo(DTList)
		else stop('Failed to get data')
		}
	if (IN_DEBUG_MODE) DTList <<- DTList
	gc()

	# get probe annotation here
	readProbeFile <- function(fn) {
		lines <- scan(fn, nlines=200, what=list('character'), sep='\n')[[1]]
		if (substr(lines[1], 1, 31) == '"Probe Set ID","GeneChip Array"') return(read.csv(fn)) # Affy annotation files of old style
		if (lines[1] == '^Annotation') {  # new-style Affy annotation files like GPL4685.annot
			tb <- read.delim(fn, skip=max(grep('!platform_table_begin', lines)) )
			if (tb[nrow(tb),1] == '!platform_table_end') tb <- tb[-nrow(tb),]
			return(tb)
			}
		else if (length(grep('netaffx-annotation-tabular-format-version', lines)) > 0) { # exon arrays
			return(read.delim(fn, skip=max(grep('^#|^!|^\\^', lines, perl=TRUE))))
			}
		# user-defined probe files
		return(read.delim(fn))
		}
	DTPB <- NULL
	save_data <- (!is.null(DTList$save_data) && DTList$save_data) || DTList$analysis_method == 'get_data'
	save_result <- !(DTList$analysis_method %in% c('none', 'get_data'))
	save_probe_tb <- if (!is.null(DTList$probe_info) && DTList$probe_info=='in tables') TRUE else FALSE
	save_probe_file <- if (is.null(DTList$probe_info) || DTList$probe_info=='in files') TRUE else FALSE # another options is "nowhere"
	tn_analysis <- !is.null(DTList$plot_genome) && DTList$plot_genome && !is.null(DTList$tn_analysis) && DTList$tn_analysis
	if (save_probe_tb && (save_data || save_result || tn_analysis )) {
		probe_idx <- DTList$probe_idx
		if (!is.null(probe_idx)) {
			for (dbnm in names(probe_idx)) {
				pfinfos <- probe_idx[[dbnm]]
				if (is.null(pfinfos) || is.na(pfinfos)) next
				for (pf_id in names(pfinfos)) {
					pfinfo <- pfinfos[[pf_id]]
					pfname <- pfinfo$pfname
					fn_src <- pfinfo$filename
					row_idx <- pfinfo$row_idx
					if (is.null(fn_src)) next
					fdt <- readProbeFile(fn_src) #read.delim(fn_src, as.is=TRUE)
					if (DTList$XPF) colnames(fdt) <- paste(colnames(fdt), paste('(', pfname, '::', dbnm, ')', sep=''))
					if (!is.null(row_idx)) fdt <- fdt[row_idx, ]
					DTPB <- if(is.null(DTPB)) fdt else cbind(DTPB, fdt) # data.frame cannot cbind with NULL (matrix can)
					}
				}
			cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'read probe files\n', sep='\t'), filename=fn_time)
			}
		}
	gc()

	# save data 
	
	rltb <- NULL
	probe_left_norm <- probe_left_dif <- TRUE
	has_data_tb <- has_dif_tb <- FALSE
	if (save_data) {
		rltb <- retData(DTList)
		if ('probe_left' %in% colnames(rltb)) probe_left_norm <- as.integer(rltb[,'probe_left'])
		if (!is.null(DTList$result_dir)) {
			try({ 
				if (is.null(DTPB)) DT_TMP <- cbind(rltb[, colnames(rltb)!='probe_left'])
				else DT_TMP <- cbind(rltb[, colnames(rltb)!='probe_left'], DTPB[probe_left_norm,])
				#write.table(DT_TMP, file=mkFn(DTList$result_dir, DTList$req_name, '_data_table.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t') 
				write.table(DT_TMP, file=mkFn(DTList$result_dir, 'data_table.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t') 
				# write data type
				DT_TMP <- sapply(seq(ncol(DT_TMP)), function(i) typeof(DT_TMP[,i]))
				#write.table(DT_TMP, file=mkFn(DTList$result_dir, DTList$req_name, '_data_table.cat'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t')
				write.table(DT_TMP, file=mkFn(DTList$result_dir, 'data_table.cat'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t')
				rm(DT_TMP)
				gc()
				has_data_tb <- TRUE}, silent=TRUE)
			cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'saved data table\n', sep='\t'), filename=fn_time)
			}
		}
	if (IN_DEBUG_MODE && !is.null(DTList$result_dir)) try(save(DTList, file=mkFn(DTList$result_dir, 'MPMDBList.Rdata') ), silent=TRUE)
	gc()

	# differential analysis
	sorted_rlt <- FALSE
	dif_test <- FALSE
	dif_p <- dif_M <- NULL
	if (save_result) {
		dif_test <- TRUE
		rltb <- try(analyzeDTList(DTList)) # analyzeDTList should return DTList
		cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rltb)) 'failed in differential analysis\n' else 'differential analysis was done\n', sep='\t'), filename=fn_time)
		if (any(class(rltb) == 'character')) {
			#if (!is.null(DTList$result_dir)) try(write.table(rltb, file=mkFn(DTList$result_dir, DTList$req_name, '_output_info.txt'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
			if (!is.null(DTList$result_dir)) try(write.table(rltb, file=mkFn(DTList$result_dir, 'output_info.txt'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
			}
		else {
			if ('MPMDBList' %in% class(rltb)) {
				DTList <- rltb
				rltb <- DTList$dif_result
				dif_p <- DTList$dif_pvalue
				if (!is.null(dif_p)) ord_dif_p <- order(dif_p)
				dif_M <- DTList$M 
				DTList$dif_result <- DTList$dif_pvalue <- DTList$M <- NULL  # to release memory
				}
			#rlt$XPF <- DTList$XPF
			#save(rltb, file='/home/xxia/temp/inqInt_rltb.Rdata')
			#rlt <- mkRltTable(rlt)
			if ('probe_left' %in% colnames(rltb)) probe_left_dif <- as.integer(rltb[,'probe_left'])
			DTPB <- DTPB[probe_left_dif, ]
			if (!is.null(DTList$sort_rlt) && DTList$sort_rlt && !is.null(dif_p)) {
				sorted_rlt <- TRUE
				rltb <- rltb[ord_dif_p, ] 
				#DTPB <- DTPB[ord_dif_p, ]
				}
			if (!is.null(DTList$result_dir)) {
				try({
					if (is.null(DTPB)) DT_TMP <- cbind(rltb[, colnames(rltb)!='probe_left'])
					else {
						#DT_TMP <- cbind(rltb[, colnames(rltb)!='probe_left'], DTPB[probe_left_dif,])
						DT_TMP <- cbind(rltb[, colnames(rltb)!='probe_left'], DTPB[if(sorted_rlt) ord_dif_p else TRUE, ])
						}
					#write.table(DT_TMP, file=mkFn(DTList$result_dir, DTList$req_name, '_differential_analysis.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t')
					write.table(DT_TMP, file=mkFn(DTList$result_dir, 'differential_analysis.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t')
					# write data type
					DT_TMP <- sapply(seq(ncol(DT_TMP)), function(i) typeof(DT_TMP[,i]))
					#write.table(DT_TMP, file=mkFn(DTList$result_dir, DTList$req_name, '_differential_analysis.cat'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t')
					write.table(DT_TMP, file=mkFn(DTList$result_dir, 'differential_analysis.cat'), col.names=FALSE, row.names=FALSE, quote=FALSE, sep='\t')
					rm(DT_TMP)
					gc()
					has_dif_tb <- TRUE}, silent=TRUE)
				}
			}
		cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'saved output of differential analysis\n', sep='\t'), filename=fn_time)
		}
	#rm(DTPB)
	gc()

	# meta analysis
	fn_tn <- mkFn(DTList$result_dir, 'transposon_table.txt')
	fn_bacgh <- mkFn(DTList$result_dir, 'bacCGH_table.txt')
	fn_bga <- mkFn(DTList$result_dir, 'bga_result.txt')
	fn_coa <- mkFn(DTList$result_dir, 'coa_result.txt')
	max_chart <- if (is.null(DTList$debug_mode) || !DTList$debug_mode) NULL else DTList$max_chart
	cgh_cols <- c('unique_id', 'chromosome', 'probe_start', 'probe_end', 'probe_strand', 'gene_symbol', 'gene_title', 'gene_strand')
	#cgh_cols <- c('idx', 'unique_id', 'chromosome', 'probe_start', 'probe_end', 'probe_strand', 'gene_symbol', 'gene_title', 'gene_strand')
	user_genome <- !is.null(DTList$gn_probefile) && file.exists(DTList$gn_probefile)
	if (user_genome) { # get genome information from a user-specified probe file
		#geneM <- try(read.delim(DTList$user_genome, col.names=cgh_cols), silent=TRUE)
		#geneM <- try(read.delim(DTList$user_genome), silent=TRUE)
		geneM <- try(eadProbeFile(DTList$gn_probefile), silent=TRUE)
		if ('try-error' %in% class(geneM)) user_genome <- FALSE
		else { # filter geneM by probe_idx
			probe_idx <- DTList$probe_idx[[DTList$dbnm_first]][[DTList$pf_id_first]][[row_idx]]
			if (!is.null(probe_idx)) {
				geneM <- try(geneM[probe_idx, ], silent=TRUE)
				if ('try-error' %in% class(geneM)) user_genome <- FALSE
				}
			if (user_genome) {
				if (!('idx' %in% colnames(geneM))) geneM <- cbind('idx'=seq(nrow(geneM)), geneM)
				DTPB <- geneM
				geneM <- geneM[, cgh_cols]
				}
			}
		}
	n_grp <- DTList$n_grp
	if (DTList$clust_chs || (DTList$clust_grps && n_grp>2) || DTList$plot_heatmap_chs || (DTList$plot_heatmap_grps && n_grp>2) || DTList$plot_genome || DTList$coa_analysis || (DTList$bga_analysis && n_grp>2)) { # do meta analysis
		if (is.null(dif_M)) {
			GM <- shrinkDups(DTList)
			metaM <- GM$M
			gpos <- GM$gpos
			if (!is.null(gpos)) gpos <- sapply(gpos, function(x) x[1])
			if (user_genome) { if (!is.null(gpos)) geneM <- geneM[gpos,] }
			else geneM <- rbind(GM$geneM[, cgh_cols]) #cbind(GM$geneM[, cgh_cols])
			if (!is.null(gpos)) DTPB <- DTPB[gpos,]
			}
		else {
			if (user_genome) {
				geneM <- geneM[DTList$gpos4dups,]
				DTPB <- DTPB[DTList$gpos4dups,]
				}
			else geneM <- rbind(rltb[, cgh_cols]) #cbind(rltb[, cgh_cols])
			metaM <- dif_M 
			}
		#if (user_genome) DTPB <- geneM
		if (is.null(dim(metaM))) metaM <- cbind(metaM)
		rownames(metaM) <- geneM[, 'unique_id'] # in order that the heatmap present unique_id instead of idx

		# filter data
		metaP <- dif_p 
		screen_probes <- FALSE
		if (!is.null(dif_p)) {
			if (DTList$screen_gene == 'by_pvalue') {
				idx <- which(dif_p <= DTList$p_threshold)
				if (length(idx) < length(dif_p)) screen_probes <- TRUE
				}
			else if (DTList$screen_gene == 'by_number') {
				idx <- ord_dif_p[1:min(length(dif_p), DTList$gene_num)]
				if (length(idx) < length(dif_p)) screen_probes <- TRUE
				}
			}
		ext <- if (DTList$plot_pdf) '.pdf' else '.png'
		grps <- pData(DTList$data)$group
		if (is.null(DTList$screen_for_cluster)) DTList$screen_for_cluster <- TRUE
		if (is.null(DTList$screen_for_heatmap)) DTList$screen_for_heatmap <- TRUE
		if (is.null(DTList$screen_for_coa)) DTList$screen_for_coa <- TRUE
		if (is.null(DTList$screen_for_bga)) DTList$screen_for_bga <- TRUE
		if (is.null(DTList$screen_for_genome)) DTList$screen_for_genome <- FALSE

		use_filter <- FALSE
		if (DTList$screen_for_cluster && (DTList$clust_chs || (DTList$clust_grps && n_grp>2)) ) use_filter <- TRUE
		else if (DTList$screen_for_heatmap && (DTList$plot_heatmap_chs || (DTList$plot_heatmap_grps && n_grp>2)) ) use_filter <- TRUE
		else if (DTList$screen_for_coa && (DTList$coa_analysis && n_grp>1) ) use_filter <- TRUE
		else if (DTList$screen_for_bga && (DTList$bga_analysis && n_grp>2) ) use_filter <- TRUE
		else if (DTList$screen_for_genome && DTList$plot_genome ) use_filter <- TRUE

		gc()
		#fn_tn <- mkFn(DTList$result_dir, DTList$req_name, '_transposon_table.txt')
		#fn_bacgh <- mkFn(DTList$result_dir, DTList$req_name, '_bacCGH_table.txt')
		if (screen_probes && use_filter) { # do meta analysis that need all probes first, then screen probes
			# do meta analysis that need all probes
			if (DTList$clust_chs && !DTList$screen_for_cluster) {
				rlt <- try(clustM(metaM, fn=paste(DTList$chart_prefix, 'cluster_data_channels', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to cluster data channels\n' else 'clustered data channels\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$clust_grps && n_grp>2 && !DTList$screen_for_cluster) {
				rlt <- try(clustM(groupM(metaM, group=paste('group', grps, sep='')), fn=paste(DTList$chart_prefix, 'cluster_groups', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to cluster groups\n' else 'clustered groups\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$plot_heatmap_chs && !DTList$screen_for_heatmap) {
				rlt <- try(heatmapM(metaM, fn=paste(DTList$chart_prefix, 'heatmap_data_channels', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce heatmap by data channels\n' else 'produced heatmap by data channels\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$plot_heatmap_grps && n_grp>2 && !DTList$screen_for_heatmap) {
				rlt <- try(heatmapM(groupM(metaM, group=paste('group', grps, sep='')), fn=paste(DTList$chart_prefix, 'heatmap_groups', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce heatmap by groups\n' else 'produced heatmap by groups\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (n_grp > 1 && DTList$coa_analysis && !DTList$screen_for_coa) {
				rlt <- try(doCOA(metaM, grps, coa_num=DTList$coa_num, fn_gene=fn_coa, fn_chart=paste(DTList$chart_prefix, 'COA_chart', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce COA charts\n' else 'produced COA charts\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (n_grp > 2 && DTList$bga_analysis && !DTList$screen_for_bga) {
				rlt <- try(doBGA(metaM, grps, bga_num=DTList$bga_num, fn_gene=fn_bga, fn_chart=paste(DTList$chart_prefix, 'BGA_chart', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce BGA charts\n' else 'produced BGA charts\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$plot_genome && !DTList$screen_for_genome) {
				if (is.null(DTList$debug_mode) || !DTList$debug_mode) rlt <- try(plotCGH(metaM, geneM, DTPB, metaP, grps, file_prefix=paste(DTList$chart_prefix, 'genome_chart', sep=''), work_dir=DTList$work_dir, plot_by=DTList$plot_genome_by, nucleotide_num=DTList$nucleotide_num, probe_num=DTList$probe_num, max_section=DTList$max_section, plot_pdf=DTList$plot_pdf, weak_perc=DTList$weak_perc, tn_analysis=DTList$tn_analysis, n_smooth=if(is.null(DTList$n_smooth)) 3 else DTList$n_smooth, fun_smooth=if(is.null(DTList$fun_smooth)) median else eval(parse(text=DTList$fun_smooth)), p_label=if(is.null(DTList$gn_p_label)) TRUE else DTList$gn_p_label, SigP=if(is.null(DTList$gn_p_threshold)) 0.01 else DTList$gn_p_threshold, fn_tn=fn_tn, fn_log=fn_time, time_last=time_last, max_chart=max_chart, debug_mode=DTList$debug_mode, tn_threshold_M=DTList$tn_threshold_M, tn_threshold_A=DTList$tn_threshold_A, bac_cgh=DTList$bac_cgh, fn_bacgh=fn_bacgh, other_params=DTList))
				else rlt <- plotCGH(metaM, geneM, DTPB, metaP, grps, file_prefix=paste(DTList$chart_prefix, 'genome_chart', sep=''), work_dir=DTList$work_dir, plot_by=DTList$plot_genome_by, nucleotide_num=DTList$nucleotide_num, probe_num=DTList$probe_num, max_section=DTList$max_section, plot_pdf=DTList$plot_pdf, weak_perc=DTList$weak_perc, tn_analysis=DTList$tn_analysis, n_smooth=if(is.null(DTList$n_smooth)) 3 else DTList$n_smooth, fun_smooth=if(is.null(DTList$fun_smooth)) median else eval(parse(text=DTList$fun_smooth)), p_label=if(is.null(DTList$gn_p_label)) TRUE else DTList$gn_p_label, SigP=if(is.null(DTList$gn_p_threshold)) 0.01 else DTList$gn_p_threshold, fn_tn=fn_tn, fn_log=fn_time, time_last=time_last, max_chart=max_chart, debug_mode=DTList$debug_mode, tn_threshold_M=DTList$tn_threshold_M, tn_threshold_A=DTList$tn_threshold_A, bac_cgh=DTList$bac_cgh, fn_bacgh=fn_bacgh, other_params=DTList)
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce genome charts\n' else 'produced genome charts\n', sep='\t'), filename=fn_time)
				gc()
				}

			# then screen probes
			if (length(idx)>1) {
				metaP <- dif_p[idx]
				#metaM <- if (is.null(dim(metaM)) || ncol(metaM)==1) cbind(metaM[idx]) else rbind(metaM[idx,])
				metaM <- SubM(metaM, idx) #if (length(idx)>1) cbind(metaM[idx,]) else rbind(metaM[idx,])
				geneM <- rbind(geneM[idx,])}
			else metaP <- metaM <- geneM <- NULL
			}

		# do analysis that only use screened probes
		if (!is.null(metaM)) {
			gc()

			if (DTList$clust_chs && (DTList$screen_for_cluster || !(screen_probes && use_filter))) {
				rlt <- try(clustM(metaM, fn=paste(DTList$chart_prefix, 'cluster_data_channels', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to cluster data channels\n' else 'clustered data channels\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$clust_grps && n_grp>2 && (DTList$screen_for_cluster || !(screen_probes && use_filter))) {
				rlt <- try(clustM(groupM(metaM, group=paste('group', grps, sep='')), fn=paste(DTList$chart_prefix, 'cluster_groups', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to cluster groups\n' else 'clustered groups\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$plot_heatmap_chs && (DTList$screen_for_heatmap || !(screen_probes && use_filter))) {
				rlt <- try(heatmapM(metaM, fn=paste(DTList$chart_prefix, 'heatmap_data_channels', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce heatmap by data channels\n' else 'produced heatmap by data channels\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (DTList$plot_heatmap_grps && n_grp>2 && (DTList$screen_for_heatmap || !(screen_probes && use_filter))) {
				rlt <- try(heatmapM(groupM(metaM, group=paste('group', grps, sep='')), fn=paste(DTList$chart_prefix, 'heatmap_groups', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce heatmap by groups\n' else 'produced heatmap by groups\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (n_grp > 1 && DTList$coa_analysis && (DTList$screen_for_coa || !(screen_probes && use_filter))) {
				rlt <- try(doCOA(metaM, grps, coa_num=DTList$coa_num, fn_gene=fn_coa, fn_chart=paste(DTList$chart_prefix, 'COA_chart', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce COA charts\n' else 'produced COA charts\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			if (n_grp > 2 && DTList$bga_analysis && (DTList$screen_for_bga || !(screen_probes && use_filter))) {
				rlt <- try(doBGA(metaM, grps, bga_num=DTList$bga_num, fn_gene=fn_bga, fn_chart=paste(DTList$chart_prefix, 'BGA_chart', ext, sep=''), plot_pdf=DTList$plot_pdf))
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce BGA charts\n' else 'produced BGA charts\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			#cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, paste(DTList$plot_genome, DTList$screen_for_genome, !screen_probes), sep='\t'), filename=fn_time)
			if (DTList$plot_genome && (DTList$screen_for_genome || !(screen_probes && use_filter))) {
				if (is.null(DTList$debug_mode) || !DTList$debug_mode) rlt <- try(plotCGH(metaM, geneM, DTPB, metaP, grps, file_prefix=paste(DTList$chart_prefix, 'genome_chart', sep=''), work_dir=DTList$work_dir, plot_by=DTList$plot_genome_by, nucleotide_num=DTList$nucleotide_num, probe_num=DTList$probe_num, max_section=DTList$max_section, plot_pdf=DTList$plot_pdf, weak_perc=DTList$weak_perc, tn_analysis=DTList$tn_analysis, n_smooth=if(is.null(DTList$n_smooth)) 3 else DTList$n_smooth, fun_smooth=if(is.null(DTList$fun_smooth)) median else eval(parse(text=DTList$fun_smooth)), p_label=if(is.null(DTList$gn_p_label)) TRUE else DTList$gn_p_label, SigP=if(is.null(DTList$gn_p_threshold)) 0.01 else DTList$gn_p_threshold, fn_tn=fn_tn, fn_log=fn_time, time_last=time_last, max_chart=max_chart, debug_mode=DTList$debug_mode, tn_threshold_M=DTList$tn_threshold_M, tn_threshold_A=DTList$tn_threshold_A, bac_cgh=DTList$bac_cgh, fn_bacgh=fn_bacgh, other_params=DTList))
				else rlt <- plotCGH(metaM, geneM, DTPB, metaP, grps, file_prefix=paste(DTList$chart_prefix, 'genome_chart', sep=''), work_dir=DTList$work_dir, plot_by=DTList$plot_genome_by, nucleotide_num=DTList$nucleotide_num, probe_num=DTList$probe_num, max_section=DTList$max_section, plot_pdf=DTList$plot_pdf, weak_perc=DTList$weak_perc, tn_analysis=DTList$tn_analysis, n_smooth=if(is.null(DTList$n_smooth)) 3 else DTList$n_smooth, fun_smooth=if(is.null(DTList$fun_smooth)) median else eval(parse(text=DTList$fun_smooth)), p_label=if(is.null(DTList$gn_p_label)) TRUE else DTList$gn_p_label, SigP=if(is.null(DTList$gn_p_threshold)) 0.01 else DTList$gn_p_threshold, fn_tn=fn_tn, fn_log=fn_time, time_last=time_last, max_chart=max_chart, debug_mode=DTList$debug_mode, tn_threshold_M=DTList$tn_threshold_M, tn_threshold_A=DTList$tn_threshold_A, bac_cgh=DTList$bac_cgh, fn_bacgh=fn_bacgh, other_params=DTList)
				cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, if('try-error' %in% class(rlt)) 'failed to produce genome charts\n' else 'produced genome charts\n', sep='\t'), filename=fn_time)
				gc()
				}
			
			}
		}

	# output probe files here
	#if ((has_data_tb || has_dif_tb) && !is.null(DTList$result_dir) && (is.null(DTList$probe_info) || DTList$probe_info=='in files')) {
	if ((has_data_tb || has_dif_tb) && save_probe_file) {
		probe_idx <- DTList$probe_idx
		if (!is.null(probe_idx)) {
			for (dbnm in names(probe_idx)) {
				pfinfos <- probe_idx[[dbnm]]
				if (is.null(pfinfos) || is.na(pfinfos)) next
				for (pf_id in names(pfinfos)) {
					pfinfo <- pfinfos[[pf_id]]
					pfname <- pfinfo$pfname
					fn_src <- pfinfo$filename
					row_idx <- pfinfo$row_idx
					if (is.null(fn_src)) next
					fdt <- read.delim(fn_src, as.is=TRUE)
					if (!is.null(row_idx)) fdt <- fdt[row_idx, ]
					if (has_data_tb) try(write.table(fdt[probe_left_norm, ], file=mkFn(DTList$result_dir, 'Probes_for_data_table_', pfname, '.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
					if (has_dif_tb) {
						fdt <- fdt[probe_left_dif, ]
						if (sorted_rlt) fdt <- fdt[ord_dif_p, ]
						try(write.table(fdt, file=mkFn(DTList$result_dir, 'Probes_for_differential_analysis_', pfname, '.txt'), col.names=TRUE, row.names=FALSE, quote=FALSE, sep='\t'), silent=TRUE)
						}
					}
				}
			cat2File(paste(time_now <- Sys.time(), {time_dif <- format(time_now-time_last); time_last <- time_now; time_dif}, 'saved probe information\n', sep='\t'), filename=fn_time)
			}
		}

	gc()
	cat2File(paste(Sys.time(), '\tthe job was done\n', sep='\t'), filename=fn_time)
	invisible(rltb)
	}



#load('image.Rdata')
#load('inqInt_DT.Rdata'); DTList <- params
#source('/var/www/cgi-bin/webarray/analyzeDBsR')
#source('~/public_html/cgi-bin/webarray/analyzeDBsR')
##DT <- readGrps(grps, merge_method='median', host, port, user, password, bg_correct, norm_in_array, norm_in_pf)
#rlt <- analyzeMPMDB(user_params)
#rlt <- analyzeMPMDB(user_params, DTList=DTList)
##rlt <- analyzeMPMDB(user_params, con=con)

#save.image(file='/home/xxia/temp/image.Rdata')

# #load('/home/xxia/temp/image.Rdata'); user_params$nproc <- 1;
# source('/home/xxia/temp/user_params.R'); user_params$nproc <- 1;
# source('/home/xxia/public_html/cgi-bin/webarray/analyzeDBsR'); IN_DEBUG_MODE <- TRUE
# source('/var/www/cgi-bin/webarray/analyzeDBsR'); IN_DEBUG_MODE <- TRUE

# source('xq.R'); user_params$nproc <- 1; user_params$debug_mode <- TRUE; source('analyzeDBsR'); IN_DEBUG_MODE <- TRUE
# rlt <- analyzeMPMDB(user_params);

# source('/var/www/cgi-bin/webarray/analyzeDBsR'); rlt <- analyzeMPMDB(user_params);
# load('/home/xxia/temp/image.Rdata'); user_params$nproc <- 1; source('analyzeDBsR'); rlt <- analyzeMPMDB(user_params);

# load('nim_1_all_S_N_ANOVA_MPMDBList.Rdata'); 
# source('/var/www/cgi-bin/webarray/analyzeDBsR'); DTList$nproc <- 1; rltb <- analyzeDTList(DTList)


