345 lines
8.9 KiB
Prolog
345 lines
8.9 KiB
Prolog
/*==============================================================================
|
||
* LPAD and CP-Logic reasoning suite
|
||
* File: parsing.pl
|
||
* Parses predicates to load LPADs (main predicate: parse(FileNameNoExt)
|
||
* Copyright (c) 2009, Stefano Bragaglia
|
||
*============================================================================*/
|
||
|
||
:- dynamic rule/4, def_rule/2.
|
||
|
||
:- use_module(params).
|
||
:- use_module(utility).
|
||
|
||
% :- source.
|
||
% :- yap_flag(single_var_warnings, on).
|
||
|
||
|
||
|
||
|
||
|
||
/* parse(File)
|
||
* -----------
|
||
* This predicate parses the given .cpl file.
|
||
*
|
||
* Note: it can be called more than once without exiting yap
|
||
*
|
||
* INPUT
|
||
* - File: .cpl file to parse, without extension.
|
||
*/
|
||
parse(File) :-
|
||
atom_concat(File, '.cpl', FileName),
|
||
open(FileName, read, FileHandle),
|
||
read_clauses(FileHandle, Clauses),
|
||
close(FileHandle),
|
||
retractall(rule_by_num(_, _, _, _, _)),
|
||
retractall(rule(_, _, _, _, _, _, _, _)),
|
||
retractall(def_rule(_, _)),
|
||
process_clauses(Clauses, 1).
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
/* assert_rules()
|
||
* --------------
|
||
* This tail recursive predicate parses the given list of (Head:Prob) couples
|
||
* and stores them incrementally as rules along with the other parameters.
|
||
*
|
||
* INPUT
|
||
* - Head: current head part.
|
||
* - Prob: probability of the current head part.
|
||
* - Index: index of the current head part.
|
||
* - Subst: substitution for the current head part.
|
||
* - Choices: list of current head parts indexes.
|
||
* - HeadList: complete head or list of its parts.
|
||
* - BodyList: complete body or list of its parts.
|
||
*/
|
||
assert_rules([], _Index, _HeadList, _BodyList, _Choices, _Id, _Subst) :- !. % Closing condition.
|
||
|
||
assert_rules(['':_Prob], _Index, _HeadList, _BodyList, _Choices, _Id, _Subst) :- !.
|
||
|
||
assert_rules([Head:Prob|Tail], Index, HeadList, BodyList, Choices, Id, Subst) :-
|
||
assertz(rule(Head, Prob, Index, Id, Subst, Choices, HeadList, BodyList)),
|
||
Next is Index + 1,
|
||
assert_rules(Tail, Next, Id, Subst, Choices, HeadList, BodyList).
|
||
|
||
|
||
|
||
delete_var(_Var, [], []).
|
||
|
||
delete_var(Var, [Current|Tail], [Current|Next]) :-
|
||
Var \== Current, !,
|
||
delete_var(Var, Tail, Next).
|
||
|
||
delete_var(_Var, [_Head|Tail], Tail).
|
||
|
||
|
||
|
||
extract_vars(Variable, Var0, Var1) :-
|
||
var(Variable), !,
|
||
(member_eq(Variable, Var0) ->
|
||
Var1 = Var0;
|
||
append(Var0, [Variable], Var1)).
|
||
|
||
extract_vars(Term, Var0, Var1) :-
|
||
Term=..[_F|Args],
|
||
extract_vars_list(Args, Var0, Var1).
|
||
|
||
|
||
|
||
extract_vars_clause(end_of_file, []).
|
||
|
||
extract_vars_clause(Clause, VarNames, Couples) :-
|
||
(Clause = (Head :- _Body) ->
|
||
true;
|
||
Head = Clause),
|
||
extract_vars(Head, [], Vars),
|
||
pair(VarNames, Vars, Couples).
|
||
|
||
|
||
|
||
extract_vars_list([], Var, Var).
|
||
|
||
extract_vars_list([Term|Tail], Var0, Var1) :-
|
||
extract_vars(Term, Var0, Var),
|
||
extract_vars_list(Tail, Var, Var1).
|
||
|
||
|
||
|
||
get_var(Var, [Var]) :-
|
||
var(Var), !. % Succeeds if Var is currently a free variable, otherwise fails.
|
||
|
||
get_var(Var, Value) :-
|
||
Var=..[_F|Args],
|
||
get_var_list(Args, Value).
|
||
|
||
|
||
|
||
get_var_list([], []).
|
||
|
||
get_var_list([Head|Tail], [Head|Next]) :-
|
||
var(Head), !,
|
||
get_var_list(Tail, Next).
|
||
|
||
get_var_list([Head|Tail], Vars) :- !,
|
||
get_var(Head, Var),
|
||
append(Var, Next, Vars),
|
||
get_var_list(Tail, Next).
|
||
|
||
|
||
|
||
/* ground_prob(HeadList)
|
||
* ---------------------
|
||
* This tail recursive predicate verifies if the given HeadList is ground.
|
||
*
|
||
* INPUT
|
||
* - HeadList: list of heads to verify its groundness.
|
||
*/
|
||
ground_prob([]).
|
||
|
||
ground_prob([_Head:ProbHead|Tail]) :-
|
||
ground(ProbHead), % Succeeds if there are no free variables in the term ProbHead.
|
||
ground_prob(Tail).
|
||
|
||
|
||
|
||
pair(_VarName, [], []).
|
||
|
||
pair([VarName = _Var|TailVarName], [Var|TailVar], [VarName = Var|Tail]) :-
|
||
pair(TailVarName, TailVar, Tail).
|
||
|
||
|
||
|
||
/* process_head(HeadList, CompleteHeadList)
|
||
* ----------------------------------------
|
||
* Note: if the annotation in the head are not ground, the null atom is not
|
||
* added and the eventual formulas are not evaluated.
|
||
*/
|
||
process_head(HeadList, GroundHeadList) :-
|
||
ground_prob(HeadList), !,
|
||
process_head_ground(HeadList, 0, GroundHeadList);
|
||
|
||
process_head(HeadList, HeadList).
|
||
|
||
|
||
|
||
/* process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null])
|
||
* ----------------------------------------------------------------
|
||
*/
|
||
process_head_ground([Head:ProbHead], Prob, [Head:ProbHead|Null]) :-
|
||
ProbLast is 1 - Prob - ProbHead,
|
||
setting(epsilon_parsing, Eps),
|
||
EpsNeg is - Eps,
|
||
ProbLast > EpsNeg,
|
||
(ProbLast > Eps ->
|
||
Null = ['':ProbLast];
|
||
Null = []).
|
||
|
||
process_head_ground([Head:ProbHead|Tail], Prob, [Head:ProbHead|Next]) :-
|
||
ProbNext is Prob + ProbHead,
|
||
process_head_ground(Tail, ProbNext, Next).
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
/* process_body(BodyList, Vars0, Vars1)
|
||
* ------------------------------------
|
||
* Note: setof must have a goal in the form B^G, where B is a term containing
|
||
* the existential variables.
|
||
*/
|
||
process_body([], Vars, Vars).
|
||
|
||
process_body([setof(A, B^_G, _L)|Tail], Vars0, Vars1) :- !,
|
||
get_var(A, VarsA),
|
||
get_var(B, VarsB),
|
||
remove_vars(VarsA, Vars0, Vars3),
|
||
remove_vars(VarsB, Vars3, Vars2),
|
||
process_body(Tail, Vars2, Vars1).
|
||
|
||
process_body([setof(A, _G, _L)|Tail], Vars0, Vars1) :- !,
|
||
get_var(A, VarsA),
|
||
remove_vars(VarsA, Vars0, Vars2),
|
||
process_body(Tail, Vars2, Vars1).
|
||
|
||
process_body([bagof(A, B^_G, _L)|Tail], Vars0, Vars1) :- !,
|
||
get_var(A, VarsA),
|
||
get_var(B, VarsB),
|
||
remove_vars(VarsA, Vars0, Vars3),
|
||
remove_vars(VarsB, Vars3, Vars2),
|
||
process_body(Tail, Vars2, Vars1).
|
||
|
||
process_body([bagof(A, _G, _L)|Tail], Vars0, Vars1) :- !,
|
||
get_var(A, VarsA),
|
||
remove_vars(VarsA, Vars0, Vars2),
|
||
process_body(Tail, Vars2, Vars1).
|
||
|
||
process_body([_Head|Tail], Vars0, Vars1) :- !,
|
||
process_body(Tail, Vars0, Vars1).
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
process_clauses([(end_of_file, [])], _Id).
|
||
|
||
/* NB: il seguente predicato <20> stato commentato perch<63> usa predicati non conformi
|
||
* a quelli attesi (vedi 'rule\5').
|
||
* /
|
||
process_clauses([((Head :- Body), Value)|Tail], Id) :-
|
||
Head=uniform(A, P, L), !,
|
||
list2and(BodyList, Body),
|
||
process_body(BodyList, Value, BodyListValue),
|
||
remove_vars([P], BodyListValue, V2),
|
||
append(BodyList, [length(L, Tot), nth0(Number, L, P)], BL1),
|
||
append(V2, ['Tot'=Tot], V3),
|
||
assertz(rule(Id, V3, _NH, uniform(A:1/Tot, L, Number), BL1)),
|
||
assertz(rule_uniform(A, Id, V3, _NH, 1/Tot, L, Number, BL1)),
|
||
N1 is Id+1,
|
||
process_clauses(Tail, N1). */
|
||
|
||
process_clauses([((Head :- Body), Value)|Tail], Id) :-
|
||
Head = (_;_), !,
|
||
list2or(HeadListOr, Head),
|
||
process_head(HeadListOr, HeadList),
|
||
list2and(BodyList, Body),
|
||
process_body(BodyList, Value, BodyListValue),
|
||
length(HeadList, LH),
|
||
listN(0, LH, NH),
|
||
assert_rules(HeadList, 0, HeadList, BodyList, NH, Id, BodyListValue),
|
||
assertz(rule_by_num(Id, BodyListValue, NH, HeadList, BodyList)),
|
||
N1 is Id+1,
|
||
process_clauses(Tail, N1).
|
||
|
||
process_clauses([((Head :- Body), Value)|Tail], Id) :-
|
||
Head = (_:_), !,
|
||
list2or(HeadListOr, Head),
|
||
process_head(HeadListOr, HeadList),
|
||
list2and(BodyList, Body),
|
||
process_body(BodyList, Value, BodyListValue),
|
||
length(HeadList, LH),
|
||
listN(0, LH, NH),
|
||
assert_rules(HeadList, 0, HeadList, BodyList, NH, Id, BodyListValue),
|
||
assertz(rule_by_num(Id, BodyListValue, NH, HeadList, BodyList)),
|
||
N1 is Id+1,
|
||
process_clauses(Tail, N1).
|
||
|
||
process_clauses([((Head :- Body), _V)|Tail], Id) :- !,
|
||
list2and(BodyList, Body),
|
||
assert(def_rule(Head, BodyList)),
|
||
process_clauses(Tail, Id).
|
||
|
||
process_clauses([(Head, Value)|Tail], Id) :-
|
||
Head=(_;_), !,
|
||
list2or(HeadListOr, Head),
|
||
process_head(HeadListOr, HeadList),
|
||
length(HeadList, LH),
|
||
listN(0, LH, NH),
|
||
assert_rules(HeadList, 0, HeadList, [], NH, Id, Value),
|
||
assertz(rule_by_num(Id, Value, NH, HeadList, [])),
|
||
N1 is Id+1,
|
||
process_clauses(Tail, N1).
|
||
|
||
process_clauses([(Head, Value)|Tail], Id) :-
|
||
Head=(_:_), !,
|
||
list2or(HeadListOr, Head),
|
||
process_head(HeadListOr, HeadList),
|
||
length(HeadList, LH),
|
||
listN(0, LH, NH),
|
||
assert_rules(HeadList, 0, HeadList, [], NH, Id, Value),
|
||
assertz(rule_by_num(Id, Value, NH, HeadList, [])),
|
||
N1 is Id+1,
|
||
process_clauses(Tail, N1).
|
||
|
||
process_clauses([(Head, _V)|Tail], Id) :-
|
||
assert(def_rule(Head, [])),
|
||
process_clauses(Tail, Id).
|
||
|
||
|
||
|
||
read_clauses(Stream, Clauses) :-
|
||
(setting(ground_body, true) ->
|
||
read_clauses_ground_body(Stream, Clauses);
|
||
read_clauses_exist_body(Stream, Clauses)).
|
||
|
||
|
||
|
||
read_clauses_exist_body(Stream, [(Clause, Vars)|Next]) :-
|
||
read_term(Stream, Clause, [variable_names(VarNames)]),
|
||
extract_vars_clause(Clause, VarNames, Vars),
|
||
(Clause = end_of_file ->
|
||
Next = [];
|
||
read_clauses_exist_body(Stream, Next)).
|
||
|
||
|
||
|
||
read_clauses_ground_body(Stream, [(Clause, Vars)|Next]) :-
|
||
read_term(Stream, Clause, [variable_names(Vars)]),
|
||
(Clause = end_of_file ->
|
||
Next = [];
|
||
read_clauses_ground_body(Stream, Next)).
|
||
|
||
|
||
|
||
remove_vars([], Vars, Vars).
|
||
|
||
remove_vars([Head|Tail], Vars0, Vars1) :-
|
||
delete_var(Head, Vars0, Vars2),
|
||
remove_vars(Tail, Vars2, Vars1).
|