/* Program for computing the probability of a query directly according to the semantics Copyright (c) 2007, Fabrizio Riguzzi */ :-module(semcpl,[p/1,s/2,sc/3,build/0,print/0,set/2]). :-use_module(library(lists)). :-dynamic setting/2. %:-set_prolog_flag(unknown,fail). setting(epsilon_parsing,0.00001). setting(ground_body,false). /* available values: true, false if true, both the head and the body of each clause will be grounded, otherwise only the head is grounded. In the case in which the body contains variables not appearing in the head, the body represents an existential event */ /* sc(Goal,Evidence,Probability) computes a conditional probability */ sc(G,E,P):- append(G,E,GE), s(GE,PGE), s(E,PE), (PE\==0-> P is PGE/PE ; P=undefined ). /* s(GoalsList,Prob) computes the probability of a query in the form of a list of literals */ s(GoalsList,Prob):- findall((State,Prob),node(empty,_,_,State,Prob),LL), sum_prob(LL,GoalsList,0,Prob). /* sum_prob(List,GoalsList,P0,P) List is a list of couples (State,Prob) where State is an interpretation and Prob is the associated probability. GoalsList is a list of goals. P0/P is an accumulator for the probability sum_prob computes the probability of GoalsList by summing the probability of every state where GoalsList is true */ sum_prob([],_GL,P,P):-!. sum_prob([(State,Prob)|T],GL,P0,P):- copy_term(GL,GLC), (body_true(GLC,State)-> P1 is P0+Prob ; P1 is P0 ), sum_prob(T,GL,P1,P). /* predicates for build the probabilistic process tree */ /* build builds the probabilistic process tree with an empty context */ build:- build([]). /* build(Context) builds the probabilistic process tree with context Context */ build(Context):- clauses(Cl), herbrand_base(HB), deleteall(HB,Context,HB1), get_new_atom(A), assert(root(A)), build(A,Context,1,Cl,HB1). /* build(Parent,State,Prob,Clauses,HB):- Given a parent node, its State, its probability, the list of ground clauses Clauses and the Herbrand Base HB, it builds the tree below Parent. The tree is stored in the database in the form of facts of the form node(Node,Parent,State,r(Head,Body),Prob). Parent is the parent of Node, State is the interpretation associated to Node, r(Head,Body) is the clause associated to Node and Prob is its Probability. The real root of the tree has a dummy parent P for which the fact root(P) is true that is used to access the tree */ build(Parent,State,Prob,Clauses,HB):- get_new_atom(Node), compute_three_valued(State,Clauses,HB,[],Unknowns), choose_clause(Clauses,State,Unknowns,RemainingClauses,Clause), (Clause=empty-> (RemainingClauses=[]-> assert(node(empty,Node,Parent,State,Prob)) ; format("Invalid program.~nInterpretation=~p.~nUnknowns atoms=~p.~nClauses=~p~n",[State,Unknowns,RemainingClauses]) ) ; Clause=r(Head,Body), assert(node(r(Head,Body),Node,Parent,State,Prob)), new_states(Node,Head,State,Prob,RemainingClauses,Unknowns) ). /* choose_clause(Clauses,Trues,Unknowns,RemainingClauses,Clause) selects a clause whose body is true in the three valued interpretation represented by Trues and Unknowns. The selected clause is returned in Clause and the remaining clauses in RemainingClauses. If no clause has the body true, it returns empty in Clause. */ choose_clause([],_True,_Unk,[],empty):-!. choose_clause([r(Head,Body)|T],True,Unk,RemCl,Clause):- copy_term(Body,BodyC), (body_true(BodyC,True,[],Unk)-> Clause=r(Head,Body), remove_false(T,True,Unk,RemCl) ; (body_false(BodyC,True,[],Unk)-> RemCl=RemCl0 ; RemCl=[r(Head,Body)|RemCl0] ), choose_clause(T,True,Unk,RemCl0,Clause) ). remove_false([],_True,_Unk,[]):-!. remove_false([r(Head,Body)|T],True,Unk,RemCl):- copy_term(Body,BodyC), (body_false(BodyC,True,[],Unk)-> RemCl=RemCl0 ; RemCl=[r(Head,Body)|RemCl0] ), remove_false(T,True,Unk,RemCl0). body_true([],_,_,_):-!. body_true([\+ H|T],True,False,Unk):- (\+ ground(H)-> format("Floundering ~n",[]) ; true ), \+ member(H,True),\+ member(H,Unk),!, body_true(T,True,False,Unk). body_true([H|T],True,False,Unk):- H \= (\+ _A), member(H,True), body_true(T,True,False,Unk). body_true([H|T],True,False,Unk):- builtin(H), call(H), body_true(T,True,False,Unk). body_true([],_):-!. body_true([\+ H|T],True):- \+ member(H,True),!, body_true(T,True). body_true([H|T],True):- member(H,True),!, body_true(T,True). body_undef([\+ H|T],True,False,Unk):- member(H,False),!, body_undef(T,True,False,Unk). body_undef([\+ H|T],True,False,Unk):- \+ member(H,True),\+ member(H,Unk),!, body_undef(T,True,False,Unk). body_undef([\+ H|T],True,False,Unk):- member(H,Unk),!, \+ body_false(T,True,False,Unk). body_undef([H|T],True,False,Unk):- member(H,True),!, body_undef(T,True,False,Unk). body_undef([H|T],True,False,Unk):- member(H,Unk),!, \+ body_false(T,True,False,Unk). /* compute_three_valued(State,Clauses,False,Unknowns0,Unknowns) computes the three valued interpretation associated with State */ compute_three_valued(State,Clauses,False,Unknowns0,Unknowns):- choose_clause_three_val(Clauses,State,False,Unknowns0,RemainingClauses,Clause), (Clause=empty-> Unknowns=Unknowns0 ; Clause=r(Head,_Body), new_int(Head,False,False1,Unknowns0,Unknowns1), compute_three_valued(State,RemainingClauses,False1,Unknowns1,Unknowns) ). /* choose_clause_three_val(Clauses,Trues,False,Unknowns,RemainingClauses,Clause) selects a clause whose body is not false in the three valued interpretation represented by Trues, False and Unknowns. The selected clause is returned in Clause and the remaining clauses in RemainingClauses. If no clause has the body true, it returns empty in Clause. */ choose_clause_three_val([],_True,_False,_Unk,_,empty):-!. choose_clause_three_val([r(Head,Body)|T],True,False,Unk,RemCl,Clause):- (\+ body_false(Body,True,False,Unk)-> Clause=r(Head,Body), RemCl=T ; RemCl=[r(Head,Body)|RemCl0], choose_clause_three_val(T,True,False,Unk,RemCl0,Clause) ). body_false([\+ H|_T],True,_False,_Unk):- (\+ ground(H)-> format("Floundering ~n",[]) ; true ), member(H,True),!. body_false([\+ H|T],True,False,Unk):- builtin(H), (call(H)-> true ; body_false(T,True,False,Unk) ). body_false([\+ _H|T],True,False,Unk):-!, body_false(T,True,False,Unk). body_false([H|T],True,False,Unk):- builtin(H), call(H),!, body_false(T,True,False,Unk). body_false([H|_T],_True,_False,_Unk):- builtin(H), \+ call(H),!. body_false([H|T],True,False,Unk):- findall(H,(member(H,True);member(H,Unk)),LH),!, body_false_list(LH,H,T,True,False,Unk). body_false_list([],_,_,_,_,_):-!. body_false_list([H|T],A,Body,True,False,Unk):- copy_term((A,Body),(AC,BodyC)), AC=H, body_false(BodyC,True,False,Unk), body_false_list(T,A,Body,True,False,Unk). /* new_int(Head,False0,False,Unk0,Unk) computes a new three valued interpretation from False0/Unk0 by moving the atoms in the head from False to Unk */ new_int([],False,False,Unk,Unk):-!. new_int([H:_P|T],False0,False,Unk0,Unk):- (member(H,False0)-> delete(False0,H,False1), append(Unk0,[H],Unk1) ; False1=False0, Unk1=Unk0 ), new_int(T,False1,False,Unk1,Unk). /* new_states(Node,Head,State,Prob,Clauses,HB) computest the tree below Node, where Head is the head of the clause associated to Node, Prob is the probability of Node, Clauses is the list of ground clauses yet to be associated to a node and HB is the Herbrand Base. */ new_states(_,[],_,_,_,_):-!. new_states(Node,[H:P|T],State,Prob,Clauses,HB):- Prob1 is P*Prob, (member(H,State)-> NewState=State ; append(State,[H],NewState) ), build(Node,NewState,Prob1,Clauses,HB), new_states(Node,T,State,Prob,Clauses,HB). /* get_new_atom(Atom) returns a new Atom of the form nNumber */ get_new_atom(Atom):- retract(new_number(N)), N1 is N+1, assert(new_number(N1)), number_atom(N,NA), atom_concat('n',NA,Atom). /* predicates for printing the probabilistic process tree */ print:- root(Root), print_children(Root,""). print_children(Parent,Tab):- findall((Node,State,Clause,Prob),node(Clause,Node,Parent,State,Prob),LC), print_list(LC,Tab). print_list([],_Tab):-!. print_list([(Node,State0,Clause,Prob)|T],Tab):- delete(State0,'',State), (Clause=empty-> % leaf format("~s~p ~f~n",[Tab,State,Prob]) ; format("~s~p ~p ~f~n",[Tab,State,Clause,Prob]), append(Tab,"| ",Tab1), print_children(Node,Tab1) ), print_list(T,Tab). /* predicate for parsing the program file */ p(File):- parse(File), build. parse(File):- retractall(root(_)), retractall(clauses(_)), retractall(herbrand_base(_)), retractall(node(_,_,_,_,_)), retractall(new_number(_)), assert(new_number(0)), atom_concat(File,'.cpl',FilePl), open(FilePl,read,S), read_clauses(S,C), close(S), atom_concat(File,'.uni',FileUni), reconsult(FileUni), process_clauses(C,ClausesVar), instantiate(ClausesVar,[],Clauses), assert(clauses(Clauses)), build_herbrand_base(HB), assert(herbrand_base(HB)). build_herbrand_base(HB):- findall(A,mode(A),LA), inst_list(LA,[],HB). /* inst_list(Atoms,HB0,HB) enlarges the Herbrand Base by instantiating the atoms in Atoms */ inst_list([],HB,HB):-!. inst_list([H|T],HB0,HB):- functor(H,F,Args), functor(A,F,Args), findall(A,instantiate_atom_modes(A),LA), append(HB0,LA,HB1), inst_list(T,HB1,HB). /* instantiate(Clauses,C0,C) returns in C the set of clauses obtained by grounding Clauses */ instantiate([],C,C). instantiate([r(_V,H,B)|T],CIn,COut):- findall(r(H,BOut),instantiate_clause_modes(H,B,BOut),L), append(CIn,L,C1), instantiate(T,C1,COut). instantiate_clause_modes(H,B,BOut):- instantiate_head_modes(H), instantiate_body_modes(B,BOut). instantiate_head_modes([]):-!. instantiate_head_modes([H:_P|T]):- instantiate_atom_modes(H), instantiate_head_modes(T). instantiate_body_modes(BL,BL):- setting(ground_body,false),!. instantiate_body_modes(BL0,BL):- instantiate_list_modes(BL0,BL). instantiate_list_modes([],[]). instantiate_list_modes([H|T0],T):- builtin(H),!, call(H), instantiate_list_modes(T0,T). instantiate_list_modes([\+ H|T0],T):- builtin(H),!, \+ call(H), instantiate_list_modes(T0,T). instantiate_list_modes([\+ H|T0],[\+ H|T]):-!, instantiate_atom_modes(H), instantiate_list_modes(T0,T). instantiate_list_modes([H|T0],[H|T]):- instantiate_atom_modes(H), instantiate_list_modes(T0,T). instantiate_atom_modes(''):-!. instantiate_atom_modes(A):- functor(A,F,NArgs), functor(TA,F,NArgs), A=..[F|Args], mode(TA), TA=..[F|Types], instantiate_args_modes(Args,Types). instantiate_args_modes([],[]):-!. instantiate_args_modes([H|T],[TH|TT]):- type(TH,Constants), member(H,Constants), instantiate_args_modes(T,TT). /* process_clauses(Terms,Clauses) processes Terms to produce Clauses Terms is a list contatining elements of the form ((H:-B),V) Clauses is a list containing elements of the form r(V,HL,BL) where HL is the list of disjuncts in H and BL is the list of literals in B */ process_clauses([(end_of_file,[])],[]). process_clauses([((H:-B),V)|T],[r(V,HL,BL)|T1]):- H=(_;_),!, list2or(HL1,H), list2and(BL,B), process_head(HL1,0,HL), process_clauses(T,T1). process_clauses([((H:-B),V)|T],[r(V,HL,BL)|T1]):- H=(_:_),!, list2or(HL1,H), process_head(HL1,0,HL), list2and(BL,B), process_clauses(T,T1). process_clauses([((H:-B),V)|T],[r(V,[H:1],BL)|T1]):-!, list2and(BL,B), process_clauses(T,T1). process_clauses([(H,V)|T],[r(V,HL,[])|T1]):- H=(_;_),!, list2or(HL1,H), process_head(HL1,0,HL), process_clauses(T,T1). process_clauses([(H,V)|T],[r(V,HL,[])|T1]):- H=(_:_),!, list2or(HL1,H), process_head(HL1,0,HL), process_clauses(T,T1). process_clauses([(H,V)|T],[r(V,[H:1],[])|T1]):- process_clauses(T,T1). process_head([H:PH],P,[H:PH1|Null]):- PH1 is PH, PNull is 1-P-PH1, setting(epsilon_parsing,Eps), EpsNeg is - Eps, PNull > EpsNeg, (PNull>Eps-> Null=['':PNull] ; Null=[] ). process_head([H:PH|T],P,[H:PH1|NT]):- PH1 is PH, P1 is P+PH1, process_head(T,P1,NT). /* read_clauses(S,Clauses) read Clauses from stream S */ read_clauses(S,Clauses):- (setting(ground_body,true)-> read_clauses_ground_body(S,Clauses) ; read_clauses_exist_body(S,Clauses) ). read_clauses_ground_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(V)]), (Cl=end_of_file-> Out=[] ; read_clauses_ground_body(S,Out) ). read_clauses_exist_body(S,[(Cl,V)|Out]):- read_term(S,Cl,[variable_names(VN)]), extract_vars_cl(Cl,VN,V), (Cl=end_of_file-> Out=[] ; read_clauses_exist_body(S,Out) ). /* extract_vars_cl(Clause,VariableNames,Couples) extract from Clause couples of the form VariableName=Variable */ extract_vars_cl(end_of_file,[]). extract_vars_cl(Cl,VN,Couples):- (Cl=(H:-_B)-> true ; H=Cl ), extract_vars(H,[],V), pair(VN,V,Couples). extract_vars(Var,V0,V):- var(Var),!, (member_eq(Var,V0)-> V=V0 ; append(V0,[Var],V) ). extract_vars(Term,V0,V):- Term=..[_F|Args], extract_vars_list(Args,V0,V). extract_vars_list([],V,V). extract_vars_list([Term|T],V0,V):- extract_vars(Term,V0,V1), extract_vars_list(T,V1,V). pair(_VN,[],[]). pair([VN= _V|TVN],[V|TV],[VN=V|T]):- pair(TVN,TV,T). /* auxiliary predicates */ list2or([X],X):- X\=;(_,_),!. list2or([H|T],(H ; Ta)):-!, list2or(T,Ta). list2and([],true):-!. list2and([X],X):- X\=(_,_),!. list2and([H|T],(H,Ta)):-!, list2and(T,Ta). builtin(_A is _B). builtin(_A > _B). builtin(_A < _B). builtin(_A >= _B). builtin(_A =< _B). builtin(_A =:= _B). builtin(_A =\= _B). builtin(true). builtin(false). builtin(_A = _B). builtin(_A==_B). builtin(_A\=_B). builtin(_A\==_B). bg(member(_El,_L)). bg(average(_L,_Av)). bg(max_list(_L,_Max)). bg(min_list(_L,_Max)). average(L,Av):- sum_list(L,Sum), length(L,N), Av is Sum/N. assert_all([]):-!. assert_all([(:- G)|T]):-!, call(G), assert_all(T). assert_all([H|T]):-!, assertz((H)), assert_all(T). assert_all(C):- assertz((C)). deleteall(L,[],L). deleteall(L,[H|T],LOut):- delete(L,H,L1), deleteall(L1,T,LOut). member_eq(A,[H|_T]):- A==H. member_eq(A,[_H|T]):- member_eq(A,T). /* set(Par,Value) can be used to set the value of a parameter */ set(Parameter,Value):- retract(setting(Parameter,_)), assert(setting(Parameter,Value)).