.packageName <- "logicFS"
cyclic.covering<-function(mat,vec.primes){
	ia<-as.data.frame(ia.samp(ncol(mat)))
	not.covered<-rowSums(as.matrix(ia)%*%t(mat)==0)
	ia<-ia[not.covered==0,]
	rowS<-rowSums(ia)
	min.rowS<-which(rowS==min(rowS))
	ia<-ia[min.rowS,]
	list.primes<-vector("list",nrow(ia))
	for(i in 1:nrow(ia))
		list.primes[[i]]<-c(vec.primes,colnames(mat)[ia[i,]==1])
	list.primes
}

generateTruthTab<-function(ltree){
	if(!is(ltree,"logregtree"))
		stop("ltree must be an object of class logregtree.")
	model.var<-ltree$trees[,3]
	model.var<-sort(model.var[model.var!=0])
	model.var<-model.var[!duplicated(model.var)]
	mat.perms<-getPerms(length(model.var))
	colnames(mat.perms)<-paste("X",model.var,sep="")
	mat.bin<-matrix(0,nrow(mat.perms),max(model.var))
	mat.bin[,model.var]<-mat.perms
	pred.out<-eval.logreg(ltree,mat.bin)
	mat.truth<-cbind(mat.perms,outcome=pred.out)
	mat.truth
}

getNames<-function(vec.primes,col.names){
	n.col<-length(col.names)
	vec.primes<-gsub("X","XtendedName",vec.primes)
	coded<-paste("XtendedName",1:n.col,sep="")
	for(i in n.col:1)
		vec.primes<-gsub(coded[i],col.names[i],vec.primes)
	vec.primes
}

getPImps<-function(ltree){
	mat.truth<-generateTruthTab(ltree)
	truth<-ifelse(ltree$coef>0 | is.na(ltree$coef),1,0)
	ids.truth<-mat.truth[,"outcome"]==truth
	mat.truth<-mat.truth[ids.truth,-ncol(mat.truth),drop=FALSE]
	if(sum(ids.truth)==1)
		vec.primes<-paste(ifelse(mat.truth==1,"","!"),colnames(mat.truth),sep="",
			collapse=" & ")
	else
		vec.primes<-prime.implicants(mat.truth)$vec.primes
	vec.primes
}

getPerms<-function(n){
	mat<-matrix(0,2^n,n)
	for(i in 1:n)
		mat[,i]<-rep(0:1,times=2^(i-1),each=2^(n-i))
	mat
}

ia.samp<-function(n.pair,conj=0){
 	mat<-matrix(0,2^n.pair,n.pair)
    	for(i in 1:n.pair) 
		mat[, i]<-rep(rep(c(1,conj),e=2^(n.pair-i)),2^(i-1))
    	mat
}

logic.bagging<-function(data,cl,B=100,ntrees=1,nleaves=8,glm.if.1tree=FALSE,
		anneal.control=logreg.anneal.control(),oob=TRUE,prob.case=0.5,
		importance=TRUE,rand=NULL){
	require(LogicReg) || stop("The package LogicReg is required.")
	if(!is.matrix(data))
		stop("'data' must be a matrix.")
	if(is.null(colnames(data))){
		colnames(data)<-paste("SNP",1:ncol(data),sep="")
		warning("Since 'data' has no column names, generic ones are added.",
			call.=FALSE)
	} 
	if(!is.null(rand))
		set.seed(rand)
	n<-length(cl)
	if(length(cl)!=nrow(data))
		stop("length(cl)!=nrow(data)")
	if(length(table(cl))!=2)
		stop("Currently only two-class analyses possible")
	type<-ifelse(ntrees>1 | glm.if.1tree,3,1)
	list.trees<-list.bagg<-vector("list",B)
	for(i in 1:B){
		bagg<-sample(n,n,replace=TRUE)
		list.trees[[i]]<-logreg(resp=cl[bagg],bin=data[bagg,],type=type,select=1,
			ntrees=ntrees,nleaves=nleaves,anneal.control=anneal.control)$model
		list.bagg[[i]]<-bagg
	}
	log.out<-list(logreg.model=list.trees,inbagg=list.bagg,data=data,type=type,
		ntrees=ntrees,nleaves=nleaves,cl=cl,oob.error=NULL,vim=NULL)
	class(log.out)<-"logicBagg"
	if(oob)
		log.out$oob.error<-logic.oob(log.out,prob.case=prob.case)
	if(importance)
		log.out$vim<-logic.vim(log.out,prob.case=prob.case)
	log.out
}

