368 lines
		
	
	
		
			9.5 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
			
		
		
	
	
			368 lines
		
	
	
		
			9.5 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.
 | |
| 
 | |
| % :- source.
 | |
| % :- yap_flag(single_var_warnings, on).
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| /* BUILTIN PREDICATES
 | |
|  * ------------------
 | |
|  * This section declares the builtin predicates.
 | |
|  */
 | |
| 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).
 | |
| builtin(length(_L, _N)).
 | |
| builtin(member(_El, _L)).
 | |
| builtin(average(_L, _Av)).
 | |
| builtin(max_list(_L, _Max)).
 | |
| builtin(min_list(_L, _Max)).
 | |
| builtin(nth0(_, _, _)).
 | |
| builtin(nth(_, _, _)).
 | |
| builtin(eraseall(_Id)).
 | |
| builtin(recordz(_Id, _Item, _)).
 | |
| builtin(recordzifnot(_Id, _Item, _)).
 | |
| 
 | |
| 
 | |
| 
 | |
| member_eq(Item, [Head|_Tail]) :- 
 | |
| 	Item==Head, !.
 | |
| 	
 | |
| member_eq(Item, [_Head|Tail]) :- 
 | |
| 	member_eq(Item, Tail).
 | |
| 
 | |
| 
 | |
| 
 | |
| not_already_present_with_a_different_head(_HeadId, _RuleId, _Subst, []).
 | |
| 
 | |
| not_already_present_with_a_different_head(HeadId, RuleId, Subst, [(HeadId1, RuleId, Subst1)|Tail]) :- 
 | |
| 	not_different(HeadId, HeadId1, Subst, Subst1), !, 
 | |
| 	not_already_present_with_a_different_head(HeadId, RuleId, Subst, Tail).
 | |
| 	
 | |
| not_already_present_with_a_different_head(HeadId, RuleId, Subst, [(_HeadId1, RuleId1, _Subst1)|Tail]) :- 
 | |
| 	RuleId \== RuleId1, 
 | |
| 	not_already_present_with_a_different_head(HeadId, RuleId, Subst, Tail).
 | |
| 
 | |
| 
 | |
| 
 | |
| not_different(_HeadId, _HeadId1, Subst, Subst1) :- 
 | |
| 	Subst \= Subst1, !.	
 | |
| 
 | |
| not_different(HeadId, HeadId1, Subst, Subst1) :- 
 | |
| 	HeadId \= HeadId1, !, 
 | |
| 	dif(Subst, Subst1).	
 | |
| 
 | |
| not_different(HeadId, HeadId, Subst, Subst).
 | |
| 
 | |
| 
 | |
| 
 | |
| get_groundc([], [], [], P, P) :- !.
 | |
| 
 | |
| get_groundc([H|T], [H|T1], TV, P0, P1) :- 
 | |
| 	ground(H), !, 
 | |
| 	H=(N, R, S), 
 | |
| 	rule_by_num(R, S, _N, Head, _Body), 
 | |
| 	nth0(N, Head, (_A:P)), 
 | |
| 	P2 is P0*P, 
 | |
| 	get_groundc(T, T1, TV, P2, P1).
 | |
| 
 | |
| get_groundc([H|T], T1, [H|TV], P0, P1) :- 
 | |
| 	get_groundc(T, T1, TV, P0, P1).
 | |
| 
 | |
| get_prob([], P, P) :- !.
 | |
| 
 | |
| get_prob([H|T], P0, P1) :- 
 | |
| 	H=(N, R, S), 
 | |
| 	rule_by_num(R, S, _N, Head, _Body), 
 | |
| 	nth0(N, Head, (_A:P)), 
 | |
| 	P2 is P0*P, 
 | |
| 	get_prob(T, P2, P1).
 | |
| 
 | |
| 
 | |
| 
 | |
| 
 | |
| find_rulec(H, (R, S, N), Body, C, P) :- 
 | |
| 	rule(H, P, N, R, S, _NH, _Head, Body), 
 | |
