/* 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(G,E,P):- append(G,E,GE), s(GE,PGE), s(E,PE), (PE\==0-> P is PGE/PE ; P=undefined ). s(GoalsList,Prob):- findall((State,Prob),node(_,_,State,empty,Prob),LL), sum_prob(LL,GoalsList,0,Prob). 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:- build([]). 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):- get_new_atom(Node), compute_three_valued(State,Clauses,HB,[],Unknowns), choose_clause(Clauses,State,Unknowns,RemainingClauses,Clause), (Clause=empty-> (RemainingClauses=[]-> assert(node(Node,Parent,State,empty,Prob)) ; format("Invalid program.~nInterpretation=~p.~nUnknowns atoms=~p.~nClauses=~p~n",[State,Unknowns,RemainingClauses]) ) ; Clause=r(Head,Body), assert(node(Node,Parent,State,r(Head,Body),Prob)), new_states(Node,Head,State,Prob,RemainingClauses,Unknowns) ). 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):- 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([],_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([],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(_,[],_,_,_,_):-!. 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):- 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(Node,Parent,State,Clause,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). 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). /* 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,'.uni',FileUni), reconsult(FileUni), atom_concat(File,'.cpl',FilePl), open(FilePl,read,S), read_clauses(S,C), close(S), 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([],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([],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([(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):- (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(end_of_file,[]). extract_vars_cl(Cl,VN,Couples):- (Cl=(H:-_B)-> true ; H=Cl ), extract_vars(H,[],V), pair(VN,V,Couples). pair(_VN,[],[]). pair([VN= _V|TVN],[V|TV],[VN=V|T]):- pair(TVN,TV,T). 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)). /* set(Par,Value) can be used to set the value of a parameter */ set(Parameter,Value):- retract(setting(Parameter,_)), assert(setting(Parameter,Value)). 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).