R/minbdd(rev3).r

In jto888/FaultTree.BDD.Reference: Reference Implementations of BDD Algorithms on 'ftree' Objects

## SPECIAL NOTE:
## This file is an attempted implimentation of bdd minimization functions minsol and without
## It only appears to function properly on a few very simple models. Given even a modest level
## of complexity to the tree it will fail. Debug code remains in place as browser() calls.



minbdd<-function(bdd)  {			
if(!exists("FT")) stop("FT object is required in global environment")			
if(!exists("tx2ite")) stop("bdd_helpers(rev2).r is required to be sourced")			
## Facilitate extraction of strings from dataframe objects			
	options(stringsAsFactors = FALSE)		
## These tables may give some insight, the CompTable some efficiency			
	CompTable<<-data.frame(func="", R="")		
	IteTable<<-NULL		
			
	return(minsol(bdd))		
}			
			
			
minsol<-function(F_bdd)  {			
	if(F_bdd=="0" || F_bdd=="1" )  {		
		 R_bdd<- F_bdd	
	}else{		
	## test for 		
		if( paste0("minsol ", F_bdd) %in% CompTable$func)  {	
			pos<-which(CompTable$func == paste0("minsol ", F_bdd) )
			R_bdd<-CompTable$R[pos]
		}else{	
			F_obj<-tx2ite(F_bdd)
			x <- F_obj$node
			G_bdd <- F_obj$X1
			H_bdd <- F_obj$X0
			K_bdd<- minsol(G_bdd)
			U_bdd<-without(K_bdd, H_bdd)
			V_bdd<- minsol(H_bdd)
			
if(U_bdd == "0")  {
U_bdd <- "1"			
##print('U_bdd == "0" ')			
##browser()			
}			
if(V_bdd == "1")  {			
print('V_bdd == "0" ')			
browser()			
}			
			R_obj <- list(node=x, X1=U_bdd, X0=V_bdd)
			R_bdd<-tx(R_obj)
			
			CompLine=data.frame(func=paste0("minsol ", F_bdd), R=R_bdd, stringsAsFactors=FALSE)
			CompTable<<-rbind(CompTable, CompLine)
		}	
	}		
	R_bdd		
}			
			
			
			
			
			
			
			
			
without<-function(F_bdd, G_bdd)  {			
	if(F_bdd==G_bdd) {		
		R_bdd<-"0"	
	}else{		
			
	if(F_bdd==G_bdd) {		
		R_bdd<-"0"	
	}else{		
	if(F_bdd == "0" )  {		
		R_bdd<-"0"	
	}else{		
	if(G_bdd == "1" )  {		
		R_bdd<-"0"	
	}else{		
	if(G_bdd == "0" )  {		
		R_bdd<-F_bdd	
	}else{		
	if(F_bdd == "1" )  {		
		R_bdd<-"1"	
	}else{		
# check table entry for without(F_bdd, G_bdd)			
## if found return Result			
	if( paste0("without", F_bdd,", ", G_bdd) %in% CompTable$func)  {		
		pos<-which(CompTable$func == paste0("without", F_bdd,", ", G_bdd)  )	
		R_bdd<-CompTable$R[pos]	
	}else{		
			
			
	F_obj<-tx2ite(F_bdd)		
	x <- F_obj$node		
	F1_bdd <- F_obj$X1		
	F2_bdd <- F_obj$X0		
	G_obj<-tx2ite(G_bdd)		
	y <- G_obj$node		
	G1_bdd <- G_obj$X1		
	G2_bdd <- G_obj$X0		
 ## get index values for x and y			
	x_val<-min(FT$ID[which(FT$Tag==x)])		
	y_val<-min(FT$ID[which(FT$Tag==y)])		
	if(x_val<y_val)  {		
		U_bdd<-without(F1_bdd, G_bdd)	
		V_bdd<-without(F2_bdd, G_bdd)	
			
		R_obj<-list(node=x, X1=U_bdd, X0=V_bdd)	
		R_bdd<-tx(R_obj)	
			
		if(!R_bdd %in% IteTable)  {	
		IteTable<<-c(IteTable, R_bdd)	
		}	
	}		
			
	if(x_val>y_val)  {		
		R_bdd<-without(F_bdd, G2_bdd)	
	}		
			
	if(x_val==y_val)  {		
		U_bdd<-without(F1_bdd, G1_bdd)	
		V_bdd<-without(F2_bdd, G2_bdd)	
		if(U_bdd == "0") U_bdd <- "1"	
			
			
	if(V_bdd == "1") browser()		
		if(V_bdd == "1") V_bdd <- "0"	
			
		R_obj<-list(node=x, X1=U_bdd, X0=V_bdd)	
		R_bdd<-tx(R_obj)	
			
		if(!R_bdd %in% IteTable)  {	
			IteTable<<-c(IteTable, R_bdd)
		}	
		CompLine=data.frame(func= paste0("without", F_bdd,", ", G_bdd) , R=R_bdd, stringsAsFactors=FALSE)	
		CompTable<<-rbind(CompTable, CompLine)	
	}		
	}}}}}}}		
	R_bdd		
}