| 	not_already_present_with_a_different_head(N, R, S, C).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* var2numbers([(Rule, Subst)|CoupleTail], Index, [[Index, Heads, Probs]|TripleTail])
 | |
|  * ----------------------------------------------------------------------------------
 | |
|  * This tail recursive predicate converts a list of couples (Rule, Subst) into a
 | |
|  * list of triples (Index, Count, Probs).
 | |
|  * Rule and Subst are the index of their equivalent rule and substitution.
 | |
|  * Index is a progressive identifier starting from 0.
 | |
|  * Count is the number of head atoms and Probs is the vector of their 
 | |
|  * probabilities.
 | |
|  *
 | |
|  * INPUT
 | |
|  *  - Couples: list of couples to convert.
 | |
|  *
 | |
|  * OUTPUT
 | |
|  *  - Triples: list of equivalent triples.
 | |
|  */
 | |
| var2numbers([], _N, []).
 | |
| 
 | |
| var2numbers([(Rule, Subst)|CoupleTail], Index, [[Index, Heads, Probs]|TripleTail]) :- 
 | |
| 	find_probs(Rule, Subst, Probs), 
 | |
| 	length(Probs, Heads), 
 | |
| 	Next is Index+1, 
 | |
| 	var2numbers(CoupleTail, Next, TripleTail).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* build_formula(ListC, Formula, VarIn, VarOut) 
 | |
|  * --------------------------------------------
 | |
|  * This predicate parses a given list of C sets with a given list of variables 
 | |
|  * and returns the equivalent formula with its list of variables.
 | |
|  * 
 | |
|  * Note: each Formula is expressed in the form: [Term1, ..., TermN], where each 
 | |
|  *       term is expressed in the form: [Factor1, ..., FactorM], where each 
 | |
|  *       factor is hence expressed in the form: (Var, Name).
 | |
|  *       Finally, Var is the index of the multivalued variable Var, and Value is 
 | |
|  *       the index of its value.
 | |
|  *
 | |
|  * INPUT
 | |
|  *  - ListC: given list of C sets.
 | |
|  *  - VarIn: list of variables pertaining to ListC.
 | |
|  * 
 | |
|  * OUTPUT
 | |
|  *  - Formula: the formula equivalent to ListC.
 | |
|  *  - VarOut: list of variables pertaining to Formula.
 | |
|  */
 | |
| build_formula([], [], Var, Var, Count, Count).
 | |
| %% Closing condition: stop if no more terms (current Var is final Var, current Count is final Count)
 | |
| 
 | |
| build_formula([D|TD], [F|TF], VarIn, VarOut, C0, C1) :- 
 | |
| 	length(D, NC), 
 | |
| 	C2 is C0+NC, 
 | |
| 	reverse(D, D1), 
 | |
| 	build_term(D1, F, VarIn, Var1), 
 | |
| 	build_formula(TD, TF, Var1, VarOut, C2, C1).
 | |
| 	%% Recursive call: procedd to next terms, building rest of formula and handling vars and count.
 | |
| 
 | |
| build_formula([], [], Var, Var).
 | |
| 
 | |
| build_formula([D|TD], [F|TF], VarIn, VarOut) :- 
 | |
| 	build_term(D, F, VarIn, Var1), 
 | |
| 	build_formula(TD, TF, Var1, VarOut).
 | |
| 
 | |
| 
 | |
| 
 | |
| build_term([], [], Var, Var).
 | |
| 
 | |
| build_term([(_, pruned, _)|TC], TF, VarIn, VarOut) :- !,
 | |
| 	build_term(TC, TF, VarIn, VarOut).
 | |
| 
 | |
| build_term([(N, R, S)|TC], [[NVar, N]|TF], VarIn, VarOut) :-
 | |
| 	(nth0_eq(0, NVar, VarIn, (R, S)) ->
 | |
| 		Var1=VarIn;
 | |
| 		append(VarIn, [(R, S)], Var1),
 | |
| 		length(VarIn, NVar)), 
 | |
| 	build_term(TC, TF, Var1, VarOut).							
 | |
| 
 | |
| 
 | |