logic.fs<-function(data,cl,B=100,ntrees=1,nleaves=8,glm.if.1tree=FALSE,
		anneal.control=logreg.anneal.control(),prob.case=0.5,rand=NULL){
	log.out<-logic.bagging(data,cl,B=B,ntrees=ntrees,nleaves=nleaves,importance=FALSE,
		glm.if.1tree=glm.if.1tree,anneal.control=anneal.control,oob=FALSE,
		prob.case=prob.case,rand=rand)
	vim.out<-logic.vim(log.out,prob.case=prob.case,addInfo=TRUE)
	vim.out
}

logic.oob<-function(log.out,prob.case=0.5){
	if(!is(log.out,"logicBagg"))
		stop("log.out must be an object of class logicBagg.")
	data<-log.out$data
	trees<-log.out$logreg.model
	inbagg<-log.out$inbagg
	n.row<-nrow(data)
	votes<-n.in<-pred<-numeric(n.row)
	list.oob<-vector("list",length(trees))
	for(i in 1:length(trees)){
		oob<-which(!(1:n.row)%in%inbagg[[i]])
		pred.cl<-predict(trees[[i]],data[oob,],log.out$type)>prob.case
		votes[oob]<-votes[oob]+pred.cl
		n.in[oob]<-n.in[oob]+1
		list.oob[[i]]<-oob
	}	
	pred[votes>n.in/2]<-1
	if(any(votes==n.in/2))
		pred[votes==n.in/2]<-sample(0:1,sum(votes==n.in/2),rep=TRUE)
	if(any(n.in==0)){
		warning(sum(n.in==0)," of the observations are in none of the oob samples.")
		pred[n.in==0]<-NA
	}
	oob.err<-mean(pred!=log.out$cl,na.rm=TRUE)
	oob.err
}

logic.pimp<-function(log.out){
	if(!is(log.out,"logicBagg"))
		stop("log.out must be an object of class logicBagg.")
	lmodel<-log.out$logreg.model
	n.lmodel<-length(lmodel)
	list.primes<-vector("list",n.lmodel)
	for(i in 1:n.lmodel)
		list.primes[[i]]<-lapply(lmodel[[i]]$trees,getPImps)
	list.primes
}

logic.vim<-function(log.out,prob.case=.5,addInfo=FALSE){
	type<-log.out$type
	if(!type%in%c(1,3))
		stop("Currently only available for classification and logistic regression.")
	list.primes<-logic.pimp(log.out)
	B<-length(list.primes)
	if(type==1)
		vec.primes<-unlist(list.primes)
	else
		vec.primes<-unlist(lapply(list.primes,function(x) unique(unlist(x))))
	prop<-table(vec.primes)/B
	vec.primes<-unique(vec.primes)
	data<-as.data.frame(log.out$data)
	colnames(data)<-paste("X",1:ncol(data),sep="")
	attach(data,warn.conflicts=FALSE)
	mat.eval<-sapply(vec.primes,function(x) eval(parse(text=x)))
	detach(data)
	cl<-log.out$cl
	inbagg<-log.out$inbagg
	n.cl<-length(cl)
	mat.imp<-matrix(0,B,length(vec.primes))
	colnames(mat.imp)<-colnames(mat.eval)
	if(type==1){
		for(i in 1:B){
			oob<-which(!(1:n.cl)%in%inbagg[[i]])
			mat.imp[i,]<-vim.single(list.primes[[i]][[1]],mat.eval[oob,],
				cl[oob])
		}
	}
	else{
		for(i in 1:B){
			tmp.imp<-vim.multiple(list.primes[[i]],mat.eval,inbagg[[i]],
				cl=cl,prob.case=prob.case)
			mat.imp[i,names(tmp.imp)]<-tmp.imp
		}
	}
	vim<-colMeans(mat.imp)
	prop<-prop[vec.primes]
	primes<-getNames(vec.primes,colnames(log.out$data))
	param<-if(addInfo) list(B=B,ntrees=log.out$ntrees,nleaves=log.out$nleaves)
		else NULL
	vim.out<-list(vim=vim,prop=prop,primes=primes,type=type,param=param)
	class(vim.out)<-"logicFS"
	vim.out	
}

