This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/cplint/approx/parsing.pl

345 lines
8.9 KiB
Perl
Raw Normal View History

2010-03-18 15:11:21 +00:00
/*==============================================================================
* 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 <EFBFBD> stato commentato perch<EFBFBD> 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).