| 
 | |
| find_probs(R, S, Probs) :- 
 | |
| 	rule_by_num(R, S, _N, Head, _Body), 
 | |
| 	get_probs(Head, Probs).
 | |
| 
 | |
| 
 | |
| 	
 | |
| get_probs(uniform(_A:1/Num, _P, _Number), ListP) :- 
 | |
| 	Prob is 1/Num, 
 | |
| 	list_el(Num, Prob, ListP).
 | |
| 
 | |
| get_probs([], []).
 | |
| 
 | |
| get_probs([_H:P|T], [P1|T1]) :- 
 | |
| 	P1 is P, 
 | |
| 	get_probs(T, T1).
 | |
| 
 | |
| 
 | |
| 
 | |
| list_el(0, _P, []) :- !.
 | |
| 
 | |
| list_el(N, P, [P|T]) :- 
 | |
| 	N1 is N-1, 
 | |
| 	list_el(N1, P, T).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* nth0_eq(PosIn, PosOut, List, Elem) 
 | |
|  * ----------------------------------
 | |
|  * This predicate searches for an element that matches with the given one in the 
 | |
|  * given list, starting from the given position, and returns its position.
 | |
|  *
 | |
|  * INPUT
 | |
|  *  - PosIn: initial position.
 | |
|  *  - List: list to parse.
 | |
|  *  - Elem: element to match.
 | |
|  *
 | |
|  * OUTPUT
 | |
|  *  - PosOut: next position of a matching element.
 | |
|  */
 | |
| nth0_eq(N, N, [H|_T], Elem) :- 
 | |
| 	H==Elem, !.
 | |
| 
 | |
| nth0_eq(NIn, NOut, [_H|T], Elem) :- 
 | |
| 	N1 is NIn+1, 
 | |
| 	nth0_eq(N1, NOut, T, Elem).
 | |
| 
 | |
| 
 | |
| 
 | |
| list2and([X], X) :- 
 | |
| 	X\=(_, _), !.
 | |
| 
 | |
| list2and([H|T], (H, Ta)) :- !, 
 | |
| 	list2and(T, Ta).
 | |
| 
 | |
| 
 | |
| 
 | |
| list2or([X], X) :- 
 | |
| 	X\=;(_, _), !.
 | |
| 
 | |
| list2or([H|T], (H ; Ta)) :- !, 
 | |
| 	list2or(T, Ta).
 | |
| 
 | |
| 
 | |
| 
 | |
| choose_clausesc(_G, C, [], C).
 | |
| 
 | |
| choose_clausesc(CG0, CIn, [D|T], COut) :- 
 | |
| 	member((N, R, S), D), 
 | |
| 	choose_clauses_present(N, R, S, CG0, CIn, COut, T).
 | |
| 	
 | |
| choose_clausesc(G0, CIn, [D|T], COut) :- 
 | |
| 	member((N, R, S), D), 
 | |
| 	new_head(N, R, S, N1), 
 | |
| 	\+ already_present(N1, R, S, CIn), 
 | |
| 	\+ already_present(N1, R, S, G0), 
 | |
| 	impose_dif_cons(R, S, CIn), 
 | |
| 	choose_clausesc(G0, [(N1, R, S)|CIn], T, COut).
 | |
| 
 | |
| 
 | |
| 
 | |
| choose_clauses_present(N, R, S, CG0, CIn, COut, T) :- 
 | |
| 	already_present_with_a_different_head_ground(N, R, S, CG0), !, 
 | |
| 	choose_clausesc(CG0, CIn, T, COut).
 | |
| 
 | |
| choose_clauses_present(N, R, S, CG0, CIn, COut, T) :- 
 | |
| 	already_present_with_a_different_head(N, R, S, CIn), 
 | |
| 	choose_a_head(N, R, S, CIn, C1), 
 | |
| 	choose_clausesc(CG0, C1, T, COut).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* new_head(N, R, S, N1)
 | |
|  * ---------------------
 | |
|  * This predicate selects an head for rule R different from N with substitution 
 | |
|  * S and returns it in N1.
 | |