logic.vim2<-function(log.out,prob.case=.5,addInfo=FALSE,with.nplus=TRUE){
	type<-log.out$type
	if(!type%in%c(1,3))
		stop("Currently only available for classification and logistic regression.")
	list.primes<-logic.pimp(log.out)
	B<-length(list.primes)
	if(type==1)
		vec.primes<-unlist(list.primes)
	else
		vec.primes<-unlist(lapply(list.primes,function(x) unique(unlist(x))))
	prop<-table(vec.primes)/B
	vec.primes<-unique(vec.primes)
	data<-as.data.frame(log.out$data)
	colnames(data)<-paste("X",1:ncol(data),sep="")
	attach(data,warn.conflicts=FALSE)
	mat.eval<-sapply(vec.primes,function(x) eval(parse(text=x)))
	detach(data)
	cl<-log.out$cl
	inbagg<-log.out$inbagg
	n.cl<-length(cl)
	mat.imp<-matrix(0,B,length(vec.primes))
	colnames(mat.imp)<-colnames(mat.eval)
	if(type==1){
		for(i in 1:B){
			oob<-which(!(1:n.cl)%in%inbagg[[i]])
			mat.imp[i,]<-vim.single2(list.primes[[i]][[1]],mat.eval[oob,],
				cl[oob],with.nplus=with.nplus)
		}
	}
	else{
		for(i in 1:B){
			tmp.imp<-vim.multiple(list.primes[[i]],mat.eval,inbagg[[i]],
				cl=cl,prob.case=prob.case)
			mat.imp[i,names(tmp.imp)]<-tmp.imp
		}
	}
	vim<-colMeans(mat.imp)
	prop<-prop[vec.primes]
	primes<-getNames(vec.primes,colnames(log.out$data))
	param<-if(addInfo) list(B=B,ntrees=log.out$ntrees,nleaves=log.out$nleaves)
		else NULL
	vim.out<-list(vim=vim,prop=prop,primes=primes,type=type,param=param)
	class(vim.out)<-"logicFS"
	vim.out	
}

make.snp.dummy<-function(data){
	if(!is.matrix(data))
		stop("'data' must be a matrix.")
	n.col<-ncol(data)
	if(is.null(colnames(data))){
		colnames(data)<-paste("SNP",1:n.col,sep="")
		warning("Since 'data' has no column names, generic ones are added.",
			call.=TRUE)
	}
	if(any(!data%in%c(1,2,3)))
		stop("Only values 1 (for homozygous reference), 2 (heterozygous)",
			"\n", "and 3 (homozygous variant) are allowed.")
	mat<-matrix(0,nrow(data),2*n.col)
	for(i in 1:n.col){
		mat[data[,i]%in%c(2,3),2*i-1]<-1
		mat[data[,i]==3,2*i]<-1
	}
	colnames(mat)<-paste(rep(colnames(data),e=2),rep(1:2,n.col),sep="_")
	mat.info<-data.frame(SNP=1:3,SNP_1=c(0,1,1),SNP_2=c(0,0,1),
		"Assumed Genotype"=c("Homozygous Reference","Heterozygous",
		"Homozygous Variant"),check.names=FALSE)
	cat("SNPs are coded as follows:\n")
	print(mat.info)
	mat
}	
minDNF<-function(mat) minimizePI(prime.implicants(mat))

