diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added comments to the semantic modules

Browse Source 
added test files for semlpadsld.pl and semlpad.pl


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2032 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
rzf 2007-12-04 18:30:35 +00:00
parent 1bd96722de
commit 523a101b15
12 changed files with 254 additions and 169 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
cplint/Makefile.in
View File

@ -68,6 +68,8 @@ CPLINT_TEST_PROGRAMS= \
$(CPLINT_SRCDIR)/testlpadsld_gbfalse.pl \ $(CPLINT_SRCDIR)/testlpadsld_gbfalse.pl \
$(CPLINT_SRCDIR)/testlpad.pl \ $(CPLINT_SRCDIR)/testlpad.pl \
$(CPLINT_SRCDIR)/testcpl.pl \ $(CPLINT_SRCDIR)/testcpl.pl \
$(CPLINT_SRCDIR)/testsemlpadsld.pl \
$(CPLINT_SRCDIR)/testsemlpad.pl \
$(CPLINT_SRCDIR)/testsemcpl.pl $(CPLINT_SRCDIR)/testsemcpl.pl
CPLINT_EXAMPLES= \ CPLINT_EXAMPLES= \

3
cplint/doc/manual.tex
View File

@ -372,7 +372,8 @@ The first clause states that, if the topic of a paper \texttt{X} is theory and
\section{Additional Files} \section{Additional Files}
In the directory where Yap keeps the library files (usually \texttt{/usr/local/share/ Yap}) you can find the directory \texttt{cplint} that contains the files: In the directory where Yap keeps the library files (usually \texttt{/usr/local/share/ Yap}) you can find the directory \texttt{cplint} that contains the files:
\begin{itemize} \begin{itemize}
\item \verb|testlpadsld_gbtrue.pl, testlpadsld_gbfalse.pl, testlpad.pl,| \verb|testcpl.pl, testsemcpl.pl|: Prolog programs for testing the modules. They are executed when issuing the command \texttt{make installcheck} during the installation. To execute them afterwords, load the file and issue the command \texttt{t.} \item \verb|testlpadsld_gbtrue.pl, testlpadsld_gbfalse.pl, testlpad.pl,|
\verb|testcpl.pl, testsemlpadsld.pl, testsemlpad.pl testsemcpl.pl|: Prolog programs for testing the modules. They are executed when issuing the command \texttt{make installcheck} during the installation. To execute them afterwords, load the file and issue the command \texttt{t.}
\item Subdirectory \texttt{examples}: \item Subdirectory \texttt{examples}:
\begin{itemize} \begin{itemize}
\item \texttt{alarm.cpl}: representation of the Bayesian network in Figure 2 of \item \texttt{alarm.cpl}: representation of the Bayesian network in Figure 2 of

146
cplint/semcpl.pl
View File

