R/backward.R

In NTW: Predict gene network using an Ordinary Differential Equation (ODE) based method

`backward` <-
function(r,X,pert,topD,restk,cFlag,TA,noiseLevel)
{
	no_experiments <- ncol(X)
	no_genes <- nrow(X)
	no_available=length(TA)

	restk=min(restk,no_available)
	#A[r,r] is none-zero
	selected_genes <- matrix(r,1,1)
	minCrtValue <- Inf
	bestComb    <- NULL
	if(restk==0)
	{
		return(list(A.row=rep(0,nrow(X)), CrtValue=Inf))
		}
	else if(restk==1)
	{
		return(list(A.row=c(rep(0,r-1),1,rep(0,nrow(X)-r)), CrtValue=100000000000000)) 
		}
	#Generate pertubation tree
	else 
	{
		for (k in 1:(restk-1))# how things go if restk==1? #Impossible
		{
			comb1 <- NULL
			for (g in 1:nrow(selected_genes))
			{
				rest_genes <- setdiff(TA,selected_genes[g,])
				if (length(rest_genes)==1)
				{
					comb <- rest_genes
					}
				else
				{
					comb  <- t( combn(rest_genes,1) )
					}
				comb_temp <- comb.matrix(selected_genes[g,],comb)
				comb1 <- rbind(comb1,comb_temp)
				}
			comb = unique(t(apply(comb1,1,sort)))
			sol <- matrix(0,nrow = nrow(comb),ncol=ncol(comb))
			error <- matrix(0,nrow = nrow(comb),1)
			for (n in 1:nrow(comb))
			{
				if(cFlag=="geo") 
				temp.result<-method.geo(index.vars=comb[n,],X=X,pert=pert)
				if(cFlag=="sse")
				temp.result<-method.sse(index.vars=comb[n,],X=X,pert=pert)
				if(cFlag=="ml")
				temp.result<-method.ml(index.vars=comb[n,],X=X,pert=pert,noiseLevel=noiseLevel)
				sol[n,]<-  temp.result$sol
				error[n,]<-temp.result$error
				}
			srtE <- sort(error,index.return=TRUE)
			topd=topD
			topD=min(topD,nrow(comb))
			topD_comb <- comb[srtE$ix[1:topD],]
			topD_sol=sol[srtE$ix[1:topD],]
			topD_error=error[srtE$ix[1:topD],]
			if (is.vector(topD_comb))
			{
				topD_comb <- t(as.matrix(topD_comb))
				topD_sol <- t(as.matrix(topD_sol))
				}
			topD_error <- t(as.matrix(topD_error))
			selected_genes <-topD_comb
			#Compute crtValue
			crtValue <- srtE$x[1]
			# select the combination best fit for the criterion
			if(minCrtValue > crtValue)
			{
				minCrtValue <- crtValue
				bestComb    <- list(selected_genes[1,],topD_sol[1,],topD_error[1,])
				}
			topD=topd
			}
		rA=rep(0,no_genes)
		if(minCrtValue!=Inf)
		{
			rA[as.vector(bestComb[[1]])]=as.vector(bestComb[[2]])
			}
		return(list(A.row=rA, CrtValue=minCrtValue))
		}
	}