minimizePI<-function(prime.out){
	mat<-prime.out$mat.primes
	vec.primes<-NULL
	repeat{
		ids.row<-which(rowSums(mat)==1)
		if(length(ids.row)>0){
			tmp<-matrix(mat[ids.row,],nrow=length(ids.row))
			ids.prime<-which(diag(t(tmp)%*%tmp)!=0)
			tmp<-mat[,ids.prime]%*%t(mat[,ids.prime])
			ids.stay<-rowSums(tmp)==0
			#ids.stay<-rowSums(matrix(tmp[,ids.row],ncol=length(ids.row)))==0
			mat<-mat[ids.stay,,drop=FALSE]
			#ids.prime<-which(colSums(mat)==0)
			vec.primes<-c(vec.primes,colnames(mat)[ids.prime])
			if(nrow(mat)==0)
				break	
			mat<-mat[,-ids.prime,drop=FALSE]
			if(ncol(mat)==0)
				break
		}
		dim.mat<-dim(mat)
		mat<-rm.dom(mat)
		mat<-rm.dom(mat,col=TRUE,dom=FALSE)
		if(all(dim(mat)==dim.mat)){
			vec.primes<-cyclic.covering(mat,vec.primes)
			break
		}
	}
	class(vec.primes)<-"minDNF"
	vec.primes
}

plot.logicBagg<-function(x,topX=15,cex=.9,pch=16,col=1,v0.col="grey35",show.prop=FALSE,
		force.topX=FALSE,include0=TRUE,coded=TRUE,...){
	if(is.null(x$vim))
		stop("No information about the importance available.")
	plot(x$vim,topX=topX,cex=cex,pch=pch,col=col,v0.col=v0.col,show.prop=show.prop,
		force.topX=force.topX,include0=include0,coded=coded)
}

plot.logicFS<-function(x,topX=15,cex=.9,pch=16,col=1,v0.col="grey35",show.prop=FALSE,
		force.topX=FALSE,include0=TRUE,coded=TRUE,...){
	if(!show.prop){
		vim<-x$vim
		main<-paste(ifelse(x$type==1,"Single","Multiple"),"Tree Measure")
		xlab<-"Importance"
	}
	else{
		vim<-x$prop
		main<-"Ad Hoc Measure"
		xlab<-"Proportion"
	}
	if(!coded)
		names(vim)<-x$primes
	vim<-sort(vim,decreasing=TRUE)
	topX<-min(topX,length(vim))
	vim<-if(force.topX) vim[1:topX] else vim[vim>=vim[topX]]
	rangex<-if(!show.prop) range(if(include0) 0,vim) else c(0,1)
	dotchart(rev(vim),main=main,xlab=xlab,pch=pch,col=col,cex=cex,xlim=rangex)
	if(!show.prop & rangex[1]<=0)
		abline(v=0,lty="dashed",col=v0.col)
}

predict.logicBagg<-function(object,newData,prob.case=.5,...){
	if(prob.case<=0 | prob.case>=1)
		stop("prob.case must be between 0 and 1.")
	if(missing(newData))
		newData<-object$data
	trees<-object$logreg.model
	n.new<-nrow(newData)
	B<-length(trees)
	mat.pred<-matrix(NA,n.new,B)
	for(i in 1:B)
		mat.pred[,i]<-predict(trees[[i]],newbin=newData,type=object$type)
	if(object$type==3)
		mat.pred<-mat.pred>prob.case
	votes<-rowSums(mat.pred)
	pred<-rep(0,n.new)
	pred[votes>B/2]<-1
	if(any(votes==B/2))
		pred[votes==B/2]<-sample(0:1,sum(votes==B/2),replace=TRUE)
	pred
}

predict.logregmodel<-function(object,newbin,type,...){
	if(!type%in%c(1,3))
		stop("Currently only available for classification and logistic regression.")
	mat.model<-cbind(1,eval.logreg(object,newbin))
	pred<-mat.model%*%object$coef
	if(type==1)
		pred[pred!=0]<-1
	else
		pred<-exp(pred)/(1+exp(pred))
	pred
}