@ -21,7 +21,9 @@ 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 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 */ not appearing in the head, the body represents an existential event */
/* sc(Goal,Evidence,Probability)
computes a conditional probability
*/
sc(G,E,P):- sc(G,E,P):-
append(G,E,GE), append(G,E,GE),
s(GE,PGE), s(GE,PGE),
@ -31,11 +33,21 @@ sc(G,E,P):-
; ;
P=undefined P=undefined
). ).
/* s(GoalsList,Prob)
computes the probability of a query in the form of a list of literals
*/
s(GoalsList,Prob):- s(GoalsList,Prob):-
findall((State,Prob),node(_,_,State,empty,Prob),LL), findall((State,Prob),node(empty,_,_,State,Prob),LL),
sum_prob(LL,GoalsList,0,Prob). 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([],_GL,P,P):-!.
sum_prob([(State,Prob)|T],GL,P0,P):- sum_prob([(State,Prob)|T],GL,P0,P):-
@ -48,9 +60,15 @@ sum_prob([(State,Prob)|T],GL,P0,P):-
sum_prob(T,GL,P1,P). sum_prob(T,GL,P1,P).
/* predicates for build the probabilistic process tree */ /* predicates for build the probabilistic process tree */
/* build
builds the probabilistic process tree with an empty context
*/
build:- build:-
build([]). build([]).
/* build(Context)
builds the probabilistic process tree with context Context
*/
build(Context):- build(Context):-
clauses(Cl), clauses(Cl),
herbrand_base(HB), herbrand_base(HB),
@ -59,22 +77,37 @@ build(Context):-
assert(root(A)), assert(root(A)),
build(A,Context,1,Cl,HB1). 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):- build(Parent,State,Prob,Clauses,HB):-
get_new_atom(Node), get_new_atom(Node),
compute_three_valued(State,Clauses,HB,[],Unknowns), compute_three_valued(State,Clauses,HB,[],Unknowns),
choose_clause(Clauses,State,Unknowns,RemainingClauses,Clause), choose_clause(Clauses,State,Unknowns,RemainingClauses,Clause),
(Clause=empty-> (Clause=empty->
(RemainingClauses=[]-> (RemainingClauses=[]->
assert(node(Node,Parent,State,empty,Prob)) assert(node(empty,Node,Parent,State,Prob))
; ;
format("Invalid program.~nInterpretation=~p.~nUnknowns atoms=~p.~nClauses=~p~n",[State,Unknowns,RemainingClauses]) format("Invalid program.~nInterpretation=~p.~nUnknowns atoms=~p.~nClauses=~p~n",[State,Unknowns,RemainingClauses])
) )
; ;
Clause=r(Head,Body), Clause=r(Head,Body),
assert(node(Node,Parent,State,r(Head,Body),Prob)), assert(node(r(Head,Body),Node,Parent,State,Prob)),
new_states(Node,Head,State,Prob,RemainingClauses,Unknowns) 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([],_True,_Unk,[],empty):-!.
choose_clause([r(Head,Body)|T],True,Unk,RemCl,Clause):- choose_clause([r(Head,Body)|T],True,Unk,RemCl,Clause):-
@ -155,7 +188,9 @@ body_undef([H|T],True,False,Unk):-
member(H,Unk),!, member(H,Unk),!,
\+ body_false(T,True,False,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):- compute_three_valued(State,Clauses,False,Unknowns0,Unknowns):-
choose_clause_three_val(Clauses,State,False,Unknowns0,RemainingClauses,Clause), choose_clause_three_val(Clauses,State,False,Unknowns0,RemainingClauses,Clause),
(Clause=empty-> (Clause=empty->
@ -165,7 +200,12 @@ compute_three_valued(State,Clauses,False,Unknowns0,Unknowns):-
new_int(Head,False,False1,Unknowns0,Unknowns1), new_int(Head,False,False1,Unknowns0,Unknowns1),
compute_three_valued(State,RemainingClauses,False1,Unknowns1,Unknowns) 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([],_True,_False,_Unk,_,empty):-!.
choose_clause_three_val([r(Head,Body)|T],True,False,Unk,RemCl,Clause):- choose_clause_three_val([r(Head,Body)|T],True,False,Unk,RemCl,Clause):-
@ -219,7 +259,10 @@ body_false_list([H|T],A,Body,True,False,Unk):-
body_false_list(T,A,Body,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([],False,False,Unk,Unk):-!.
new_int([H:_P|T],False0,False,Unk0,Unk):- new_int([H:_P|T],False0,False,Unk0,Unk):-
@ -234,7 +277,11 @@ new_int([H:_P|T],False0,False,Unk0,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(_,[],_,_,_,_):-!.
@ -248,6 +295,9 @@ new_states(Node,[H:P|T],State,Prob,Clauses,HB):-
build(Node,NewState,Prob1,Clauses,HB), build(Node,NewState,Prob1,Clauses,HB),
new_states(Node,T,State,Prob,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):- get_new_atom(Atom):-
retract(new_number(N)), retract(new_number(N)),
N1 is N+1, N1 is N+1,
@ -261,7 +311,7 @@ print:-
print_children(Root,""). print_children(Root,"").
print_children(Parent,Tab):- print_children(Parent,Tab):-
findall((Node,State,Clause,Prob),node(Node,Parent,State,Clause,Prob),LC), findall((Node,State,Clause,Prob),node(Clause,Node,Parent,State,Prob),LC),
print_list(LC,Tab). print_list(LC,Tab).
print_list([],_Tab):-!. print_list([],_Tab):-!.
@ -279,23 +329,6 @@ print_list([(Node,State0,Clause,Prob)|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 */ /* predicate for parsing the program file */
p(File):- p(File):-
@ -309,12 +342,12 @@ parse(File):-
retractall(node(_,_,_,_,_)), retractall(node(_,_,_,_,_)),
retractall(new_number(_)), retractall(new_number(_)),
assert(new_number(0)), assert(new_number(0)),
atom_concat(File,'.uni',FileUni),
reconsult(FileUni),
atom_concat(File,'.cpl',FilePl), atom_concat(File,'.cpl',FilePl),
open(FilePl,read,S), open(FilePl,read,S),
read_clauses(S,C), read_clauses(S,C),
close(S), close(S),
atom_concat(File,'.uni',FileUni),
reconsult(FileUni),
process_clauses(C,ClausesVar), process_clauses(C,ClausesVar),
instantiate(ClausesVar,[],Clauses), instantiate(ClausesVar,[],Clauses),
assert(clauses(Clauses)), assert(clauses(Clauses)),
@ -326,7 +359,9 @@ build_herbrand_base(HB):-
findall(A,mode(A),LA), findall(A,mode(A),LA),
inst_list(LA,[],HB). 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([],HB,HB):-!.
inst_list([H|T],HB0,HB):- inst_list([H|T],HB0,HB):-
@ -336,7 +371,9 @@ inst_list([H|T],HB0,HB):-
append(HB0,LA,HB1), append(HB0,LA,HB1),
inst_list(T,HB1,HB). inst_list(T,HB1,HB).
/* instantiate(Clauses,C0,C)
returns in C the set of clauses obtained by grounding Clauses
*/
instantiate([],C,C). instantiate([],C,C).
instantiate([r(_V,H,B)|T],CIn,COut):- instantiate([r(_V,H,B)|T],CIn,COut):-
@ -404,7 +441,15 @@ instantiate_args_modes([H|T],[TH|TT]):-
instantiate_args_modes(T,TT). 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([(end_of_file,[])],[]).
process_clauses([((H:-B),V)|T],[r(V,HL,BL)|T1]):- process_clauses([((H:-B),V)|T],[r(V,HL,BL)|T1]):-
@ -457,6 +502,9 @@ process_head([H:PH|T],P,[H:PH1|NT]):-
P1 is P+PH1, P1 is P+PH1,
process_head(T,P1,NT). process_head(T,P1,NT).
/* read_clauses(S,Clauses)
read Clauses from stream S
*/
read_clauses(S,Clauses):- read_clauses(S,Clauses):-
(setting(ground_body,true)-> (setting(ground_body,true)->
read_clauses_ground_body(S,Clauses) read_clauses_ground_body(S,Clauses)
@ -482,6 +530,9 @@ read_clauses_exist_body(S,[(Cl,V)|Out]):-
read_clauses_exist_body(S,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(end_of_file,[]).
extract_vars_cl(Cl,VN,Couples):- extract_vars_cl(Cl,VN,Couples):-
@ -493,12 +544,30 @@ extract_vars_cl(Cl,VN,Couples):-
extract_vars(H,[],V), extract_vars(H,[],V),
pair(VN,V,Couples). 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,[],[]).
pair([VN= _V|TVN],[V|TV],[VN=V|T]):- pair([VN= _V|TVN],[V|TV],[VN=V|T]):-
pair(TVN,TV,T). pair(TVN,TV,T).
/* auxiliary predicates */
list2or([X],X):- list2or([X],X):-
X\=;(_,_),!. X\=;(_,_),!.
@ -550,10 +619,6 @@ assert_all([H|T]):-!,
assert_all(C):- assert_all(C):-
assertz((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,[],L).
@ -566,3 +631,8 @@ member_eq(A,[H|_T]):-
member_eq(A,[_H|T]):- member_eq(A,[_H|T]):-
member_eq(A,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)).

91
cplint/semlpad.pl
View File

@ -30,14 +30,21 @@ if set to variables, the universe facts from the .uni file are used
if set to modes, the mode and type declaration from the .uni file are used if set to modes, the mode and type declaration from the .uni file are used
*/ */
new_number(0). setting(verbose,false).
new_number(0).
/* sc(Goal,Evidence,Probability)
computes a conditional probability
*/
sc(Goals,Evidence,Prob):- sc(Goals,Evidence,Prob):-
s(Evidence,ProbE), s(Evidence,ProbE),
append(Goals,Evidence,GE), append(Goals,Evidence,GE),
s(GE,ProbGE), s(GE,ProbGE),
Prob is ProbGE/ProbE. Prob is ProbGE/ProbE.
/* s(GoalsList,Prob)
computes the probability of a query in the form of a list of literals
*/
s(GoalsList,Prob):- s(GoalsList,Prob):-
program_names(L), program_names(L),
convert_to_goal(GoalsList,Goal,L), convert_to_goal(GoalsList,Goal,L),
@ -87,20 +94,44 @@ assert_in_all_prog(LC,Prog,[PrH|PrT]):-
/* predicate for parsing the program file */ /* predicate for parsing the program file */
p(File):- p(File):-
atom_concat(File,'.uni',FileUni), clean_db,
consult(FileUni),
atom_concat(File,'.cpl',FilePl), atom_concat(File,'.cpl',FilePl),
open(FilePl,read,S), open(FilePl,read,S),
read_clauses(S,C), read_clauses(S,C),
close(S), close(S),
atom_concat(File,'.uni',FileUni),
reconsult(FileUni),
process_clauses(C,ClausesVar), process_clauses(C,ClausesVar),
instantiate(ClausesVar,[],Clauses), instantiate(ClausesVar,[],Clauses),
assert(program(1)), assert(program(1)),
assert(program_names([])), assert(program_names([])),
create_programs(Clauses). create_programs(Clauses).
clean_db:-
findall((P/A),(mode(Atom),functor(Atom,P,A0),A is A0+1),L),
findall((P/A),(mode(Atom),functor(Atom,P0,A0),A is A0+2,
name(P0,Pl),
name(P,[115,108,103,36|Pl]) % 'slg$'
),Lslg),
abolish_all(L),
abolish_all(Lslg),
abolish(program/1),
abolish(program_names/1),
abolish(prob/2).
abolish_all([]).
abolish_all([(P/A)|T]):-
abolish(P/A),
abolish_all(T).
/* create_programs(Clauses)
create the instances of the ground LPAD composed by Clauses
Each instance is identified by an atom of the form P<Number> where <Number> is an
increasing number. An extra argument is added to each atom in the clauses to represent
the identifier of the instance.
*/
create_programs(Clauses):- create_programs(Clauses):-
create_single_program(Clauses,1,Program), create_single_program(Clauses,1,Program),
retract(program(N)), retract(program(N)),
@ -109,7 +140,11 @@ create_programs(Clauses):-
atom_concat(p,NA,Name), atom_concat(p,NA,Name),
N1 is N+1, N1 is N+1,
assert(program(N1)), assert(program(N1)),
format("Writing instance ~d~n",[N]), (setting(verbose,true)->
format("Writing instance ~d~n",[N])
;
true
),
write_program(Name,Program), write_program(Name,Program),
retract(program_names(L)), retract(program_names(L)),
append(L,[Name],L1), append(L,[Name],L1),
@ -130,6 +165,9 @@ write_program(Name,[(H:-B)|T]):-
assert_all(LC), assert_all(LC),
write_program(Name,T). write_program(Name,T).
/* elab_conj(Name,Conj0,Conj)
adds the extra argument Name to the conjunction Conj0 resulting in Conj
*/
elab_conj(_Name,true,true):-!. elab_conj(_Name,true,true):-!.
elab_conj(Name,\+(B),\+(B1)):-!, elab_conj(Name,\+(B),\+(B1)):-!,
@ -174,6 +212,10 @@ create_single_program([r(H,B)|T],PIn,[(HA:-B)|T1]):-
create_single_program(T,P1,T1). create_single_program(T,P1,T1).
/* predicates for producing the ground instances of program clauses */ /* predicates for producing the ground instances of program clauses */
/* instantiate(Clauses,C0,C)
returns in C the set of clauses obtained by grounding Clauses
*/
instantiate([],C,C). instantiate([],C,C).
instantiate([r(_V,[H:1],B)|T],CIn,COut):-!, instantiate([r(_V,[H:1],B)|T],CIn,COut):-!,
@ -274,7 +316,9 @@ instantiate_clause_variables([VarName=_Var|T],H,BIn,BOut):-
varName_present_variables(VarName):- varName_present_variables(VarName):-
universe(VarNames,_U), member(VarName,VarNames). universe(VarNames,_U), member(VarName,VarNames).
/* check_body(Body0,Body)
removes the true builtin literals from Body0. Fails if there is a false builtin literal.
*/
check_body([],[]). check_body([],[]).
check_body([H|T],TOut):- check_body([H|T],TOut):-
@ -286,6 +330,16 @@ check_body([H|T],[H|TOut]):-
check_body(T,TOut). check_body(T,TOut).
/* predicates for processing the clauses read from the file */
/* 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([(end_of_file,[])],[]).
process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):- process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):-
@ -336,6 +390,9 @@ process_head([H:PH|T],P,[H:PH1|NT]):-
process_head(T,P1,NT). process_head(T,P1,NT).
/* predicates for reading in the program clauses */ /* predicates for reading in the program clauses */
/* read_clauses(S,Clauses)
read Clauses from stream S
*/
read_clauses(S,Clauses):- read_clauses(S,Clauses):-
(setting(ground_body,true)-> (setting(ground_body,true)->
read_clauses_ground_body(S,Clauses) read_clauses_ground_body(S,Clauses)
@ -363,6 +420,9 @@ read_clauses_exist_body(S,[(Cl,V)|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(end_of_file,[]).
extract_vars_cl(Cl,VN,Couples):- extract_vars_cl(Cl,VN,Couples):-
@ -400,11 +460,6 @@ extract_vars_list([Term|T],V0,V):-
extract_vars(Term,V0,V1), extract_vars(Term,V0,V1),
extract_vars_list(T,V1,V). extract_vars_list(T,V1,V).
member_eq(A,[H|_T]):-
A==H,!.
member_eq(A,[_H|T]):-
member_eq(A,T).
/* auxiliary predicates */ /* auxiliary predicates */
list2or([X],X):- list2or([X],X):-
@ -449,12 +504,6 @@ average(L,Av):-
length(L,N), length(L,N),
Av is Sum/N. Av is Sum/N.
/* set(Par,Value) can be used to set the value of a parameter */
set(Parameter,Value):-
retract(setting(Parameter,_)),
assert(setting(Parameter,Value)).
assert_all([]):-!. assert_all([]):-!.
assert_all([(:- G)|T]):-!, assert_all([(:- G)|T]):-!,
@ -468,3 +517,13 @@ assert_all([H|T]):-!,
assert_all(C):- assert_all(C):-
assertz((C)). assertz((C)).
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)).

60
cplint/semlpadsld.pl
View File

@ -25,6 +25,9 @@ if set to variables, the universe facts from the .uni file are used
if set to modes, the mode and type declaration from the .uni file are used if set to modes, the mode and type declaration from the .uni file are used
*/ */
setting(verbose,false).
sc(Goals,Evidence,Prob):- sc(Goals,Evidence,Prob):-
s(Evidence,ProbE), s(Evidence,ProbE),
append(Goals,Evidence,GE), append(Goals,Evidence,GE),
@ -52,18 +55,38 @@ run_query([Prog|T],Goal,PIn,POut):-
/* predicate for parsing the program file */ /* predicate for parsing the program file */
p(File):- p(File):-
atom_concat(File,'.uni',FileUni), clean_db,
reconsult(FileUni),
atom_concat(File,'.cpl',FilePl), atom_concat(File,'.cpl',FilePl),
open(FilePl,read,S), open(FilePl,read,S),
read_clauses(S,C), read_clauses(S,C),
close(S), close(S),
atom_concat(File,'.uni',FileUni),
reconsult(FileUni),
process_clauses(C,ClausesVar), process_clauses(C,ClausesVar),
instantiate(ClausesVar,[],Clauses), instantiate(ClausesVar,[],Clauses),
assert(program(1)), assert(program(1)),
assert(program_names([])), assert(program_names([])),
create_programs(Clauses). create_programs(Clauses).
clean_db:-
findall((P/A),(mode(Atom),functor(Atom,P,A0),A is A0+1),L),
abolish_all(L),
abolish(program/1),
abolish(program_names/1),
abolish(prob/2).
abolish_all([]).
abolish_all([(P/A)|T]):-
abolish(P/A),
abolish_all(T).
/* create_programs(Clauses)
create the instances of the ground LPAD composed by Clauses
Each instance is identified by an atom of the form P<Number> where <Number> is an
increasing number. An extra argument is added to each atom in the clauses to represent
the identifier of the instance.
*/
create_programs(Clauses):- create_programs(Clauses):-
create_single_program(Clauses,1,Program), create_single_program(Clauses,1,Program),
retract(program(N)), retract(program(N)),
@ -72,7 +95,11 @@ create_programs(Clauses):-
atom_concat(p,NA,Name), atom_concat(p,NA,Name),
N1 is N+1, N1 is N+1,
assert(program(N1)), assert(program(N1)),
format("Writing instance ~d~n",[N]), (setting(verbose,true)->
format("Writing instance ~d~n",[N])
;
true
),
write_program(Name,Program), write_program(Name,Program),
retract(program_names(L)), retract(program_names(L)),
append(L,[Name],L1), append(L,[Name],L1),
@ -90,6 +117,9 @@ write_program(Name,[(H:-B)|T]):-
assertz((H1:-B1)), assertz((H1:-B1)),
write_program(Name,T). write_program(Name,T).
/* elab_conj(Name,Conj0,Conj)
adds the extra argument Name to the conjunction Conj0 resulting in Conj
*/
elab_conj(_Name,true,true):-!. elab_conj(_Name,true,true):-!.
elab_conj(Name,\+(B),\+(B1)):-!, elab_conj(Name,\+(B),\+(B1)):-!,
@ -134,6 +164,10 @@ create_single_program([r(H,B)|T],PIn,[(HA:-B)|T1]):-
create_single_program(T,P1,T1). create_single_program(T,P1,T1).
/* predicates for producing the ground instances of program clauses */ /* predicates for producing the ground instances of program clauses */
/* instantiate(Clauses,C0,C)
returns in C the set of clauses obtained by grounding Clauses
*/
instantiate([],C,C). instantiate([],C,C).
instantiate([r(_V,[H:1],B)|T],CIn,COut):-!, instantiate([r(_V,[H:1],B)|T],CIn,COut):-!,
@ -234,7 +268,9 @@ instantiate_clause_variables([VarName=_Var|T],H,BIn,BOut):-
varName_present_variables(VarName):- varName_present_variables(VarName):-
universe(VarNames,_U), member(VarName,VarNames). universe(VarNames,_U), member(VarName,VarNames).
/* check_body(Body0,Body)
removes the true builtin literals from Body0. Fails if there is a false builtin literal.
*/
check_body([],[]). check_body([],[]).
check_body([H|T],TOut):- check_body([H|T],TOut):-
@ -247,6 +283,15 @@ check_body([H|T],[H|TOut]):-
/* predicates for processing the clauses read from the file */ /* predicates for processing the clauses read from the file */
/* 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([(end_of_file,[])],[]).
process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):- process_clauses([((H:-B),V)|T],[r(V,HL,B)|T1]):-
@ -298,6 +343,9 @@ process_head([H:PH|T],P,[H:PH1|NT]):-
/* predicates for reading in the program clauses */ /* predicates for reading in the program clauses */
/* read_clauses(S,Clauses)
read Clauses from stream S
*/
read_clauses(S,Clauses):- read_clauses(S,Clauses):-
(setting(ground_body,true)-> (setting(ground_body,true)->
read_clauses_ground_body(S,Clauses) read_clauses_ground_body(S,Clauses)
@ -325,6 +373,9 @@ read_clauses_exist_body(S,[(Cl,V)|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(end_of_file,[]).
extract_vars_cl(Cl,VN,Couples):- extract_vars_cl(Cl,VN,Couples):-
@ -415,4 +466,3 @@ average(L,Av):-
set(Parameter,Value):- set(Parameter,Value):-
retract(setting(Parameter,_)), retract(setting(Parameter,_)),
assert(setting(Parameter,Value)). assert(setting(Parameter,Value)).

2
cplint/testcpl.pl
View File

@ -32,7 +32,7 @@ t:-
format("Test successful, time ~f secs.~n",[T1]). format("Test successful, time ~f secs.~n",[T1]).
t:- t:-
format("Test unsuccessful.",[]). format("Test unsuccessful.~n",[]).
test_files([],_GB). test_files([],_GB).

2
cplint/testlpad.pl
View File

@ -32,7 +32,7 @@ t:-
format("Test successful, time ~f secs.~n",[T1]). format("Test successful, time ~f secs.~n",[T1]).
t:- t:-
format("Test unsuccessful.",[]). format("Test unsuccessful.~n",[]).
test_files([],_GB). test_files([],_GB).

2
cplint/testlpadsld_gbfalse.pl
View File

@ -35,7 +35,7 @@ t:-
format("Test successful, time ~f secs.~n",[T1]). format("Test successful, time ~f secs.~n",[T1]).
t:- t:-
format("Test unsuccessful.",[]). format("Test unsuccessful.~n",[]).
test_files([],_GB). test_files([],_GB).

2
cplint/testlpadsld_gbtrue.pl
View File

@ -34,7 +34,7 @@ t:-
format("Test successful, time ~f secs.~n",[T1]). format("Test successful, time ~f secs.~n",[T1]).
t:- t:-
format("Test unsuccessful.",[]). format("Test unsuccessful.~n",[]).
test_files([],_GB). test_files([],_GB).

16
cplint/testsemcpl.pl
View File

@ -37,7 +37,7 @@ t:-
format("Test successful, time ~f secs.~n",[T1]). format("Test successful, time ~f secs.~n",[T1]).
t:- t:-
format("Test unsuccessful.",[]). format("Test unsuccessful.~n",[]).
test_files([],_GB). test_files([],_GB).
@ -62,8 +62,8 @@ test_all(F,[H|T]):-
files([ files([
esapprox,esrange,threesideddice,mendels, exapprox,exrange,threesideddice,mendels,
coin2,es,throws,trigger,win,hiv,light, coin2,ex,throws,trigger,win,hiv,light,
invalid]). invalid]).
test((s([p],P),close_to(P,0)),invalid,_). test((s([p],P),close_to(P,0)),invalid,_).
@ -96,12 +96,12 @@ test((s([light],P),close_to(P,0.5)),light,_).
test((s([replace],P),close_to(P,0.5)),light,_). test((s([replace],P),close_to(P,0.5)),light,_).
test((s([a],P),close_to(P,0.1719)),esapprox,ground_body(true)). test((s([a],P),close_to(P,0.1719)),exapprox,ground_body(true)).
test((s([a],P),close_to(P,0.099)),esapprox,ground_body(false)). test((s([a],P),close_to(P,0.099)),exapprox,ground_body(false)).
test((s([a(1)],P),close_to(P,0.2775)),esrange,_). test((s([a(1)],P),close_to(P,0.2775)),exrange,_).
test((s([a(2)],P),close_to(P,0.36)),esrange,_). test((s([a(2)],P),close_to(P,0.36)),exrange,_).
test((s([on(0,1)],P),close_to(P,0.333333333333333)),threesideddice,_). test((s([on(0,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_). test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
@ -123,5 +123,5 @@ test((s([heads(coin2)],P),close_to(P,0.51)),coin2,_).
test((s([tails(coin1)],P),close_to(P,0.49)),coin2,_). test((s([tails(coin1)],P),close_to(P,0.49)),coin2,_).
test((s([tails(coin2)],P),close_to(P,0.49)),coin2,_). test((s([tails(coin2)],P),close_to(P,0.49)),coin2,_).
test((s([a],P),close_to(P,0.226)),es,_). test((s([a],P),close_to(P,0.226)),ex,_).

46
cplint/testsemlpad.txt
View File

@ -1,46 +0,0 @@
/*
LPAD and CP-Logic reasoning suite
Copyright (c) 2007, Fabrizio Riguzzi
list of tests for semlpad.pl
*/
files([
exapprox,
exrange,
threesideddice,
mendels, %ok only with grounding=variables
coin2,
ex
]).
test((s([a],P),close_to(P,0.1719)),exapprox,ground_body(true)).
test((s([a],P),close_to(P,0.0.99)),exapprox,ground_body(false)).
test((s([a(1)],P),close_to(P,0.2775)),exrange,_).
test((s([a(2)],P),close_to(P,0.36)),exrange,_).
test((s([on(0,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((s([on(2,1)],P),close_to(P,0.148148147703704)),threesideddice,_).
test((sc([on(2,1)],[on(0,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((sc([on(2,1)],[on(1,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([cg(s,1,p)],P),close_to(P,0.5)),mendels,ground_body(false)).
test((s([cg(s,1,w)],P),close_to(P,0.5)),mendels,ground_body(false)).
test((s([cg(s,2,p)],P),close_to(P,1.0)),mendels,ground_body(false)).
test((s([cg(s,2,w)],P),close_to(P,0)),mendels,ground_body(false)).
test((s([heads(coin1)],P),close_to(P,0.51)),coin2,_).
test((s([heads(coin2)],P),close_to(P,0.51)),coin2,_).
test((s([tails(coin1)],P),close_to(P,0.49)),coin2,_).
test((s([tails(coin2)],P),close_to(P,0.49)),coin2,_).
test((s([a],P),close_to(P,0.226)),ex,_).

51
cplint/testsemlpadsld.txt
View File

@ -1,51 +0,0 @@
/*
LPAD and CP-Logic reasoning suite
Copyright (c) 2007, Fabrizio Riguzzi
list of tests for semlpadsld.pl
*/
files([
exapprox,
exrange,
threesideddice,
mendels,
school_simple,
coin2,
ex]).
test((s([a],P),close_to(P,0.1719)),exapprox,ground_body(true)).
test((s([a],P),close_to(P,0.0.99)),exapprox,ground_body(false)).
test((s([a(1)],P),close_to(P,0.2775)),exrange,_).
test((s([a(2)],P),close_to(P,0.36)),exrange,_).
test((s([on(0,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((s([on(2,1)],P),close_to(P,0.148148147703704)),threesideddice,_).
test((sc([on(2,1)],[on(0,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((sc([on(2,1)],[on(1,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([cg(s,1,p)],P),close_to(P,0.5)),mendels,ground_body(false)).
test((s([cg(s,1,w)],P),close_to(P,0.5)),mendels,ground_body(false)).
test((s([cg(s,2,p)],P),close_to(P,1.0)),mendels,ground_body(false)).
test((s([cg(s,2,w)],P),close_to(P,0)),mendels,ground_body(false)).
test((s([student_ranking(s0,h)],P),close_to(P,0.6646250000000005)),school_simple,_).
test((s([student_ranking(s0,l)],P),close_to(P,0.33537499999999987)),school_simple,_).
test((s([heads(coin1)],P),close_to(P,0.51)),coin2,_).
test((s([heads(coin2)],P),close_to(P,0.51)),coin2,_).
test((s([tails(coin1)],P),close_to(P,0.49)),coin2,_).
test((s([tails(coin2)],P),close_to(P,0.49)),coin2,_).
test((s([a],P),close_to(P,0.226)),ex,_).