190 lines
		
	
	
		
			5.4 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
		
		
			
		
	
	
			190 lines
		
	
	
		
			5.4 KiB
		
	
	
	
		
			Perl
		
	
	
	
	
	
|   | /*============================================================================== | ||
|  |  *	LPAD and CP-Logic reasoning suite | ||
|  |  *	File best.pl | ||
|  |  *	Goal oriented interpreter for LPADs based on SLDNF | ||
|  |  *	Copyright (c) 2009, Stefano Bragaglia | ||
|  |  *============================================================================*/ | ||
|  | 
 | ||
|  | /* DA MODIFICARE AFFINCHE' USI IL NUOVO CPLINT_INT */ | ||
|  | /* PARTE BDD IN UN FILE SEPARATO? */ | ||
|  | 
 | ||
|  |    | ||
|  | :- dynamic rule/4, def_rule/2. | ||
|  | 
 | ||
|  | /* EXTERNAL FILE | ||
|  |  * ------------- | ||
|  |  * The following libraries are required by the program to work fine. | ||
|  |  */ | ||
|  | :- use_module(library(lists)). | ||
|  | :- use_module(library(ugraphs)). | ||
|  | :- use_module(params). | ||
|  | :- use_module(utility). | ||
|  | 
 | ||
|  | % :- source. | ||
|  | % :- yap_flag(single_var_warnings, on). | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | /* INITIALIZATION | ||
|  |  * -------------- | ||
|  |  * The following predicate enables the cplint specific features for the program. | ||
|  |  */ | ||
|  | :- load_foreign_files(['cplint'], [], init_my_predicates). | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | /* SOLVING PREDICATES | ||
|  |  * ------------------ | ||
|  |  * The predicates in this section solve any given problem with several class of  | ||
|  |  * algorithms. | ||
|  |  * | ||
|  |  * Note: the original predicates (no more need and eligible to be deleted) have  | ||
|  |  *       been moved to the end of the file. | ||
|  |  */  | ||
|  |   | ||
|  | /* solve(GoalsList, Prob, ResTime, BddTime) | ||
|  |  * ---------------------------------------- | ||
|  |  * This predicate computes the probability of a given list of goals using an  | ||
|  |  * exact algorithm. It also returns the number of handled BDDs (trivial but  | ||
|  |  * present for simmetry with other solving predicates), CPUTime spent in  | ||
|  |  * performing resolution and in handling the BDDs. | ||
|  |  *  | ||
|  |  * INPUT | ||
|  |  *  - GoalsList: given list of goal to work on. | ||
|  |  * | ||
|  |  * OUTPUT | ||
|  |  *  - Prob: the resulting exact probability for the given list of goals. | ||
|  |  *  - Count: number of BDDs handled by the algorithm (trivial, since it's always 1). | ||
|  |  *  - ResTime: cpu time spent on performing resolution. | ||
|  |  *  - BddTime: cpu time spent on handling BDDs. | ||
|  |  */  | ||
|  | solve(GoalsList, Prob, ResTime, BddTime) :- | ||
|  | 	% Resetting the clocks... | ||
|  | 	statistics(walltime, [_, _]),	 | ||
|  | 	% Performing resolution... | ||
|  | 	findall(Deriv, exact(GoalsList, Deriv), List),	 | ||
|  | 	% Taking elapsed times... | ||
|  | 	statistics(walltime, [_, ElapResTime]), | ||
|  | 	ResTime is ElapResTime/1000,	 | ||
|  | 	% Building and solving equivalent bdds... | ||
|  | 	build_formula(List, Formula, [], Var),  | ||
|  | 	var2numbers(Var, 0, NewVar),  | ||
|  | 	(setting(save_dot, true) -> | ||
|  | 		format("Variables: ~p~n", [Var]),  | ||
|  | 		compute_prob(NewVar, Formula, Prob, 1); | ||
|  | 		compute_prob(NewVar, Formula, Prob, 0)), | ||
|  | 	 | ||
|  | 	% Taking elapsed times | ||
|  | 	statistics(walltime, [_, ElapBddTime]), | ||
|  | 	BddTime is ElapBddTime/1000. | ||
|  | 
 | ||
|  | /* exact(GoalsList, CIn, COut) takes a list of goals and an input C set | ||
|  | and returns an output C set | ||
|  | The C set is a list of triple (N, R, S) where | ||
|  | - N is the index of the head atom used, starting from 0 | ||
|  | - R is the index of the non ground rule used, starting from 1 | ||
|  | - S is the substitution of rule R, in the form of a list whose elements | ||
|  | 	are of the form 'VarName'=value | ||
|  | */ | ||
|  | exact(GoalsList, Deriv) :-  | ||
|  | 	exact(GoalsList, [], Deriv). | ||
|  | 
 | ||
|  | exact([], C, C) :- !. | ||
|  | 
 | ||