prime.implicants<-function(mat){
	if(is.vector(mat) || nrow(mat)==1)
		stop("'mat' must have at least 2 rows.")
	mat[mat==0]<- -1
	n.var<-ncol(mat)
	if(is.null(colnames(mat)))
		colnames(mat)<-paste("X",1:n.var,sep="")
	ia<-ia.samp(n.var)
	ia.rowS<-rowSums(ia)
	vec.primes<-character(0)
	list.cover<-list()
	mat.in<-NULL
	name.paste<-function(x){
		x<-x[x!=""]
		paste(x,collapse=" & ")
	}
	for(i in 1:n.var){
		pairt<-ia.samp(i,conj=-1)
		n.p<-nrow(pairt)
		ia2<-matrix(ia[ia.rowS==i,],ncol=n.var)
		tmp<-matrix(0,nrow(ia2)*n.p,n.var)
		for(j in 1:nrow(ia2))
			tmp[((j-1)*n.p+1):(j*n.p),ia2[j,]==1]<-pairt
		if(length(vec.primes)>0){
			tmp9<-tmp%*%t(mat.in)
			tmp10<-diag(mat.in%*%t(mat.in))
			tmp11<-t(tmp10)%x%rep(1,nrow(tmp))==tmp9
			tmp.in<-which(rowSums(tmp11)==0)
			tmp<-tmp[tmp.in,]
		}
		tmp2<-tmp%*%t(mat)==i
		ids<-which(rowSums(tmp2)==2^(n.var-i))
		tmp<-tmp[ids,]
		if(length(ids)>0){
			mat.in<-rbind(mat.in,tmp)
			for(k in ids)
				list.cover[[length(list.cover)+1]]<-which(tmp2[k,]) #ids2
			mat.names<-matrix(rep(colnames(mat),e=length(ids)),ncol=n.var)
			mat.names[tmp==0]<-""
			mat.names[tmp==-1]<-paste("!",mat.names[tmp==-1],sep="")
			tmp.prime<-apply(mat.names,1,name.paste)
			vec.primes<-c(vec.primes,tmp.prime)
		}
		cover<-unique(unlist(list.cover))
		if(length(cover)==nrow(mat))
			break
	}
	n.prime<-length(vec.primes)
	mat.primes<-matrix(0,nrow(mat),n.prime)
	for(i in 1:n.prime)
		mat.primes[list.cover[[i]],i]<-1
	colnames(mat.primes)<-vec.primes
	mat.primes<-rm.dom(mat.primes,col=TRUE,dom=FALSE)
	vec.primes<-colnames(mat.primes)
	listPI<-list(vec.primes=vec.primes,mat.primes=mat.primes)
	class(listPI)<-"primeImp"
	listPI
}

print.logicBagg<-function(x,...){
	cat("Bagged Logic Regression\n\n")
	cat("Number of Iterations: ",length(x$logreg.model),"\n")
	cat("Logic Regression Type:",ifelse(x$type==1,"Classification",
		"Logistic Regression"),"\n")
	if(x$type==3)
		cat("Number of Trees:      ",x$ntrees,"\n")
	cat("Max. Number of Leaves:",x$nleaves,"\n")
	if(!is.null(x$oob.error))
	   cat("\n","OOB Error Rate:        ",100*round(x$oob.error,4),"%","\n",sep="")
}

print.logicFS<-function(x,topX=5,show.prop=TRUE,coded=FALSE,...){
	param<-x$param
	if(!is.null(param)){
		cat("Selection of Interactions Using Logic Regression\n\n")
		cat("Number of Iterations: ",param$B,"\n")
		cat("Logic Regression Type:",ifelse(x$type==1,"Classification",
			"Logistic Regression"),"\n")
		if(x$type==3)
			cat("Number of Trees:      ",param$ntrees,"\n")
		cat("Max. Number of Leaves:",param$nleaves,"\n\n\n")
	}
	vim<-sort(x$vim,decreasing=TRUE)
	topX<-min(topX,length(vim))
	names.vim<-if(coded) names(vim) else x$primes[order(x$vim,decreasing=TRUE)]
	out<-data.frame(Importance=vim,Proportion=x$prop[order(x$vim,decreasing=TRUE)],
		Expression=names.vim)
	rownames(out)<-1:nrow(out)
	if(!show.prop)
		out<-out[,-2]
	out<-format(out[vim>=vim[topX],],digits=2,nsmall=2)
	cat("The",nrow(out),"Most Important Interactions:\n\n")
	print(out)
}

print.minDNF<-function(x,which=0,...){
	if(is.character(x)){
		cat("Minimum DNF",if(which>0) paste("",which),":\n",sep="")
		cat("   ",x[1],"\n")
		for(i in 2:length(x))
			cat(" | ",x[i],"\n")
	}
	else{
		cat("Because of cyclic covering, there are",length(x),"solutions:\n")
		for(i in 1:length(x)){
			cat("\n")
			class(x[[i]])<-"minDNF"
			print(x[[i]],which=i)
		}
	}
}

