baggedModel <-
function(modelFormulas,data,type=c("LM","LOGIT","COX"),Outcome=NULL,timeOutcome=NULL,frequencyThreshold=0.025,univariate=NULL,useFreq=TRUE,n_bootstrap=1)
{
	type <- match.arg(type)

	formulaLoops <- 1;
	if (is.numeric(useFreq))
	{
		formulaLoops <- useFreq;
		useFreq <- TRUE;
	}
	observations <- nrow(data);
	avgZvalues <- NULL;
	forder <- NULL;
#	cat(length(modelFormulas)," :Bagging\n",modelFormulas[1],"\n");
	model <- NULL;
	if (class(modelFormulas)=="list")
	{ 
		listformulas <- modelFormulas;
		modelFormulas <- character();
		for (i in 1:length(listformulas))
		{
			modelFormulas <- append(modelFormulas,paste(listformulas[[i]],collapse = ' + '))
		}
	}
	if (length(modelFormulas)>0)
	{
		if (modelFormulas[1] != "=-=End=-=")
		{
			iscompletef <- (gregexpr(pattern ='~',modelFormulas[1])[1] > 0)
			if (iscompletef && is.null(Outcome))
			{
				varsmod <- all.vars(formula(modelFormulas[1]));
				if (substr(modelFormulas[1],1,5)!="Surv(")
				{
					Outcome <- varsmod[1];
				}
				else
				{
					Outcome <- varsmod[2];
					timeOutcome <- varsmod[1];
				}
			}

#		cat(length(modelFormulas)," :in 1 Bagging\n");

			theoutcome <- data[,Outcome];
			varOutcome <- var(theoutcome);
			binoutcome <- (length(table(theoutcome))==2) && (min(theoutcome)==0);
			predtype="linear";
			if (binoutcome) predtype="prob";
			if ( (type=="LM") && (binoutcome==TRUE) )
			{
				data[,Outcome] = 2*theoutcome-1.0;
				predtype="linear";
			}
			
			if (type!="COX")
			{
				baseForm <- paste(Outcome,"~ 1");
			}
			else
			{
				baseForm <- paste("Surv(",timeOutcome,",",Outcome,")~ 1");
			}
			EquTrainSet <- data;
			minTrainSamples <- nrow(data);
			maxTrainSamples = minTrainSamples;
			casesample  <- NULL;
			controlsample <- NULL;
			noequalSets <- FALSE;
			nrowcases <- minTrainSamples
			nrowcontrols <- minTrainSamples
			if (type != "LM")
			{
				casesample = subset(data,get(Outcome)  == 1);
				controlsample = subset(data,get(Outcome) == 0);
				nrowcases <- nrow(casesample);
				nrowcontrols <- nrow(controlsample);
				
				minTrainSamples <- min(c(nrowcases,nrowcontrols));
				maxTrainSamples <- max(c(nrowcases,nrowcontrols));
				noequalSets <- (minTrainSamples < (0.75*maxTrainSamples));
		#		cat(nrowcases,":",nrowcontrols,":",noequalSets,"\n")
		#		cat(minTrainSamples,":",maxTrainSamples,":",noequalSets,"\n")
			}
#			cat(length(modelFormulas)," :in 2 Bagging\n");
			frma <- baseForm;
			Jaccard.SM <- 0;
			coefEvolution <- NULL;
			avgsize <- 0;
			formulaNetwork <- NULL;

#				cat(length(modelFormulas)," :Entering orderFeatures\n");

			oF <- orderFeatures(modelFormulas,univariate,baseForm,useFreq,n_bootstrap);
			
			VarFrequencyTable <- oF$VarFrequencyTable;
			if (!is.null(VarFrequencyTable))
			{
#				print(VarFrequencyTable);
				forder <- oF$forder;
				theterms <- oF$theterms;
				features <- oF$features;
				modelFormulas <- oF$modelFormulas;
				
				if (length(names(VarFrequencyTable)) > 0)
				{
					loops <- length(modelFormulas);
					vnames <- rownames(VarFrequencyTable);
					formulaNetwork <- matrix(0,nrow=length(VarFrequencyTable),ncol = length(VarFrequencyTable))
					dimnames(formulaNetwork) <- list(names(VarFrequencyTable),names(VarFrequencyTable))
					m <- formulaNetwork
					Jaccard.SM <- 0;
					tota <- 0;
					for (n in 1:loops)
					{
						feat <- theterms[[n]];
						lft <- length(feat);
						m[,] <- 0;
						if (lft>0)
						{
							m[feat,feat]=1;
							if (n<loops)
							{
								for (i in (n+1):loops)
								{
									feat2 <- theterms[[i]];
									if (length(feat2) > 0)
									{
										Jaccard.SM = Jaccard.SM+sum(duplicated(c(feat2,feat)))/length(unique(c(feat2,feat)));
										tota = tota + 1;
				#						print(feat2)
				#						print(feat)
				#						cat("Dup:",sum(duplicated(c(feat2,feat)))," U:",length(unique(c(feat2,feat)))," JI:",Jaccard.SM,"\n")
									}
								}
							}
						}
						formulaNetwork <- formulaNetwork+m
					}
					if (tota>1) Jaccard.SM = Jaccard.SM/tota;
					fnrom <- loops;
					if (oF$numberofBreaks>0) fnrom <- oF$numberofBreaks;

					formulaNetwork <- round(formulaNetwork/fnrom,digits = 3);

				#	cat("Size :",nrow(data)," Features :",length(VarFrequencyTable))
					
					nsize <- nrow(data)
					
					lastTopVariable = length(VarFrequencyTable);
			#		if (lastTopVariable >= 2*(nsize-2)) lastTopVariable <- 2*(nsize-2); #The largest model size
					
					frma <- baseForm;
					enterlist <- vector();
					toRemove <- vector();
					bmodelsize <- 1;
					removed <- 0;
					avgsize <- 0;
					coefEvolution <- NULL;
					zthr <- 0;
					if (!is.null(univariate))
					{
						nfeat <- nrow(univariate);
						zthr <- abs(qnorm(0.1/(formulaLoops*nfeat)));
					}
					thrsfreq <- as.integer(frequencyThreshold*VarFrequencyTable[1]+0.5);
					if (formulaLoops==1) 
					{
						fthrsfreq <- as.integer(frequencyThreshold*loops+0.5);
					}
					else
					{
						fthrsfreq <- as.integer(frequencyThreshold*formulaLoops+0.5);
					}
					fistfreq <- VarFrequencyTable[1];
					for ( i in 1:length(vnames))
					{
						if ((vnames[i] != " ") && (vnames[i] != ""))
						{
							enterlist <- append(enterlist,vnames[i]);
							passZ <- TRUE;
							if (!is.null(univariate) && (VarFrequencyTable[i]<=(fthrsfreq+1)) && (useFreq>0) && (frequencyThreshold>0))
							{
								passZ <- (univariate[vnames[i],"ZUni"]>zthr); # only features that have strong unit pvalue for very low frequencies
		#						if (passZ==FALSE)
		#						{
		#							cat(fthrsfreq," Removing:",vnames[i],":",VarFrequencyTable[i]," Z=",univariate[vnames[i],"ZUni"],"Zthr=",zthr,"\n");
		#						}
							}
							if (passZ&&(i<=lastTopVariable)&&(VarFrequencyTable[i] > thrsfreq))  # Only features with a given frequency
							{
								if ((fistfreq == loops)&&(VarFrequencyTable[i] > (loops/3)))
								{
									fistfreq <- VarFrequencyTable[i];
									thrsfreq <- as.integer(frequencyThreshold*fistfreq+0.5);
								}
								frma <- paste(frma,"+",vnames[i]);	
								bmodelsize = bmodelsize + 1;
							}
							else
							{
								toRemove <- append(toRemove,paste(" ",vnames[i]," ",sep=""));
								removed = removed+1;
							}
						}
					}
		#			cat("\nNum. Models:",loops," To Test:",length(vnames)," TopFreq:",fistfreq," Thrf:",thrsfreq," Removed:",removed,"\n")
					model <- modelFitting(frma,data,type=type,fitFRESA=TRUE);
					if (bmodelsize>1)
					{
						thevars <- all.vars(formula(frma));
#						data <- data[,thevars];
						if (noequalSets)
						{
							casesample <- casesample[,thevars]
							controlsample <- controlsample[,thevars]
							trainCaseses <- casesample;
							trainControls <- controlsample;
					#		print(thevars);
						}
						else
						{
							EquTrainSet <- data;
						}
						
						
					#	print(toRemove);
					#	print(model$coefficients);
					#	cat(frma,"\n");
						if (inherits(model, "try-error"))
						{
			#				cat("Fitting Error\n");
							warning(frma," Warning Bagging Fitting error\n")
						}
						else
						{
							msize <- length(model$coefficients)
							basecoef <- abs(model$coefficients)+1e-6;
							names(basecoef) <- names(model$coefficients);
							
							if ((type=="COX")&&(class(model)!="fitFRESA"))
							{
								avgZvalues <- numeric(length(model$coefficients));
								names(avgZvalues) <- names(model$coefficients);
							}
							else
							{
								avgZvalues <- numeric(length(model$coefficients)-1);
								names(avgZvalues) <- names(model$coefficients)[-1];
							}
							addedZvalues <- avgZvalues;
							baggingAnalysis <- list();
							baggingAnalysis$uMS_values <- avgZvalues;
							baggingAnalysis$rMS_values <- avgZvalues;
							baggingAnalysis$NeRI_values <- avgZvalues;
							baggingAnalysis$pt_values <- avgZvalues;
							baggingAnalysis$pWilcox_values <- avgZvalues;
							baggingAnalysis$pF_values <- avgZvalues;
							baggingAnalysis$pBin_values <- avgZvalues;
							baggingAnalysis$mMSE_values <- avgZvalues;
							baggingAnalysis$uAcc_values <- avgZvalues;
							baggingAnalysis$rAcc_values <- avgZvalues;
							baggingAnalysis$uAUC_values <- avgZvalues;
							baggingAnalysis$rAUC_values <- avgZvalues;
							baggingAnalysis$idi_values <- avgZvalues;
							baggingAnalysis$nri_values <- avgZvalues;
							baggingAnalysis$zidi_values <- avgZvalues;
							baggingAnalysis$znri_values <- avgZvalues;
							baggingAnalysis$mAUC_values <- avgZvalues;
							baggingAnalysis$mACC_values <- avgZvalues;
							baggingAnalysis$coefstd <- avgZvalues;
							baggingAnalysis$coefficients <- avgZvalues;
							baggingAnalysis$wts <- avgZvalues;
						#	print(basecoef);
							avgsize <- msize-1;
							mado <- NA;
							rnames <- 0;
							nrep <- 1+2*(noequalSets);
							if ((msize > 1)&&(loops>1))
							{
								model$type=type;
								onames <- names(model$coefficients);
								mmult <- 1+1*(type=="COX");
								model$estimations <- rep(0,mmult*msize); 
								wts <- 0;
								model$coefficients <- rep(0,msize);
								names(model$coefficients) <- onames;
								modelmeans <- model$coefficients;
								coefEvolution <- c(0,model$coefficients);
								names(coefEvolution) <- c("Weight",names(model$coefficients));
							#	cat("\n");
								tot_cycles <- 0;
								b_casesample <- casesample;
								b_controlsample <- controlsample;
								for (m in 1:n_bootstrap)
								{
									if (n_bootstrap>1)
									{
										if (type!="LM")
										{
											b_casesample <- casesample[sample(1:nrowcases,nrowcases,replace=TRUE),]
											b_controlsample <- controlsample[sample(1:nrowcontrols,nrowcontrols,replace=TRUE),]						
											EquTrainSet <- rbind(b_casesample,b_controlsample)
										}
										else
										{
											EquTrainSet <- data[sample(1:nrow(data),nrow(data),replace=TRUE),];
										}
										theoutcome <- EquTrainSet[,Outcome];
										varOutcome <- var(theoutcome);
									}
									avgsize = 0;
									for (n in 1:loops)
									{
										if ((n %% 10) == 0) cat(".");
										feat <- theterms[[n]]
										avgsize = avgsize+length(feat);
										if (m==1)
										{
								#			cat(modelFormulas[n],"\n");

											if (length(toRemove)>0)
											{
												modelFormulas[n] <- paste(modelFormulas[n],"  ",sep="");
												for (rml in 1:length(toRemove))
												{
													modelFormulas[n] <- sub(toRemove[rml]," 1 ",modelFormulas[n],fixed=TRUE);
												}
							#					cat("After Rem:",modelFormulas[n],"\n");
												feat <- attr(terms(formula(modelFormulas[n])),"term.labels");
											}
										}
										if (length(feat)>0)
										{
											for (replicates in 1:nrep)
											{
												if (noequalSets)
												{
													if (maxTrainSamples > nrowcases)  trainCaseses <- b_casesample[sample(1:nrowcases,maxTrainSamples,replace=TRUE),]
													if (maxTrainSamples > nrowcontrols)  trainControls <- b_controlsample[sample(1:nrowcontrols,maxTrainSamples,replace=TRUE),]
													EquTrainSet <- rbind(trainCaseses,trainControls)
													theoutcome <- EquTrainSet[,Outcome];
													varOutcome <- var(theoutcome);
												}
												out <- modelFitting(formula(modelFormulas[n]),EquTrainSet,type,fitFRESA=TRUE);
												coef_Zanalysis <- NULL;
												if (!inherits(out, "try-error")) 
												{
													osize <- length(out$coefficients)					
													if (osize > 1)
													{
														tot_cycles = tot_cycles+1;
														curprediction <- predict.fitFRESA(out,EquTrainSet,predtype)
														residual <- as.vector(abs(curprediction-theoutcome));
														onames <- names(out$coefficients);
														znames <- onames;
														if ((type!="COX")||(class(out)=="fitFRESA")) znames <- onames[-1];
														if (predtype=="linear")
														{
															gvar <- getVar.Res(out,data=EquTrainSet,Outcome=Outcome,type=type,testData=data)
															coef_Zanalysis <- -qnorm(gvar$FP.value);
															baggingAnalysis$uMS_values[znames] <- baggingAnalysis$uMS_values[znames] + gvar$unitestMSE;
															baggingAnalysis$rMS_values[znames] <- baggingAnalysis$rMS_values[znames] + gvar$redtestMSE;
															baggingAnalysis$NeRI_values[znames] <- baggingAnalysis$NeRI_values[znames] + gvar$NeRIs;
															baggingAnalysis$pF_values[znames] <- baggingAnalysis$pF_values[znames] + log(gvar$FP.value);
															baggingAnalysis$pt_values[znames] <- baggingAnalysis$pt_values[znames] + log(gvar$tP.value);
															baggingAnalysis$pBin_values[znames] <- baggingAnalysis$pBin_values[znames] + log(gvar$BinP.value);
															baggingAnalysis$pWilcox_values[znames] <- baggingAnalysis$pWilcox_values[znames] + log(gvar$WilcoxP.value);
															baggingAnalysis$mMSE_values[znames] <- baggingAnalysis$mMSE_values[znames] + gvar$FullTestMSE;
														}
														else
														{
															gvar <- getVar.Bin(out,data=EquTrainSet,Outcome=Outcome,type=type,testData=data)
			#												cat("Equ: ",mean(EquTrainSet[,Outcome])," Data: ",mean(data[,Outcome]),"\n");
															coef_Zanalysis <- gvar$z.IDIs;
															baggingAnalysis$uAcc_values[znames] <- baggingAnalysis$uAcc_values[znames] + gvar$uniTestAccuracy;
															baggingAnalysis$rAcc_values[znames] <- baggingAnalysis$rAcc_values[znames] + gvar$redtestAccuracy;
															baggingAnalysis$uAUC_values[znames] <- baggingAnalysis$uAUC_values[znames] + gvar$uniTestAUC;
															baggingAnalysis$rAUC_values[znames] <- baggingAnalysis$rAUC_values[znames] + gvar$redtestAUC;
															baggingAnalysis$idi_values[znames] <- baggingAnalysis$idi_values[znames] + gvar$IDIs;
															baggingAnalysis$nri_values[znames] <- baggingAnalysis$nri_values[znames] + gvar$NRIs;
															baggingAnalysis$zidi_values[znames] <- baggingAnalysis$zidi_values[znames] + gvar$z.IDIs;
															baggingAnalysis$znri_values[znames] <- baggingAnalysis$znri_values[znames] + gvar$z.NRIs;
															baggingAnalysis$mAUC_values[znames] <- baggingAnalysis$mAUC_values[znames] + gvar$fullTestAUC;
															baggingAnalysis$mACC_values[znames] <- baggingAnalysis$mACC_values[znames] + gvar$fullTestAccuracy;
														}
														infnum <- is.infinite(coef_Zanalysis)
														if (sum(infnum)>0)
														{	
															coef_Zanalysis[coef_Zanalysis == Inf] <- 20.0;
															coef_Zanalysis[coef_Zanalysis == -Inf] <- 0;
														}
														avgZvalues[znames] <- avgZvalues[znames] + coef_Zanalysis;
														coef_Zanalysis[coef_Zanalysis < 0] <- 0.0;
														coef_Zanalysis[coef_Zanalysis > 10] <- 10.0;
														Rwts <- sum(coef_Zanalysis);
														Rwts <- Rwts*Rwts*(varOutcome-mean(residual^2))/varOutcome;
#														print(coef_Zanalysis);
#														cat(Rwts," : ",(varOutcome-mean(residual^2))/varOutcome," : ",modelFormulas[n],"  <- Wts \n")
														if (Rwts<=0) Rwts <- 1.0e-4;
#														Rwts <- Rwts*Rwts;
														rnames <- append(rnames,tot_cycles)
														outmeans <- out$coefficients;
														wts = wts + Rwts;
														model$coefficients[onames] <- model$coefficients[onames] + Rwts*out$coefficients[onames];
														baggingAnalysis$coefficients[znames] <- baggingAnalysis$coefficients[znames] + Rwts*out$coefficients[znames];
														baggingAnalysis$coefstd[znames] <- baggingAnalysis$coefstd[znames] + Rwts*(out$coefficients[znames]^2);
														baggingAnalysis$wts[znames] <- baggingAnalysis$wts[znames] + rep(Rwts,length(znames));
														coefEvolution <- rbind(coefEvolution,c(Rwts,model$coefficients/wts));
														addedZvalues[znames] <- addedZvalues[znames] + rep(1,length(znames));
														if (type=="COX")
														{
															fullmodelmeans <- abs(modelmeans[onames]);
															names(fullmodelmeans) <- onames 
															for (ei in 1:osize) 
															{
																outmeans[ei] <- out$estimations[osize+ei];
															}
															for (ei in onames) 
															{
																if (fullmodelmeans[ei]>0)
																{
																	modelmeans[ei] <- 0.5*(modelmeans[ei] + outmeans[ei]); 
																}
																else
																{
																	modelmeans[ei] <- outmeans[ei]; 
																}
															}
														}
								#						print(model$coefficients)
													}
												}
												else
												{
													cat("+");
								#					print(out$coef);
												}
											}
										}
									}
									avgsize = avgsize/loops;
				#					cat("*");
								}
								if( wts>0)
								{
				#					print(baggingAnalysis$coefficients^2);
				#					print(baggingAnalysis$coefstd);
				#					print(addedZvalues);
									model$coefficients <- model$coefficients/wts;
									baggingAnalysis$coefficients <- baggingAnalysis$coefficients/baggingAnalysis$wts;
									gain <- model$coefficients[names(baggingAnalysis$coefficients)]/baggingAnalysis$coefficients;
									
									baggingAnalysis$coefstd <- gain*sqrt(abs(baggingAnalysis$coefstd/baggingAnalysis$wts-(baggingAnalysis$coefficients)^2));
									baggingAnalysis$coefficients <- gain*baggingAnalysis$coefficients;
									
									coefEvolution <- as.data.frame(coefEvolution);
									rownames(coefEvolution) <- rnames
									if (type == "COX")
									{
										model$estimations <- c(model$coefficients,modelmeans);
									}
									else
									{
										model$estimations <- model$coefficients;
									}
									avgZvalues <- avgZvalues/addedZvalues;
									baggingAnalysis$formula.list <- modelFormulas;
									baggingAnalysis$uMS_values <- baggingAnalysis$uMS_values/addedZvalues;
									baggingAnalysis$rMS_values <- baggingAnalysis$rMS_values/addedZvalues;
									baggingAnalysis$NeRI_values <- baggingAnalysis$NeRI_values/addedZvalues;
									baggingAnalysis$pt_values <- exp(baggingAnalysis$pt_values/addedZvalues);
									baggingAnalysis$pWilcox_values <- exp(baggingAnalysis$pWilcox_values/addedZvalues);
									baggingAnalysis$pF_values <- exp(baggingAnalysis$pF_values/addedZvalues);
									baggingAnalysis$pBin_values <- exp(baggingAnalysis$pBin_values/addedZvalues);
									baggingAnalysis$uAcc_values <- baggingAnalysis$uAcc_values/addedZvalues;
									baggingAnalysis$rAcc_values <- baggingAnalysis$rAcc_values/addedZvalues;
									baggingAnalysis$uAUC_values <- baggingAnalysis$uAUC_values/addedZvalues;
									baggingAnalysis$rAUC_values <- baggingAnalysis$rAUC_values/addedZvalues;
									baggingAnalysis$idi_values <- baggingAnalysis$idi_values/addedZvalues;
									baggingAnalysis$nri_values <- baggingAnalysis$nri_values/addedZvalues;
									baggingAnalysis$zidi_values <- baggingAnalysis$zidi_values/addedZvalues;
									baggingAnalysis$znri_values <- baggingAnalysis$znri_values/addedZvalues;
									baggingAnalysis$mAUC_values <- baggingAnalysis$mAUC_values/addedZvalues;
									baggingAnalysis$mACC_values <- baggingAnalysis$mACC_values/addedZvalues;
									baggingAnalysis$mMSE_values <- baggingAnalysis$mMSE_values/addedZvalues;
									baggingAnalysis$wts <- baggingAnalysis$wts/addedZvalues;
									baggingAnalysis$RelativeFrequency <- VarFrequencyTable/fnrom;
									baggingAnalysis$Jaccard.SM <- Jaccard.SM;
									baggingAnalysis$n_bootstrap <- n_bootstrap;
									baggingAnalysis$coeff_n_samples <- addedZvalues;
									baggingAnalysis$observations <- observations;
									baggingAnalysis$avgZvalues <- avgZvalues;

									model$baggingAnalysis <- baggingAnalysis;
									model$linear.predictors <- predict(model);
								}
								else
								{
									
									model <- modelFitting(formula(frma),data,type=type,fitFRESA=TRUE)
						#			print(model$coefficients)
									model$coefficients[is.nan(model$coefficients)] <- 0.0;
									model$coefficients[is.na(model$coefficients)] <- 0.0;
									model$estimations[is.nan(model$estimations)] <- 0.0;
									model$estimations[is.na(model$estimations)] <- 0.0;
								}
							}
							else
							{
								model <- modelFitting(formula(frma),data,type=type,fitFRESA=TRUE)
								model$coefficients[is.nan(model$coefficients)] <- 0.0;
								model$coefficients[is.na(model$coefficients)] <- 0.0;
								model$estimations[is.nan(model$estimations)] <- 0.0;
								model$estimations[is.na(model$estimations)] <- 0.0;
							}
						}
					}
				}
				else
				{
					model <- modelFitting(formula(frma),data,type=type,fitFRESA=TRUE);
				}
			}
			else
			{
				model <- modelFitting(formula(frma),data,type=type,fitFRESA=TRUE);
			}
	#		print(model$coefficients);
			environment(model$formula) <- globalenv();
			environment(model$terms) <- globalenv();		
		}
		else
		{
			warning("No Formulas\n");
			model <- NULL;
			frma <- NULL;
			VarFrequencyTable <- NULL;
			avgsize <- 0;
			formulaNetwork <- NULL;
			Jaccard.SM <- 0;
			coefEvolution <- NULL;
		}
	}
	else
	{
		warning("No Formulas\n");
		model <- NULL;
		frma <- NULL;
		VarFrequencyTable <- NULL;
		avgsize <- 0;
		formulaNetwork <- NULL;
		Jaccard.SM <- 0;
		coefEvolution <- NULL;
	}
	

  	result <- list(bagged.model=model,
				   formula=frma,
				   frequencyTable=VarFrequencyTable,
				   averageSize=avgsize,
				   formulaNetwork=formulaNetwork,
				   Jaccard.SM = Jaccard.SM,
				   coefEvolution=coefEvolution,
				   avgZvalues=avgZvalues,
				   featureLocation=forder
				   );
  
	return (result);
}
