module for computing the semantics of CP-logic programs
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2011 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
rzf
parent
2ffffffed0
commit
d63e4aaaad
568
cplint/semcpl.pl
Normal file
568
cplint/semcpl.pl
Normal file
@ -0,0 +1,568 @@
|
||||
/*
|
||||
|
||||
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).
|
||||
Reference in New Issue
Block a user