2ffffffed0
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2010 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
136 lines
3.2 KiB
Prolog
136 lines
3.2 KiB
Prolog
/*
|
|
LPAD and CP-Logic reasoning suite
|
|
File cpl.pl
|
|
Computes the semantics of CP-logic programs
|
|
Copyright (c) 2007, Fabrizio Riguzzi
|
|
*/
|
|
|
|
:-use_module(lpad,[slg/3,setting/2,set/2]).
|
|
|
|
:-use_module(semcpl,[build/0,print/0]).
|
|
|
|
:-use_module(library(lists)).
|
|
|
|
p(File):-
|
|
lpad:p(File).
|
|
|
|
sc(Goals,Evidences,Prob):-
|
|
lpad:convert_to_goal(Goals,Goal),
|
|
lpad:convert_to_goal(Evidences,Evidence),
|
|
solve_cond(Goal,Evidence,Prob).
|
|
|
|
solve_cond(Goal,Evidence,Prob):-
|
|
(setof((DerivE,D),slg(Evidence,DerivE,D),LCouplesE)->
|
|
separate(LCouplesE,LCDupE,LDefClE),
|
|
lpad:rem_dup_lists(LCDupE,[],LCE),
|
|
lpad:build_formula(LCE,FormulaE,[],VarE),
|
|
lpad:var2numbers(VarE,0,NewVarE),
|
|
lpad:compute_prob(NewVarE,FormulaE,ProbE,0),
|
|
solve_cond_goals(Goal,LCE,ProbGE,LGE,LDefClGE),
|
|
(setof((R,S),N^(member(C,LGE),member((N,R,S),C)),LDisClGE)->
|
|
true
|
|
;
|
|
LDisClGE=[]
|
|
),
|
|
append(LDefClGE,LDefClE,LDefDup),
|
|
remove_duplicates(LDefDup,LDef),
|
|
append(LDisClGE,LDef,LCl),
|
|
test_validity(LCl),
|
|
Prob is ProbGE/ProbE
|
|
;
|
|
format("P(Evidence)=0~n",[]),
|
|
Prob=undefined
|
|
).
|
|
|
|
solve_cond_goals(Goals,LE,ProbGE,LGE,LDefClGE):-
|
|
(setof((DerivGE,D),find_deriv_GE(LE,Goals,DerivGE,D),LCouplesGE)->
|
|
separate(LCouplesGE,LCDupGE,LDefClGE),
|
|
lpad:rem_dup_lists(LCDupGE,[],LGE),
|
|
lpad:build_formula(LGE,FormulaGE,[],VarGE),
|
|
lpad:var2numbers(VarGE,0,NewVarGE),
|
|
lpad:call_compute_prob(NewVarGE,FormulaGE,ProbGE)
|
|
;
|
|
ProbGE=0
|
|
).
|
|
|
|
find_deriv_GE(LD,GoalsList,Deriv,Def):-
|
|
member(D,LD),
|
|
lpad:slg(GoalsList,D,DerivDup,[],Def),
|
|
remove_duplicates(DerivDup,Deriv).
|
|
|
|
s(GoalsList,Prob):-
|
|
lpad:convert_to_goal(GoalsList,Goal),
|
|
solve(Goal,Prob).
|
|
|
|
solve(Goal,Prob):-
|
|
(setof((C,D),slg(Goal,C,D),LCouples)->
|
|
separate(LCouples,LCDup,LDefCl),
|
|
(member(unsound,LCDup)->
|
|
format("Unsound program ~n",[]),
|
|
Prob=unsound
|
|
;
|
|
lpad:rem_dup_lists(LCDup,[],L),
|
|
(ground(L)->
|
|
lpad:build_formula(L,Formula,[],Var),
|
|
lpad:var2numbers(Var,0,NewVar),
|
|
(setting(savedot,true)->
|
|
format("Variables: ~p~n",[Var]),
|
|
lpad:compute_prob(NewVar,Formula,_Prob,1)
|
|
;
|
|
lpad:compute_prob(NewVar,Formula,Prob,0)
|
|
),
|
|
(setof((R,S),N^(member(C,LCDup),member((N,R,S),C)),LDisCl)->
|
|
true
|
|
;
|
|
LDisCl=[]
|
|
),
|
|
append(LDisCl,LDefCl,LCl),
|
|
test_validity(LCl)
|
|
;
|
|
format("It requires the choice of a head atom from a non ground head~n~p~n",[L]),
|
|
Prob=non_ground
|
|
)
|
|
)
|
|
;
|
|
Prob=0
|
|
).
|
|
|
|
test_validity(L):-
|
|
retractall(semcpl:root(_)),
|
|
retractall(semcpl:clauses(_)),
|
|
retractall(semcpl:herbrand_base(_)),
|
|
retractall(semcpl:node(_,_,_,_,_)),
|
|
retractall(semcpl:new_number(_)),
|
|
assert(semcpl:new_number(0)),
|
|
get_clauses_hb(L,LC,HBDup),
|
|
remove_duplicates(HBDup,HB0),
|
|
delete(HB0, '' ,HB),
|
|
assert(semcpl:herbrand_base(HB)),
|
|
assert(semcpl:clauses(LC)),
|
|
build.
|
|
|
|
get_clauses_hb([],[],[]):-!.
|
|
|
|
get_clauses_hb([(R,S)|T],[r(Head,Body)|TR],HB):-
|
|
lpad:rule(R,S,_,Head,Body),!,
|
|
get_atoms(Head,Atoms),
|
|
append(Atoms,HB0,HB),
|
|
get_clauses_hb(T,TR,HB0).
|
|
|
|
get_clauses_hb([(R,S)|T],[r([Head:1],Body)|TR],HB):-
|
|
lpad:def_rule(R,S,Head,Body),
|
|
append([Head],HB0,HB),
|
|
get_clauses_hb(T,TR,HB0).
|
|
|
|
get_atoms([],[]):-!.
|
|
|
|
get_atoms([H:_P|T],[H|TA]):-
|
|
get_atoms(T,TA).
|
|
|
|
separate([],[],[]):-!.
|
|
|
|
separate([(C,D)|T],[C|TC],Cl):-
|
|
append(D,Cl0,Cl),
|
|
separate(T,TC,Cl0).
|
|
|