|  | exact([bagof(V, EV^G, L)|T], CIn, COut) :- !,  | ||
|  | 	list2and(GL, G),  | ||
|  | 	bagof((V, C), EV^exact(GL, CIn, C), LD),  | ||
|  | 	length(LD, N),  | ||
|  | 	build_initial_graph(N, GrIn), 	 | ||
|  | 	build_graph(LD, 0, GrIn, Gr),  | ||
|  | 	clique(Gr, Clique),  | ||
|  | 	build_Cset(LD, Clique, L, [], C1),  | ||
|  | 	remove_duplicates_eq(C1, C2),  | ||
|  | 	exact(T, C2, COut). | ||
|  | 
 | ||
|  | exact([bagof(V, G, L)|T], CIn, COut) :- !,  | ||
|  | 	list2and(GL, G),  | ||
|  | 	bagof((V, C), exact(GL, CIn, C), LD),  | ||
|  | 	length(LD, N),  | ||
|  | 	build_initial_graph(N, GrIn), 	 | ||
|  | 	build_graph(LD, 0, GrIn, Gr),  | ||
|  | 	clique(Gr, Clique),  | ||
|  | 	build_Cset(LD, Clique, L, [], C1),  | ||
|  | 	remove_duplicates_eq(C1, C2),  | ||
|  | 	exact(T, C2, COut). | ||
|  | 
 | ||
|  | exact([setof(V, EV^G, L)|T], CIn, COut) :- !,  | ||
|  | 	list2and(GL, G),  | ||
|  | 	setof((V, C), EV^exact(GL, CIn, C), LD),  | ||
|  | 	length(LD, N),  | ||
|  | 	build_initial_graph(N, GrIn), 	 | ||
|  | 	build_graph(LD, 0, GrIn, Gr),  | ||
|  | 	clique(Gr, Clique),  | ||
|  | 	build_Cset(LD, Clique, L1, [], C1), 	 | ||
|  | 	remove_duplicates(L1, L), 	 | ||
|  | 	exact(T, C1, COut). | ||
|  | 
 | ||
|  | exact([setof(V, G, L)|T], CIn, COut) :- !,  | ||
|  | 	list2and(GL, G),  | ||
|  | 	setof((V, C), exact(GL, CIn, C), LD),  | ||
|  | 	length(LD, N),  | ||
|  | 	build_initial_graph(N, GrIn), 	 | ||
|  | 	build_graph(LD, 0, GrIn, Gr),  | ||
|  | 	clique(Gr, Clique),  | ||
|  | 	build_Cset(LD, Clique, L1, [], C1), 	 | ||
|  | 	remove_duplicates(L1, L), 	 | ||
|  | 	exact(T, C1, COut). | ||
|  | 
 | ||
|  | exact([\+ H|T], CIn, COut) :-  | ||
|  | 	builtin(H), !,  | ||
|  | 	call((\+ H)),  | ||
|  | 	exact(T, CIn, COut). | ||
|  | 
 | ||
|  | exact([\+ H |T], CIn, COut) :- !,  | ||
|  | 	list2and(HL, H),  | ||
|  | 	findall(D, find_deriv(HL, D), L),  | ||
|  | 	choose_clauses(CIn, L, C1), 	 | ||
|  | 	exact(T, C1, COut). | ||
|  | 	 | ||
|  | exact([H|T], CIn, COut) :-  | ||
|  | 	builtin(H), !,  | ||
|  | 	call(H),  | ||
|  | 	exact(T, CIn, COut). | ||
|  | 
 | ||
|  | exact([H|T], CIn, COut) :-  | ||
|  | 	def_rule(H, B),  | ||
|  | 	append(B, T, NG),  | ||
|  | 	exact(NG, CIn, COut). | ||
|  | 	 | ||
|  | exact([H|T], CIn, COut) :-  | ||
|  | 	find_rule(H, (R, S, N), B, CIn),  | ||
|  | 	solve_pres(R, S, N, B, T, CIn, COut). | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | solve_pres(R, S, N, B, T, CIn, COut) :-  | ||
|  | 	member_eq((N, R, S), CIn), !,  | ||
|  | 	append(B, T, NG),  | ||
|  | 	exact(NG, CIn, COut). | ||
|  | 	 | ||
|  | solve_pres(R, S, N, B, T, CIn, COut) :-  | ||
|  | 	append(CIn, [(N, R, S)], C1),  | ||
|  | 	append(B, T, NG),  | ||
|  | 	exact(NG, C1, COut). | ||
|  | 
 | ||
|  | 
 | ||
|  | 
 | ||
|  | /* find_rule(G, (R, S, N), Body, C)  | ||
|  |  * -------------------------------- | ||
|  |  * This predicate takes a goal G and the current C set and returns the index R  | ||
|  |  * of a disjunctive rule resolving with G together with the index N of the  | ||
|  |  * resolving head, the substitution S and the Body of the rule. | ||
|  |  */ | ||
|  | find_rule(H, (R, S, N), Body, C) :-  | ||
|  | 	rule(H, _P, N, R, S, _NH, _Head, Body),  | ||
|  | 	not_already_present_with_a_different_head(N, R, S, C). |