/* *********************************************************
   * General Certainty Program With Explanation Written By *
   *              Ammar Falih Mahdi in 2002                *
   *                    Expert System                      *
   ********************************************************* */

domains
	s=string.
	words=s*.
	n=real.
	list=n*.
	p=imp(s,s,s,s,s,s,s,n).
database
	evidence(s,n).
	hypothesis_node(s).
	terminal_node(s).
	imp(s,s,s,s,s,s,s,n).	
	danswer(s,n).
	infer_summary(p,n).
database - stack
	dbimp(s,s,s,s,s,s,s,n).	
	tdbimp(s,s,s,s,s,s,s,n).
predicates
	start. input. input_c. input_e. input_imp. perg.
	read_use(s). read_root(s). read_sign_left(s). read_sign_right(s,s).
	read_e_left(s). read_e_right(s,s). mem(s,words). infer(s,n).
	member(s). why_describer(s,s,s,s,s,s,s,n). reply_to_input(s,s,n).
	allinfer(s,n). repeat. gettype(s,s). getmode(s,s).
	find_multiplier(s,n,s,n). putadjustflag. exsys_driver. getallans.
	qualifier(s,n,n). prepare_answer. answer. showresults.
	supercombine(list,n). display_one_answer. how_describer(s).
	combine(list,n). how_explain(s). displayall.
	min(n,n,n). max(n,n,n). absvalue(n,n). append(list,list,list).
	