|  */
 | |
| new_head(N, R, S, N1) :- 
 | |
| 	rule_by_num(R, S, Numbers, Head, _Body), 
 | |
| 	Head\=uniform(_, _, _), !, 
 | |
| 	nth0(N, Numbers, _Elem, Rest), 
 | |
| 	member(N1, Rest).
 | |
| 
 | |
| new_head(N, R, S, N1) :- 
 | |
| 	rule_uniform(_A, R, S, Numbers, 1/Tot, _L, _Number, _Body), 
 | |
| 	listN(0, Tot, Numbers), 
 | |
| 	nth0(N, Numbers, _Elem, Rest), 
 | |
| 	member(N1, Rest).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* already_present(N, R, S, [(N, R, SH)|_T])
 | |
|  * -----------------------------------------
 | |
|  * This predicate checks if a rule R with head N and selection S (or one of its 
 | |
|  * generalizations is in C) is already present in C.
 | |
|  */
 | |
| already_present(N, R, S, [(N, R, SH)|_T]) :- 
 | |
| 	S=SH.
 | |
| 
 | |
| already_present(N, R, S, [_H|T]) :- 
 | |
| 	already_present(N, R, S, T).
 | |
| 
 | |
| 
 | |
| 
 | |
| already_present_with_a_different_head(N, R, S, [(NH, R, SH)|_T]) :- 
 | |
| 	\+ \+ S=SH, NH \= N.
 | |
| 
 | |
| already_present_with_a_different_head(N, R, S, [_H|T]) :- 
 | |
| 	already_present_with_a_different_head(N, R, S, T).
 | |
| 
 | |
| already_present_with_a_different_head_ground(N, R, S, [(NH, R, SH)|_T]) :- 
 | |
| 	S=SH, NH \= N.
 | |
| 
 | |
| already_present_with_a_different_head_ground(N, R, S, [_H|T]) :- 
 | |
| 	already_present_with_a_different_head_ground(N, R, S, T).
 | |
| 
 | |
| 
 | |
| 
 | |
| impose_dif_cons(_R, _S, []) :- !.
 | |
| 
 | |
| impose_dif_cons(R, S, [(_NH, R, SH)|T]) :- !, 
 | |
| 	dif(S, SH), 
 | |
| 	impose_dif_cons(R, S, T).
 | |
| 
 | |
| impose_dif_cons(R, S, [_H|T]) :- 
 | |
| 	impose_dif_cons(R, S, T).
 | |
| 
 | |
| 
 | |
| 
 | |
| /* choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, SH)|T])
 | |
|  * --------------------------------------------------------
 | |
|  * This predicate chooses and returns an head. 
 | |
|  * It instantiates a more general rule if it is contained in C with a different 
 | |
|  * head.
 | |
|  */
 | |
| choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, SH)|T]) :- 
 | |
| 	S=SH, 
 | |
| 	dif(N, NH).
 | |
| 
 | |
| /* choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, S), (NH, R, SH)|T])
 | |
|  * --------------------------------------------------------------------
 | |
|  * This predicate chooses and returns an head.
 | |
|  * It instantiates a more general rule if it is contained in C with a different 
 | |
|  * head.
 | |
|  * It ensures the same ground clause is not generated again.
 | |
|  */
 | |
| choose_a_head(N, R, S, [(NH, R, SH)|T], [(NH, R, S), (NH, R, SH)|T]) :- 
 | |
| 	\+ \+ S=SH, S\==SH, 
 | |
| 	dif(N, NH), 
 | |
| 	dif(S, SH).
 | |
| 
 | |
| choose_a_head(N, R, S, [H|T], [H|T1]) :- 
 | |
| 	choose_a_head(N, R, S, T, T1).
 | |
| 
 | |
| 
 | |
| 
 | |
| listN(N, N, []) :- !.
 | |
| 
 | |
| listN(NIn, N, [NIn|T]) :- 
 | |
| 	N1 is NIn+1, 
 | |
| 	listN(N1, N, T).
 | |
| 
 | |
| 
 |