print.primeImp<-function(x,...){
	cat("Prime Implicants:\n")
	for(i in 1:length(x$vec.primes))
		cat("   ",x$vec.primes[i],"\n")
}

rm.dom<-function(mat,col=FALSE,dom=TRUE){
	if(col)
		mat<-t(mat)
	mat<-mat[!duplicated(mat),,drop=FALSE]
	row.dom<-mat%*%t(mat)==rowSums(mat)
	ids.row<-if(dom) colSums(row.dom)==1 else rowSums(row.dom)==1
	mat<-mat[ids.row,,drop=FALSE]
	#if(sum(ids.row)==1)
	#	mat<-matrix(mat,ncol=1,dimnames=list(rownames(mat),colnames(mat)[ids.row]))
	if(col)
		mat<-t(mat)
	mat
}

vim.multiple<-function(mprimes,mat.eval,inbagg,cl,prob.case=0.5){
	primes<-unique(unlist(mprimes))
	n.trees<-length(mprimes)
	n.primes<-length(primes)
	mat.in<-cbind(1-diag(n.primes),1)
	rownames(mat.in)<-primes		
	list.eval<-lapply(mprimes,function(x,e=mat.eval,i=mat.in) 
		e[,x,drop=FALSE]%*%i[x,,drop=FALSE]>0)
	vec.improve<-numeric(n.primes+1)
	getIth<-function(x,ids=NULL) x[,ids]
	oob<-which(!(1:nrow(mat.eval))%in%inbagg)
	for(i in 1:(n.primes+1)){
		mat.model<-matrix(unlist(lapply(list.eval,getIth,ids=i)),ncol=n.trees)
		if(any(colSums(mat.model)==0))
			mat.model<-mat.model[,colSums(mat.model)>0]
		mat.model<-data.frame(cl=cl,mat.model)
		glm.out<-glm(cl~.,data=mat.model[inbagg,],family="binomial")
		preds<-predict(glm.out,mat.model[oob,],type="response")>prob.case
		vec.improve[i]<-sum(preds==cl[oob])
	}
	vec.improve<-vec.improve[n.primes+1]-vec.improve
	vec.improve<-vec.improve[-(n.primes+1)]
	names(vec.improve)<-primes
	vec.improve
}

vim.single<-function(primes,mat.eval,cl){
	n.col<-ncol(mat.eval)
	mat.in<-matrix(0,n.col,n.col)
	id.primes<-colnames(mat.eval)%in%primes
	n.primes<-length(primes)
	mat.in[id.primes,id.primes]<-1-diag(n.primes)
	mat.in[!id.primes,!id.primes]<-diag(n.col-n.primes)
	mat.in[id.primes,!id.primes]<-1
	mat.pred<-mat.eval%*%mat.in
	mat.pred[mat.pred>1]<-1
	vec.improve<-colSums(mat.pred==cl)
	preds<-rowSums(mat.eval[,id.primes,drop=FALSE])>0
	n.corr<-sum(preds==cl)
	vec.improve<-ifelse(id.primes,n.corr-vec.improve,vec.improve-n.corr)
	names(vec.improve)<-colnames(mat.eval)
	vec.improve
}

vim.single2<-function(primes,mat.eval,cl,with.nplus=TRUE){
	n.col<-ncol(mat.eval)
	mat.in<-matrix(0,n.col,n.col)
	id.primes<-colnames(mat.eval)%in%primes
	n.primes<-length(primes)
	mat.in[id.primes,id.primes]<-1-diag(n.primes)
	mat.in[!id.primes,!id.primes]<-diag(n.col-n.primes)
	mat.in[id.primes,!id.primes]<-1
	mat.pred<-mat.eval%*%mat.in
	mat.pred[mat.pred>1]<-1
	vec.improve<-colSums(mat.pred==cl)
	preds<-rowSums(mat.eval[,id.primes,drop=FALSE])>0
	n.corr<-sum(preds==cl)
	if(with.nplus)
		vec.improve<-ifelse(id.primes,n.corr-vec.improve,vec.improve-n.corr)
	else
		vec.improve<-ifelse(id.primes,n.corr-vec.improve,0)
	names(vec.improve)<-colnames(mat.eval)
	vec.improve
}