clauses
	start:-clearwindow,input,
	       clearwindow,exsys_driver,
	       readchar(_),perg.
	
	input:-input_c,input_e,input_imp.
	
	input_c:-write("Enter Conclusion name or <stop>: "),readln(C),
		 C<>"stop",!,assertz(hypothesis_node(C)),input_c.
	input_c:-write("End Conclusion Input"),nl.
	
	input_e:-write("Enter Evidence name or <stop>: "),readln(E),
		 E<>"stop",!,assertz(terminal_node(E)),input_e.
	input_e:-write("End Evidence Input"),nl.	 
	
	input_imp:-write("Enter Name of Imp or <stop>: "),readln(N),
		   N<>"stop",!,read_use(U),read_root(R),
		   read_sign_left(Sl),read_e_left(El),
		   read_sign_right(N,Sr),read_e_right(N,Er),
		   write("Enter Value of ",N," Imp : "),readreal(Ct),
		   assertz(imp(N,U,R,Sl,El,Sr,Er,Ct)),input_imp.
	input_imp.		 
	
	read_use(U):-write("Enter <r>ev or <n>rev : "),readln(U),
		     mem(U,["r","n"]),!.	
	read_use(U):-read_use(U).
	
	read_root(R):-write("Enter Root Of Imp : "),readln(R),
		      hypothesis_node(R),!.
	read_root(R):-read_root(R).	      	
	
	read_sign_left(Sl):-write("Enter <pos> or <neg> : "),
			    readln(Sl),mem(Sl,["pos","neg"]),!.
	read_sign_left(Sl):-read_sign_left(Sl).
	
	read_sign_right("s","dummy"):-!.
	read_sign_right(_,Sr):-write("Enter <pos> or <neg> : "),
			    readln(Sr),mem(Sr,["neg","pos"]),!.
	read_sign_right(N,Sr):-read_sign_right(N,Sr).
	
	read_e_left(El):-write("Enter Left Node Name : "),
			readln(El),member(El),!.
	read_e_left(El):-read_e_left(El).
	
	read_e_right("s","dummy"):-!.
	read_e_right(_,Er):-write("Enter Right Node Name : "),
			readln(Er),member(Er),!.		 
	read_e_right(N,Er):-read_e_right(N,Er).
	
	member(S):-hypothesis_node(S),!.
	member(S):-terminal_node(S),!.
	
	exsys_driver:-getallans,showresults,!.
	
	getallans:-not(prepare_answer).
	
	prepare_answer:-answer,fail.
	
	answer:-hypothesis_node(X),allinfer(X,Y),
		     assert(danswer(X,Y)).
	
	showresults:-not(displayall).
	
	displayall:-display_one_answer,fail.
	
	display_one_answer:-danswer(X,Y),clearwindow,
			    write("For this hypothesis :"),nl,
			    write(" ",X),nl,
			    write("The certainty is : ",Y),nl,nl,
			    not(how_describer(X)). 
	
	how_describer(Node):-repeat,nl,
			    write("S:Type <h>ow ",Node,", or <c>ontinue "),
			    nl,write("U:"),readln(Reply),nl,
			    how_explain(Reply),!.		    
	
	how_explain("c"):-!.
	how_explain(R):-concat("h",X1,R),frontchar(X1,_,X),
		infer_summary(imp(_,_,X,_,_,_,_,_),_),clearwindow,!,
		write("The Rule(s) that bearupon this conclusion are : "),
		nl,nl,infer_summary(imp(N,_,X,_,El,_,Er,_),F),
		write("Concluded : ",X),nl,gettype(N,UU),
		write("From an ",UU),nl,
		write("Primse 1 : ",El),nl,
		write("Primse 2 : ",Er),nl,
		write("The certainty from use of this rule : ",F),fail.
	how_explain(R):-concat("h",X1,R),frontchar(X1,_,X),
			terminal_node(X),evidence(X,C),
			write("You told me that : "),nl,write(" ",X),nl,
			write("has a certainty of : ",C),nl,fail.
					    
	allinfer(Node,Ct):-findall(C1,infer(Node,C1),Clist),
		           supercombine(Clist,Ct).
	
	infer(Node,Ct):-terminal_node(Node),evidence(Node,Ct),!.
	infer(Node,Ct):-terminal_node(Node),repeat,nl,
			write("S:Enter Ct of ",Node," or type <w>hy "),nl,
			write("U:"),readln(Reply),
			reply_to_input(Node,Reply,Ct),!.
	infer(Node,Ct):-imp("s",Use,Node,S1,Node1,A,B,C),!,
			asserta(dbimp("s",Use,Node,S1,Node1,A,B,C),stack),
			asserta(tdbimp("s",Use,Node,S1,Node1,A,B,C),stack),
			allinfer(Node1,C1),
			find_multiplier(S1,M1,"dummy",0),
			C2=C1*M1,qualifier(Use,C2,Q),
			Ct=C2*C*Q,
			assertz(infer_summary(imp("s",Use,Node,S1,Node1,A,B,C),Ct)),
			retract(dbimp("s",Use,Node,S1,Node1,A,B,C),stack),
			retract(tdbimp("s",Use,Node,S1,Node1,A,B,C),stack).
	infer(Node,Ct):-imp("a",Use,Node,S1,Node1,S2,Node2,C),!,
			asserta(dbimp("a",Use,Node,S1,Node1,S2,Node2,C),stack),
			asserta(tdbimp("a",Use,Node,S1,Node1,S2,Node2,C),stack),
			allinfer(Node1,C1),allinfer(Node2,C2),
			find_multiplier(S1,M1,S2,M2),
			CC1=C1*M1,CC2=C2*M2,min(CC1,CC2,Min),
			qualifier(Use,Min,Q),
			Ct=C*Min*Q,
			assertz(infer_summary(imp("a",Use,Node,S1,Node1,S2,Node2,C),Ct)),
			retract(dbimp("a",Use,Node,S1,Node1,S2,Node2,C),stack),
			retract(tdbimp("a",Use,Node,S1,Node1,S2,Node2,C),stack).
	infer(Node,Ct):-imp("o",Use,Node,S1,Node1,S2,Node2,C),!,
			asserta(dbimp("o",Use,Node,S1,Node1,S2,Node2,C),stack),
			asserta(tdbimp("o",Use,Node,S1,Node1,S2,Node2,C),stack),	
			allinfer(Node1,C1),allinfer(Node2,C2),
			find_multiplier(S1,M1,S2,M2),
			CC1=C1*M1,CC2=C2*M2,max(CC1,CC2,Max),
			qualifier(Use,Max,Q),
			Ct=C*Max*Q,
			assertz(infer_summary(imp("o",Use,Node,S1,Node1,S2,Node2,C),Ct)),
			retract(dbimp("o",Use,Node,S1,Node1,S2,Node2,C),stack),
			retract(tdbimp("o",Use,Node,S1,Node1,S2,Node2,C),stack).
	
	reply_to_input(Node,Reply,Ct):-not(isname(Reply)),
				       str_real(Reply,Ct),
				       assertz(evidence(Node,Ct)),!.
	reply_to_input(_,Reply,_):-isname(Reply),Reply="w",nl,
				   dbimp(N,U,R,Sl,El,Sr,Er,V),
				   why_describer(N,U,R,Sl,El,Sr,Er,V),
				   retract(dbimp(N,U,R,Sl,El,Sr,Er,V)),
				   putadjustflag,!,fail.
				   
	why_describer(N,_,R,Sl,El,Sr,Er,V):-clearwindow,nl,
		   N<>"s",gettype(N,NN),getmode(Sl,Sll),getmode(Sr,Srr),
		   write("S:I am trying to use rule of the type "),
		   write(NN),nl,
		   write("  , to support the conclusion : ",R),nl,
		   write("  Primse 1 : ",El," of mode ",Sll),nl,
		   write("  Primse 2 : ",Er," of mode ",Srr),nl,
		   write("  The Certainty of implication is : ",V),nl,!.
		   
	why_describer(N,_,R,Sl,El,_,_,V):-clearwindow,nl,
		   gettype(N,NN),getmode(Sl,Sll),
		   write("S:I am trying to use rule of the type "),
		   write(NN),nl,
		   write("  , to support the conclusion : ",R),nl,
		   write("  Primse 1 : ",El," of mode ",Sll),nl,
		   write("  The Certainty of implication is : ",V),nl,!.	     
	
	gettype("s"," Simple Implication ").
	gettype("a"," And Implication ").
	gettype("o"," Or Implication ").
	
	getmode("pos"," as you see it ").
	getmode("neg"," prefaced by not ").
	
	repeat.
	repeat:-repeat.
	
	putadjustflag:-tdbimp(N,U,R,Sl,El,Sr,Er,V),!,
		       assertz(dbimp(N,U,R,Sl,El,Sr,Er,V),stack).
	putadjustflag.	       
	
	supercombine([Ct],Ct):-!.
	supercombine([C1,C2],Ct):-combine([C1,C2],Ct),!.
	supercombine([C1,C2|T],Ct):-combine([C1,C2],C3),
				    append([C3],T,T1),supercombine(T1,Ct).
	
	combine([Ct],Ct):-!.
	combine([-1,1],0):-!.
	combine([1,-1],0):-!.
	combine([C1,C2],Ct):-C1>=0,C2>=0,!,Ct=C1+C2-C1*C2.
	combine([C1,C2],Ct):-C1<0,C2<0,!,Ct=C1+C2+C1*C2.
	combine([C1,C2],Ct):-C1>=0,C2<0,absvalue(C1,C11),absvalue(C2,C22),
			     min(C11,C22,Min),Ct=(C1+C2)/(1-Min).
	combine([C1,C2],Ct):-C1<0,C2>=0,absvalue(C1,C11),absvalue(C2,C22),
			     min(C11,C22,Min),Ct=(C1+C2)/(1-Min).
	
	find_multiplier("pos",1,"dummy",0):-!.
	find_multiplier("neg",-1,"dummy",0):-!.
	find_multiplier("pos",1,"pos",1):-!.
	find_multiplier("neg",-1,"neg",-1):-!.			     
	find_multiplier("pos",1,"neg",-1):-!.
	find_multiplier("neg",-1,"pos",1):-!.
	
	qualifier(Use,_,Q):-Use="r",!,Q=1.
	qualifier(Use,C,Q):-Use="n",C>=0,!,Q=1.
	qualifier(Use,C,Q):-Use="n",C<0,!,Q=0.
	
	absvalue(X,Y):-X=0,Y=0,!.
	absvalue(X,Y):-X>0,Y=X,!.
	absvalue(X,Y):-X<0,Y=-X.
	
	min(X,Y,Z):-X>Y,!,Z=Y.
	min(X,_,X).
	
	max(X,Y,Z):-X>=Y,!,Z=X.
	max(_,X,X).
	
	append([],L,L):-!.
	append([H|T],L,[H|T1]):-append(T,L,T1).
	
	mem(H,[H|_]):-!.
	mem(H,[_|T]):-mem(H,T).
	
	perg:-retractall(imp(_,_,_,_,_,_,_,_)),
	      retractall(terminal_node(_)),
	      retractall(hypothesis_node(_)),
	      retractall(evidence(_,_)),
	      retractall(danswer(_,_)),
	      retractall(infer_summary(_,_)),!.
	perg.      	

goal
	start.	