diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

added approximated cplint

Browse Source
This commit is contained in:
RIGUZZI FABRIZIO - Dipartimento di Ingegneria
2010-03-18 16:11:21 +01:00
parent 601bc81464
commit db2eefd0c9
54 changed files with 28413 additions and 2421 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
packages/cplint/approx/.svn/text-base/INSTALL.txt.svn-base Normal file
View File

@@ -0,0 +1,5 @@
To use the algorithms, you have to compile simplecudd for LPADs in folder
simplecuddLPADs. Modify the makefile provided to suit your machine and run
make, make install. Please note that glu is a library that includes cudd and
that is distributed with vis http://vlsi.colorado.edu/~vis/.
Instead of linking with libglu.a, you can link with libcudd-ver.a.

451
packages/cplint/approx/.svn/text-base/bestfirst.pl.svn-base Normal file
View File

@@ -0,0 +1,451 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File best.pl
* Goal oriented interpreter for LPADs based on SLDNF
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- 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(system)).
:- use_module(library(ugraphs)).
:- use_module(params).
:- use_module(tptreefile).
:- use_module(utility).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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(Goals, ProbLow, ProbUp, Count, ResTime, BddTime)
* ------------------------------------------------------
* This predicate computes the probability of a given list of goals using an
* iterative deepening, probability bounded algorithm.
* It also returns the number of handled BDDs and the CPUTime spent performing
* resolution and spent handling the BDDs.
*
* Note: when their derivation is cut, negative goals are added to the head of
* the goals' list to be solved during the following iteration.
*
* INPUT
* - GoalsList: given list of goal to work on. It can contains variables: the
* predicate returns in backtracking all the solutions and their equivalent
* lower and upper bound probability.
*
* OUTPUT
* - ProbLow: resulting lower bound probability for the given list of goals.
* - ProbUp: resulting upper bound probability for the given list of goals.
* - Count: number of BDDs generated by the algorithm.
* - ResTime: CPU time spent on performing resolution.
* - BddTime: CPU time spent on handling BDDs.
*/
solve(Goals, ProbLow, ProbUp, Count, ResTime, BddTime) :-
setting(k, K),
setting(min_error, MinError),
setting(prob_step, ProbStep),
ProbStepLog is log(ProbStep),
assert(low(0, 0.0)),
assert(up(1.0)),
init_ptree(1),
% NB: log(1.0) == 0.0 !!!
bestfirst([0.0-([], [], Goals)], 0, K, MinError, ProbStepLog, ProbLow, ProbUp, 0, Count, 0, ResTime, 0, BddTime),
delete_ptree(1),
retract(low(_, _)),
retract(up(_)).
/* bestfirst(GoalsList, Number, Amount, MinError, ProbStep,
* LowerProb1, UpperProb1, Count0, Count1, ResTime0, ResTime1, BddTime0, BddTime1)
* -----------------------------------------------------------------------------
* This recursive supporting predicate performs resolution for current iteration,
* handles equivalent BDDs (lower and upper one) and calls itself if the current
* probability error is still bigger than the given minimum error.
*
* INPUT
* - GoalsList: given list of goal to work on.
* - FoundList: given list of achieved solutions.
* - Amount: max number of solution considered by each iteration.
* - MinError: minimum error (closing condition).
* - ProbStep: probability step.
* - Count0: number of BDDs already handled by the algorithm.
* - ResTime0: cpu time already spent on performing resolution.
* - BddTime0: cpu time already spent on handling BDDs.
*
* OUTPUT
* - LowerProb1: resulting lower bound probability for the given list of goals.
* - UpperProb1: resulting upper bound probability for the given list of goals.
* - Count1: number of BDDs handled.
* - ResTime1: cpu time spent on performing resolution.
* - BddTime1: cpu time spent on handling BDDs.
*/
bestfirst(GoalsList, Number, Amount, MinError, ProbStep, LowerProb1, UpperProb1, Count0, Count1, ResTime0, ResTime1, BddTime0, BddTime1) :-
% Resetting the clocks...
statistics(walltime, [_, _]),
% Performing resolution...
main(GoalsList, Amount, ProbStep, List),
% Taking elapsed times...
statistics(walltime, [_, ElapResTime]),
ResTime2 is ResTime0 + ElapResTime/1000,
% Building and solving equivalent bdds...
init_ptree(2),
init_ptree(3),
separate(List, [], LowerList0, [], UpperList, [], Incomplete),
insert_list_ptree(LowerList0, 1),
insert_list_ptree(UpperList, 2),
merge_ptree(1,2,3),
length(LowerList0, DeltaLow),
Next is Number + DeltaLow,
eval_lower(Next, ProbLow),
length(UpperList, DeltaUp),
Temp is Next + DeltaUp,
eval_upper(Temp, ProbUp),
delete_ptree(2),
delete_ptree(3),
% Taking elapsed times...
Count2 is Count0 + 2,
statistics(walltime, [_, ElapBddTime]),
BddTime2 is BddTime0 + (ElapBddTime / 1000),
% Is the current error lower than the minimum error?
(ProbUp - ProbLow < MinError ->
% Setting output parameters' values...
LowerProb1 = ProbLow,
UpperProb1 = ProbUp,
Count1 = Count2,
ResTime1 = ResTime2,
BddTime1 = BddTime2;
% Keeping on iterating with accumulated values...
% sufficient without negation:
% D1 = DB,
% necessary for negation
bestfirst(Incomplete, Next, Amount, MinError, ProbStep, LowerProb1, UpperProb1, Count2, Count1, ResTime2, ResTime1, BddTime2, BddTime1)).
/* main(GoalsList, Amount, ProbStep, Pending)
* ------------------------------------------------
* This tail recursive predicate takes the given GoalsList and tries to solve
* the first given Amount quads with the given ProbStep bound on probability,
* one at a time. After each resolution step, it merges the new solutions to the
* current list of solutions so that each time it can consider the most
* promising solution. It finally returns the list of pending solutions, if any.
*
* INPUT
* - GoalsList: current list of goals to solve.
* - Amount: current number of goals to solve.
* - ProbStep: incremental probability step for bound.
*
* OUTPUT
* - Sorted: desired sorted (by non increasing prob) results.
*/
main([], _Amount, _Step, []) :- !.
%% Closing condition: stop if no more goals (pending list is an empty list).
main(Pending, Amount, _Step, Pending) :-
Amount =< 0, !.
%% Closing condition: stop if reached desired amount (pending list is current list).
main([Prob0-(Gnd0, Var0, Goals0)|Tail], Amount, Step, Pending) :-
%% Note: Current list is surely not empty.
%% Note: A certain amount is surely still needed.
Bound is Prob0 + Step,
findall(Prob1-(Gnd1, Var1, Goals1),
explore(Bound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)),
List),
%% Find all the solutions reacheable from the first quad.
sort(List, Sorted),
merge(Tail, Sorted, Complete),
Needed is Amount - 1,
%% Count current quad as considered.
main(Complete, Needed, Step, Pending).
%% Recursive call: consider next quad (updating pending list).
%% Note: Complete list is sorted; this assures we always consider best quad.
/* merge(SortedA, SortedB, Sorted)
* -------------------------------
* This tail recursive predicate merges the quads in SortedA and SortedB list by
* non-increasing values of Prob and returns the desired unique Sorted list.
* The SortedA and SortedB lists must be sorted.
*
* INPUT
* - SortedA: first sorted list of quads.
* - SortedB: second sorted list of quads.
*
* OUTPUT
* - Sorted: resulting unique sorted list of quads.
*/
merge(Sorted, [], Sorted) :- !.
%% Closing condition: stop if no more items in first sorted list (current second sorted list is output sorted list).
merge([], Sorted, Sorted).
%% Closing condition: stop if no more items in first sorted list (current second sorted list is output sorted list).
merge([ProbA-(GndA, VarA, GoalsA)|TailA], [ProbB-(GndB, VarB, GoalsB)|TailB], [ProbA-(GndA, VarA, GoalsA)|Tail]) :-
ProbA >= ProbB, !,
merge(TailA, [ProbB-(GndB, VarB, GoalsB)|TailB], Tail).
%% Recursive call: use the first quad (merge the rest of the first list with the second one).
merge([ProbA-(GndA, VarA, GoalsA)|TailA], [ProbB-(GndB, VarB, GoalsB)|TailB], [ProbB-(GndB, VarB, GoalsB)|Tail]) :-
% ProbA < ProbB, !,
merge([ProbA-(GndA, VarA, GoalsA)|TailA], TailB, Tail).
%% Recursive call: use the second quad (merge the first list with the rest of the second one).
/* separate(List, Low, Up, Next)
* ----------------------------------
* This tail recursive predicate parses the input list and builds the list for
* the lower bound, the upper bound and the pending goals.
* The upper bound list contains both the items of the lower bound list and the
* incomplete ones.
*
* INPUT
* - List: input list.
*
* OUTPUT
* - Low: list for lower bound.
* - Up: list for upper bound.
* - Next: list of pending goals.
*/
separate(List, Low, Up, Next) :-
%% Polarization: initial low, up and next lists are empty.
separate(List, [], Low, [], Up, [], Next).
separate([], Low, Low, Up, Up, Next, Next) :- !.
%% Closing condition: stop if no more results (current lists are now final lists).
separate([_Prob-(Gnd0, [], [])|Tail], Low0, [Gnd0|Low1], Up0, [Gnd0|Up1], Next0, Next1) :- !,
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate([Prob0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Gnd1|Up1], Next0, [Prob1-(Gnd1, Var1, Goals)|Next1]) :-
get_groundc(Var0, Gnd2, Var1, 1.0, Prob2),
append(Gnd0, Gnd2, Gnd1),
Prob1 is Prob0 + log(Prob2),
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
/* explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))
* --------------------------------------------------------------------------
* This tail recursive predicate reads current explanation and returns the
* explanation after the current iteration without dropping below the given
* probability bound.
*
* INPUT
* - ProbBound: the desired probability bound;
* - Prob0-(Gnd0, Var0, Goals0): current explanation
* - Gnd0: list of current ground choices,
* - Var0: list of current non-ground choices,
* - Prob0: probability of Gnd0,
* - Goals0: list of current goals.
*
* OUTPUT
* - Prob1-(Gnd1, Var1, Prob1, Goals1): explanation after current iteration
* - Gnd1: list of final ground choices,
* - Var1: list of final non-ground choices,
* - Prob1: probability of Gnd1,
* - Goals1: list of final goals.
*/
explore(_ProbBound, Prob-(Gnd, Var, []), Prob-(Gnd, Var, [])) :- !.
%% Closing condition: stop if no more goals (input values are output values).
explore(ProbBound, Prob-(Gnd, Var, Goals), Prob-(Gnd, Var, Goals)) :-
%% Closing condition: stop if bound has been reached (input values are output values).
Prob =< ProbBound, !.
% Negation, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call((\+ Head)),
explore(ProbBound, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
%% Recursive call: consider next goal (building next values)
% Negation
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- !,
list2and(HeadList, Head), % ...
findall(Prob-(Gnd, Var, CurrentGoals), explore(ProbBound, 0.0-([], [], HeadList), Prob-(Gnd, Var, CurrentGoals)), List) ->
separate(List, [], LowerBound, [], _UpperBound, [], PendingGoals),
(PendingGoals \= [] ->
Var2 = Var0,
Gnd2 = Gnd0,
Goals1 = [\+ Head|Goals],
explore(ProbBound, Prob0-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals));
%% Recursive call: consider next goal (building next values)
choose_clausesc(Gnd0, Var0, LowerBound, Var),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1))).
%% Recursive call: consider next goal (building next values)
% Main, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call(Head),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, def_rule
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
def_rule(Head, Goals0),
append(Goals0, Tail, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, find_rulec
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
find_rulec(Head, (R, S, N), Goals, Var0, _Prob),
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals)) :-
(member_eq((N, R, S), Var0);
member_eq((N, R, S), Gnd0)), !,
append(Goals, Goals0, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals)).
% Recursive call: consider next goal (building next values)
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) :-
append(Var0, [(N, R, S)], Var),
append(Goals, Goals0, Goals2),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
/* eval_lower(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the lower bound by
* running an external command (BDD resolution via files).
*/
eval_lower(Number, Prob) :-
low(Number, Prob).
eval_lower(Number, ProbLow) :-
Number > 0,
low(OldNumber, _),
Number \= OldNumber,
bdd_ptree_map(1, 'bddl.txt', 'bddl.par', 'bddl.map'),
run_file('bddl.txt', 'bddl.par', NewProbLow),
(NewProbLow = timeout ->
low(_, ProbLow);
ProbLow = NewProbLow,
retract(low(_, _)),
assert(low(Number, ProbLow))).
/* eval_upper(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the upper bound by
* running an external command (BDD resolution via files).
*/
eval_upper(0, ProbUp) :- !,
low(_, ProbUp).
eval_upper(_Number, ProbUp) :-
bdd_ptree_map(3, 'bddu.txt', 'bddu.par', 'bddu.map'),
run_file('bddu.txt', 'bddu.par', NewProbUp),
(NewProbUp = timeout->
up(ProbUp);
ProbUp = NewProbUp,
retract(up(_)),
assert(up(ProbUp))).
/* run_file(BDDFile, BDDParFile, Prob)
* -----------------------------------
* This predicate calls for the resolution of a BDD via file.
*/
run_file(BDDFile, BDDParFile, Prob) :-
ResultFile = 'result.txt',
library_directory(Dir),
setting(timeout, BDDTime),
(BDDTime = no ->
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' > ', ResultFile], Command);
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' -t ', BDDTime,' > ', ResultFile], Command)),
%statistics(walltime,_),
shell(Command, Return),
(Return =\= 0 ->
Status = timeout,
Prob = Status;
see(ResultFile),
read(elapsed_construction(_TimeConstruction)),
read(probability(Prob)),
read(elapsed_traversing(_TimeTraversing)),
seen,
%write(probability(Prob)),nl,
%read(_),
%delete_file(ResultFile),
Status = ok
% format("Construction time ~f traversing time ~f~Number",[TimeConstruction, TimeTraversing])
).
%statistics(walltime,[_,E3]),
%format(user,'~w ms BDD processing~Number',[E3]),
% format("Status ~a~Number",[Status]).
/* insert_list_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the given list in a trie.
*/
insert_list_ptree([], _Trie).
insert_list_ptree([Head|Tail], Trie) :-
reverse(Head, Head1),
insert_ptree(Head1, Trie),
insert_list_ptree(Tail, Trie).

528
packages/cplint/approx/.svn/text-base/bestk.pl.svn-base Normal file
View File

@@ -0,0 +1,528 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File best.pl
* Goal oriented interpreter for LPADs based on SLDNF
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- 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(system)).
:- use_module(library(ugraphs)).
:- use_module(params).
:- use_module(tptreefile).
:- use_module(utility).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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(Goals, Prob, ResTime, BddTime)
* ------------------------------------
* This predicate computes the probability of a given list of goals using an
* iterative deepening, probability bounded algorithm.
* It also returns the number of handled BDDs and the CPUTime spent performing
* resolution and spent handling the BDDs.
*
* Note: when their derivation is cut, negative goals are added to the head of
* the goals' list to be solved during the following iteration.
*
* INPUT
* - GoalsList: given list of goal to work on. It can contains variables: the
* predicate returns in backtracking all the solutions and their equivalent
* lower and upper bound probability.
*
* OUTPUT
* - Prob: resulting lower bound probability for the given list of goals.
* - ResTime: CPU time spent on performing resolution.
* - BddTime: CPU time spent on handling BDDs.
*/
solve(Goals, Prob, ResTime, BddTime) :-
setting(k, K),
setting(prob_step, ProbStep),
ProbStepLog is log(ProbStep),
% NB: log(1.0) == 0.0 !!!
bestk([0.0-0.0-([], [], Goals)], K, ProbStepLog, Prob, ResTime, BddTime).
/* bestk(GoalsList, K, ProbStep, Prob, ResTime, BddTime)
* -----------------------------------------------------
* This recursive supporting predicate performs resolution for current iteration,
* sticks with the best complete solutions only and considers their equivalent
* BDD to compute their probability.
*
* INPUT
* - GoalsList: given list of goal to work on.
* - K: number of solution to consider.
* - ProbStep: value used to update the probability bound.
*
* OUTPUT
* - Prob: resulting probability (actaully a lower bound) for the given list of goals.
* - ResTime: cpu time spent on performing resolution.
* - BddTime: cpu time spent on handling BDDs.
*/
bestk(GoalsList, K, ProbStep, Prob, ResTime, BddTime) :-
% Resetting the clocks...
statistics(walltime, [_, _]),
% Performing resolution...
main(GoalsList, K, ProbStep, BestK),
% Taking elapsed times...
statistics(walltime, [_, ElapResTime]),
ResTime is ElapResTime/1000,
% Building and solving equivalent bdds...
init_ptree(1),
insert_full_ptree(BestK, 1),
bdd_ptree_map(1, 'bdd.txt', 'bdd.par', 'bdd.map'),
delete_ptree(1),
run_file('bdd.txt','bdd.par', Temp),
(Temp == timeout ->
Prob is -1.0;
Prob is Temp),
% Taking elapsed times...
statistics(walltime, [_, ElapBddTime]),
BddTime is (ElapBddTime / 1000).
/* main(Goals, K, ProbStep, Best)
* ------------------------------
* This tail recursive predicate returns the Best K complete solutions to the
* given Goals. The probability bound is dinamically computed at each iteration.
*
* INPUT
* - Goals: list of goals to achive.
* - K: desired number of solutions.
* - ProbStep: value used to update the probability bound.
*
* OUTPUT
* - Best: list of best solutions (at most k).
*/
main(Goals, K, ProbStep, Best) :-
K > 0,
main(Goals, ProbStep, K, 0.0, [], Best).
main([], _ProbStep, _Left, _Worst, Best, Best).
main(Goals, ProbStep, Left0, Worst0, Best0, Best1) :-
findall(Prob1-Bound-(Gnd1, Var1, Goals1),
(member(Prob0-Bound0-(Gnd0, Var0, Goals0), Goals), Bound is Bound0+ ProbStep, explore(Bound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))),
Found),
%% sepkeepbest(Found, Left0, Left2, Worst0, Worst2, Best0, Best2, [], Incomplete),
separate_main(Found, [], Complete, [], _UpperList, [], Incomplete),
keepbest(Complete, Left0, Left2, Worst0, Worst2, Best0, Best2),
main(Incomplete, ProbStep, Left2, Worst2, Best2, Best1).
/* sepkeepbest(Found, Left0, Left1, Worst0, Worst1, List0, List1, Next0, Next1)
* ----------------------------------------------------------------------------
* This tail recursive predicate analyzes the given list of solutions found and
* returns the list of (K at most) best complete solutions and the whole list of
* incomplete solutions for a full B&B behaviour.
* The given worst value permits some optimization, such as immediate skipping
* of very bad solutions.
*
* INPUT
* - Found: list of solutions found.
* - Left0: actual amount of items still needed to have K solutions.
* - Worst0: value of the actual worst complete solution kept.
* - List0: actual list of best complete solutions.
* - Next0: actual list of incomplete solutions.
*
* OUTPUT
* - Left1: final amount of items still needed to have K solutions.
* - Worst1: value of the final worst complete solution kept.
* - List1: final list of best complete solutions.
* - Next1: final list of incomplete solutions.
*/
sepkeepbest([], Left, Left, Worst, Worst, List, List, Next, Next) :- !.
%% Closing condition: stop if no more results (current values are now final values).
sepkeepbest([Prob0-(_Gnd0, [], [])|Tail], 0, Left1, Worst0, Worst1, List0, List1, Next0, Next1) :-
Prob0 =< Worst0, !,
sepkeepbest(Tail, 0, Left1, Worst0, Worst1, List0, List1, Next0, Next1).
sepkeepbest([Prob0-(Gnd0, [], [])|Tail], 0, Left1, Worst0, Worst1, List0, List1, Next0, Next1) :-
Prob0 > Worst0, !,
discard(Prob0-(Gnd0, [], []), List0, List2, Worst2),
sepkeepbest(Tail, 0, Left1, Worst2, Worst1, List2, List1, Next0, Next1).
sepkeepbest([Prob0-(Gnd0, [], [])|Tail], Left0, Left1, Worst0, Worst1, List0, List1, Next0, Next1) :- !,
insert(Prob0-(Gnd0, [], []), List0, Worst0, List2, Worst2),
Left2 is Left0 - 1,
sepkeepbest(Tail, Left2, Left1, Worst2, Worst1, List2, List1, Next0, Next1).
sepkeepbest([Prob0-(Gnd0, Var0, Goals)|Tail], Left0, Left1, Worst0, Worst1, List0, List1, Next0, [Prob1-(Gnd1, Var1, Goals)|Next1]) :-
get_groundc(Var0, Gnd2, Var1, 1.0, Prob2),
append(Gnd0, Gnd2, Gnd1),
Prob1 is Prob0 + log(Prob2),
sepkeepbest(Tail, Left0, Left1, Worst0, Worst1, List0, List1, Next0, Next1).
/* separate(List, Low, Up, Next)
* -----------------------------
* This tail recursive predicate parses the input list and builds the list for
* the lower bound, the upper bound and the pending goals.
* The upper bound list contains both the items of the lower bound list and the
* incomplete ones.
*
* INPUT
* - List: input list.
*
* OUTPUT
* - Low: list for lower bound.
* - Up: list for upper bound.
* - Next: list of pending goals.
*/
separate(List, Low, Up, Next) :-
%% Polarization: initial low, up and next lists are empty.
separate(List, [], Low, [], Up, [], Next).
separate([], Low, Low, Up, Up, Next, Next) :- !.
%% Closing condition: stop if no more results (current lists are now final lists).
separate([Prob0-(Gnd0, [], [])|Tail], Low0, [Gnd0|Low1], Up0, [Prob0-(Gnd0, [], [])|Up1], Next0, Next1) :- !,
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate([Prob0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Prob0-(Gnd0, Var0, Goals)|Up1], Next0, [Prob0-(Gnd0, Var0, Goals)|Next1]) :-
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate_main([], Low, Low, Up, Up, Next, Next) :- !.
%% Closing condition: stop if no more results (current lists are now final lists).
separate_main([Prob0-_Bound0-(Gnd0, [], [])|Tail], Low0, [Prob0-(Gnd0, [], [])|Low1], Up0, [Prob0-(Gnd0, [], [])|Up1], Next0, Next1) :- !,
separate_main(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate_main([Prob0-Bound0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Prob0-Bound0-(Gnd0, Var0, Goals)|Up1], Next0, [Prob0-Bound0-(Gnd0, Var0, Goals)|Next1]) :-
separate_main(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
/* explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))
* --------------------------------------------------------------------------
* This tail recursive predicate reads current explanation and returns the
* explanation after the current iteration without dropping below the given
* probability bound.
*
* INPUT
* - ProbBound: the desired probability bound;
* - Prob0-(Gnd0, Var0, Goals0): current explanation
* - Gnd0: list of current ground choices,
* - Var0: list of current non-ground choices,
* - Prob0: probability of Gnd0,
* - Goals0: list of current goals.
*
* OUTPUT
* - Prob1-(Gnd1, Var1, Prob1, Goals1): explanation after current iteration
* - Gnd1: list of final ground choices,
* - Var1: list of final non-ground choices,
* - Prob1: probability of Gnd1,
* - Goals1: list of final goals.
*/
explore(_ProbBound, Prob-(Gnd, Var, []), Prob-(Gnd, Var, [])) :- !.
%% Closing condition: stop if no more goals (input values are output values).
explore(ProbBound, Prob-(Gnd, Var, Goals), Prob-(Gnd, Var, Goals)) :-
%% Closing condition: stop if bound has been reached (input values are output values).
Prob =< ProbBound, !.
% Negation, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call((\+ Head)),
explore(ProbBound, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
%% Recursive call: consider next goal (building next values)
% Negation
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- !,
list2and(HeadList, Head), % ...
findall(Prob-(Gnd, Var, CurrentGoals), explore(ProbBound, 0.0-([], [], HeadList), Prob-(Gnd, Var, CurrentGoals)), List) ->
separate(List, [], LowerBound, [], _UpperBound, [], PendingGoals),
(PendingGoals \= [] ->
Var2 = Var0,
Gnd2 = Gnd0,
Goals1 = [\+ Head|Goals],
explore(ProbBound, Prob0-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals));
%% Recursive call: consider next goal (building next values)
choose_clausesc(Gnd0, Var0, LowerBound, Var),
get_prob(Var, 1, Prob),
append(Gnd0, Var, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, [], Tail), Prob1-(Gnd1, Var1, Goals1))).
%% Recursive call: consider next goal (building next values)
% Main, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call(Head),
explore(ProbBound, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, def_rule
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
def_rule(Head, Goals0),
append(Goals0, Tail, Goals2),
explore(ProbBound, Prob0-(Gnd0, Var0, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, find_rulec
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
find_rulec(Head, (R, S, N), Goals, Var0, _Prob),
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals)) :-
(member_eq((N, R, S), Var0);
member_eq((N, R, S), Gnd0)), !,
append(Goals, Goals0, Goals2),
explore(ProbBound, Prob0-(Gnd0, Var0, Goals2), Prob1-(Gnd1, Var1, Goals)).
% Recursive call: consider next goal (building next values)
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) :-
append(Var0, [(N, R, S)], Var),
append(Goals, Goals0, Goals2),
get_prob(Var, 1, Prob),
append(Gnd0, Var, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, [], Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
/* keepbest(List, K, BestK)
* ------------------------
* This tail recursive predicate parses the given list of quads and returns the
* list of its best k quads. If the given list of quads contains less than k
* items, the predicate returns them all.
*
* INPUT
* - List: list of quads to parse.
* - K: desired number of quads.
*
* OUTPUT
* - BestK: final list of (at most) best k quads.
*/
keepbest(List, K, BestK) :-
K > 0,
keepbest(List, K, _Left, 0.0, _Worst, [], BestK).
/*keepbest([], _Left, _Worst, List, List).
keepbest([Prob-(_Gnd, _Var, _Goals)|Tail], 0, Worst, List0, List1) :-
Prob =< Worst, !,
keepbest(Tail, 0, Worst, List0, List1).
keepbest([Prob-(Gnd, Var, Goals)|Tail], 0, Worst, List0, List1) :-
Prob > Worst, !,
discard(Prob-(Gnd, Var, Goals), List0, List2, Worst2),
keepbest(Tail, 0, Worst2, List2, List1).
keepbest([Prob-(Gnd, Var, Goals)|Tail], Left, Worst, List0, List1) :-
insert(Prob-(Gnd, Var, Goals), List0, Worst, List2, Worst2),
Left2 is Left - 1,
keepbest(Tail, Left2, Worst2, List2, List1).*/
keepbest([], Left, Left, Worst, Worst, List, List).
keepbest([Prob-(_Gnd, _Var, _Goals)|Tail], 0, Left1, Worst0, Worst1, List0, List1) :-
Prob =< Worst0, !,
keepbest(Tail, 0, Left1, Worst0, Worst1, List0, List1).
keepbest([Prob-(Gnd, Var, Goals)|Tail], 0, Left1, Worst0, Worst1, List0, List1) :-
Prob > Worst0, !,
discard(Prob-(Gnd, Var, Goals), List0, List2, Worst2),
keepbest(Tail, 0, Left1, Worst2, Worst1, List2, List1).
keepbest([Prob-(Gnd, Var, Goals)|Tail], Left0, Left1, Worst0, Worst1, List0, List1) :-
insert(Prob-(Gnd, Var, Goals), List0, Worst0, List2, Worst2),
Left2 is Left0 - 1,
keepbest(Tail, Left2, Left1, Worst2, Worst1, List2, List1).
/* insert(Prob-(Gnd, Var, Goals), Sorted0, Worst0, Sorted1, Worst1)
* ----------------------------------------------------------------
* This tail recursive predicate inserts the given quad into the given sorted
* list and returns the final sorted list. The input list must be sorted.
* It also updates the prob value of the worst quad.
*
* INPUT
* - Prob-(Gnd, Var, Goals): quad to insert.
* - Sorted0: sorted list to insert the quad into.
* - Worst0: current worst prob value.
*
* OUTPUT
* - Sorted1: the final sorted list.
* - Worst1: the final worst prob value.
*/
insert(Prob-(Gnd, Var, Goals), [], _Worst, [Prob-(Gnd, Var, Goals)], Prob).
insert(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst, [Prob-(Gnd, Var, Goals), Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst) :-
Prob >= Prob_i, !.
insert(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i)|Tail], Worst0, [Prob_i-(Gnd_i, Var_i, Goals_i)|Next], Worst1) :-
Prob < Prob_i, !,
insert(Prob-(Gnd, Var, Goals), Tail, Worst0, Next, Worst1).
/* discard(Prob-(Gnd, Var, Goals), Sorted0, Sorted1, Worst)
* --------------------------------------------------------
* This tail recursive predicate inserts the given quad into the given sorted
* list, removes the last quad from it and returns the final sorted list.
* The given sorted list contains at least one quad and must be sorted.
* Previous worst prob value is not needed because it necessarely changes and
* the new value is not known in advance.
* It also updates the prob value of the worst quad.
*
* INPUT
* - Prob-(Gnd, Var, Goals): quad to insert.
* - Sorted0: sorted list to insert the quad into.
*
* OUTPUT
* - Sorted1: the final sorted list.
* - Worst: the final worst prob value.
*/
discard(Prob-(Gnd, Var, Goals), [_Prob_i-(_Gnd_i, _Var_i, _Goals_i)], [Prob-(Gnd, Var, Goals)], Prob) :- !.
discard(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i), Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], [Prob-(Gnd, Var, Goals)|Next], Worst) :-
Prob >= Prob_i, !,
discard(Prob_i-(Gnd_i, Var_i, Goals_i), [Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], Next, Worst).
discard(Prob-(Gnd, Var, Goals), [Prob_i-(Gnd_i, Var_i, Goals_i), Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], [Prob_i-(Gnd_i, Var_i, Goals_i)|Next], Worst) :-
Prob < Prob_i, !,
discard(Prob-(Gnd, Var, Goals), [Prob_l-(Gnd_l, Var_l, Goals_l)|Tail], Next, Worst).
/* eval_lower(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the lower bound by
* running an external command (BDD resolution via files).
*/
eval_lower(Number, Prob) :-
low(Number, Prob).
eval_lower(Number, ProbLow) :-
Number > 0,
low(OldNumber, _),
Number \= OldNumber,
bdd_ptree_map(1, 'bddl.txt', 'bddl.par', 'bddl.map'),
run_file('bddl.txt', 'bddl.par', NewProbLow),
(NewProbLow = timeout ->
low(_, ProbLow);
ProbLow = NewProbLow,
retract(low(_, _)),
assert(low(Number, ProbLow))).
/* eval_upper(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the upper bound by
* running an external command (BDD resolution via files).
*/
eval_upper(0, ProbUp) :- !,
low(_, ProbUp).
eval_upper(_Number, ProbUp) :-
bdd_ptree_map(3, 'bddu.txt', 'bddu.par', 'bddu.map'),
run_file('bddu.txt', 'bddu.par', NewProbUp),
(NewProbUp = timeout->
up(ProbUp);
ProbUp = NewProbUp,
retract(up(_)),
assert(up(ProbUp))).
/* run_file(BDDFile, BDDParFile, Prob)
* -----------------------------------
* This predicate calls for the resolution of a BDD via file.
*/
run_file(BDDFile, BDDParFile, Prob) :-
ResultFile = 'result.txt',
library_directory(Dir),
setting(timeout, BDDTime),
(BDDTime = no ->
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' > ', ResultFile], Command);
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' -t ', BDDTime,' > ', ResultFile], Command)),
%statistics(walltime,_),
shell(Command, Return),
(Return =\= 0 ->
Status = timeout,
Prob = Status;
see(ResultFile),
read(elapsed_construction(_TimeConstruction)),
read(probability(Prob)),
read(elapsed_traversing(_TimeTraversing)),
seen,
%write(probability(Prob)),nl,
%read(_),
%delete_file(ResultFile),
Status = ok
% format("Construction time ~f traversing time ~f~Number",[TimeConstruction, TimeTraversing])
).
%statistics(walltime,[_,E3]),
%format(user,'~w ms BDD processing~Number',[E3]),
% format("Status ~a~Number",[Status]).
/* insert_full_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the ground part of the given list in a trie.
*/
insert_full_ptree([], _Trie).
insert_full_ptree([_Prob-(Gnd, _Var, _Goals)|Tail], Trie) :-
reverse(Gnd, Gnd1),
insert_ptree(Gnd1, Trie),
insert_full_ptree(Tail, Trie).
/* insert_list_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the given list in a trie.
*/
insert_list_ptree([], _Trie).
insert_list_ptree([Head|Tail], Trie) :-
reverse(Head, Head1),
insert_ptree(Head1, Trie),
insert_list_ptree(Tail, Trie).

352
packages/cplint/approx/.svn/text-base/deepdyn.pl.svn-base Normal file
View File

@@ -0,0 +1,352 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File deepit.pl
* Goal oriented interpreter for LPADs based on SLDNF
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- 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(system)).
:- use_module(library(ugraphs)).
:- use_module(params).
:- use_module(tptreefile).
:- use_module(utility).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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, ProbLow, ProbUp, ResTime, BddTime)
* ---------------------------------------------------
* This predicate computes the probability of a given list of goals using an
* iterative deepening algorithm. It also returns the number of handled BDDs and
* CPUTime spent in performing resolution and in handling the BDDs.
*
* INPUT
* - GoalsList: given list of goal to work on.
*
* OUTPUT
* - ProbLow: the resulting lowerbound probability for the given list of goals.
* - ProbUp: the resulting upperbound probability for the given list of goals.
* - ResTime: cpu time spent on performing resolution.
* - BddTime: cpu time spent on handling BDDs.
*/
solve(GoalsList, ProbLow,ProbUp, ResTime, BddTime):-
setting(min_error, MinError),
setting(prob_step, ProbStep),
LogProbStep is log(ProbStep),
assert(low(0,0.0)),
assert(up(1.0)),
init_ptree(1),
% NB: log(1.0) == 0.0 !!!
deepdyn([0.0-([], [], GoalsList)], 0, MinError, LogProbStep, ProbLow, ProbUp, 0, ResTime, 0, BddTime),
delete_ptree(1),
retract(low(_,_)),
retract(up(_)).
/* solve_t(L0,Succ,PB,ProbL0,ProbU0) L0 is a list of quadruples (CG,C,P,G) where
CG is the list of ground choices, C is the list of non-ground choices,
P is the probability of CG, G is the list of goals to be resolved,
Succ is the list of explanations found so far, PB is the current prob bound,
ProbL0,ProbU0 are the lower/upper prob bounds */
deepdyn(GoalsList, Number, MinError, ProbStep, LowerProb1, UpperProb1, ResTime0, ResTime1, BddTime0, BddTime1) :-
% Resetting the clocks...
statistics(walltime, [_, _]),
% Performing resolution...
findall(Prob1-(Gnd1, Var1, Goals1),
(member(Prob0-(Gnd0, Var0, Goals0), GoalsList), ProbBound is log(Prob0) + ProbStep, explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))),
List),
% Taking elapsed times...
statistics(walltime, [_, ElapResTime]),
ResTime2 is ResTime0 + ElapResTime/1000,
% Building and solving equivalent bdds...
init_ptree(2),
init_ptree(3),
separate(List, [], LowerList0, [], UpperList, [], Incomplete),
insert_list_ptree(LowerList0, 1),
insert_list_ptree(UpperList, 2),
merge_ptree(1,2,3),
length(LowerList0, DeltaLow),
Next is Number + DeltaLow,
eval_lower(Next, ProbLow),
length(UpperList, DeltaUp),
Temp is Next + DeltaUp,
eval_upper(Temp, ProbUp),
delete_ptree(2),
delete_ptree(3),
% Taking elapsed times...
statistics(walltime, [_, ElapBddTime]),
BddTime2 is BddTime0 + (ElapBddTime / 1000),
% Is the current error lower than the minimum error?
(ProbUp - ProbLow < MinError ->
% Setting output parameters' values...
LowerProb1 = ProbLow,
UpperProb1 = ProbUp,
ResTime1 = ResTime2,
BddTime1 = BddTime2;
% Keeping on iterating with accumulated values...
% sufficient without negation:
% D1 = DB,
% necessary for negation
deepdyn(Incomplete, Next, MinError, ProbStep, LowerProb1, UpperProb1, ResTime2, ResTime1, BddTime2, BddTime1)).
/* separate(List, Low, Up, Next)
* ----------------------------------
* This tail recursive predicate parses the input list and builds the list for
* the lower bound, the upper bound and the pending goals.
* The upper bound list contains both the items of the lower bound list and the
* incomplete ones.
*
* INPUT
* - List: input list.
*
* OUTPUT
* - Low: list for lower bound.
* - Up: list for upper bound.
* - Next: list of pending goals.
*/
separate(List, Low, Up, Next) :-
%% Polarization: initial low, up and next lists are empty.
separate(List, [], Low, [], Up, [], Next).
separate([], Low, Low, Up, Up, Next, Next) :- !.
%% Closing condition: stop if no more results (current lists are now final lists).
separate([_Prob-(Gnd0, [], [])|Tail], Low0, [Gnd0|Low1], Up0, [Gnd0|Up1], Next0, Next1) :- !,
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate([Prob0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Gnd1|Up1], Next0, [Prob1-(Gnd1, Var1, Goals)|Next1]) :-
get_groundc(Var0, Gnd2, Var1, 1.0, Prob2),
append(Gnd0, Gnd2, Gnd1),
Prob1 is Prob0 + log(Prob2),
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
/* explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))
* --------------------------------------------------------------------------
* This tail recursive predicate reads current explanation and returns the
* explanation after the current iteration without dropping below the given
* probability bound.
*
* INPUT
* - ProbBound: the desired probability bound;
* - Prob0-(Gnd0, Var0, Goals0): current explanation
* - Gnd0: list of current ground choices,
* - Var0: list of current non-ground choices,
* - Prob0: probability of Gnd0,
* - Goals0: list of current goals.
*
* OUTPUT
* - Prob1-(Gnd1, Var1, Prob1, Goals1): explanation after current iteration
* - Gnd1: list of final ground choices,
* - Var1: list of final non-ground choices,
* - Prob1: probability of Gnd1,
* - Goals1: list of final goals.
*/
explore(_ProbBound, Prob-(Gnd, Var, []), Prob-(Gnd, Var, [])) :- !.
%% Closing condition: stop if no more goals (input values are output values).
explore(ProbBound, Prob-(Gnd, Var, Goals), Prob-(Gnd, Var, Goals)) :-
%% Closing condition: stop if bound has been reached (input values are output values).
Prob =< ProbBound, !.
% Negation, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call((\+ Head)),
explore(ProbBound, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
%% Recursive call: consider next goal (building next values)
% Negation
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- !,
list2and(HeadList, Head), % ...
findall(Prob-(Gnd, Var, CurrentGoals), explore(ProbBound, 0.0-([], [], HeadList), Prob-(Gnd, Var, CurrentGoals)), List) ->
separate(List, [], LowerBound, [], _UpperBound, [], PendingGoals),
(PendingGoals \= [] ->
Var2 = Var0,
Gnd2 = Gnd0,
Goals1 = [\+ Head|Goals],
explore(ProbBound, Prob0-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals));
%% Recursive call: consider next goal (building next values)
choose_clausesc(Gnd0, Var0, LowerBound, Var),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1))).
%% Recursive call: consider next goal (building next values)
% Main, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call(Head),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, def_rule
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
def_rule(Head, Goals0),
append(Goals0, Tail, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, find_rulec
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
find_rulec(Head, (R, S, N), Goals, Var0, _Prob),
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals)) :-
(member_eq((N, R, S), Var0);
member_eq((N, R, S), Gnd0)), !,
append(Goals, Goals0, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals)).
% Recursive call: consider next goal (building next values)
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) :-
append(Var0, [(N, R, S)], Var),
append(Goals, Goals0, Goals2),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
/* eval_lower(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the lower bound by
* running an external command (BDD resolution via files).
*/
eval_lower(Number, Prob) :-
low(Number, Prob).
eval_lower(Number, ProbLow) :-
Number > 0,
low(OldNumber, _),
Number \= OldNumber,
bdd_ptree_map(1, 'bddl.txt', 'bddl.par', 'bddl.map'),
run_file('bddl.txt', 'bddl.par', NewProbLow),
(NewProbLow = timeout ->
low(_, ProbLow);
ProbLow = NewProbLow,
retract(low(_, _)),
assert(low(Number, ProbLow))).
/* eval_upper(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the upper bound by
* running an external command (BDD resolution via files).
*/
eval_upper(0, ProbUp) :- !,
low(_, ProbUp).
eval_upper(_Number, ProbUp) :-
bdd_ptree_map(3, 'bddu.txt', 'bddu.par', 'bddu.map'),
run_file('bddu.txt', 'bddu.par', NewProbUp),
(NewProbUp = timeout->
up(ProbUp);
ProbUp = NewProbUp,
retract(up(_)),
assert(up(ProbUp))).
/* run_file(BDDFile, BDDParFile, Prob)
* -----------------------------------
* This predicate calls for the resolution of a BDD via file.
*/
run_file(BDDFile, BDDParFile, Prob) :-
ResultFile = 'result.txt',
library_directory(Dir),
setting(timeout, BDDTime),
(BDDTime = no ->
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' > ', ResultFile], Command);
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' -t ', BDDTime,' > ', ResultFile], Command)),
%statistics(walltime,_),
shell(Command, Return),
(Return =\= 0 ->
Status = timeout,
Prob = Status;
see(ResultFile),
read(elapsed_construction(_TimeConstruction)),
read(probability(Prob)),
read(elapsed_traversing(_TimeTraversing)),
seen,
%write(probability(Prob)),nl,
%read(_),
%delete_file(ResultFile),
Status = ok
% format("Construction time ~f traversing time ~f~Number",[TimeConstruction, TimeTraversing])
).
%statistics(walltime,[_,E3]),
%format(user,'~w ms BDD processing~Number',[E3]),
% format("Status ~a~Number",[Status]).
/* insert_list_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the given list in a trie.
*/
insert_list_ptree([], _Trie).
insert_list_ptree([Head|Tail], Trie) :-
reverse(Head, Head1),
insert_ptree(Head1, Trie),
insert_list_ptree(Tail, Trie).

352
packages/cplint/approx/.svn/text-base/deepit.pl.svn-base Normal file
View File

@@ -0,0 +1,352 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File deepit.pl
* Goal oriented interpreter for LPADs based on SLDNF
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- 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(system)).
:- use_module(library(ugraphs)).
:- use_module(params).
:- use_module(tptreefile).
:- use_module(utility).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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, ProbLow, ProbUp, ResTime, BddTime)
* ---------------------------------------------------
* This predicate computes the probability of a given list of goals using an
* iterative deepening algorithm. It also returns the number of handled BDDs and
* CPUTime spent in performing resolution and in handling the BDDs.
*
* INPUT
* - GoalsList: given list of goal to work on.
*
* OUTPUT
* - ProbLow: the resulting lowerbound probability for the given list of goals.
* - ProbUp: the resulting upperbound probability for the given list of goals.
* - ResTime: cpu time spent on performing resolution.
* - BddTime: cpu time spent on handling BDDs.
*/
solve(GoalsList, ProbLow,ProbUp, ResTime, BddTime):-
setting(min_error, MinError),
setting(prob_bound, ProbBound),
LogProbBound is log(ProbBound),
assert(low(0,0.0)),
assert(up(1.0)),
init_ptree(1),
% NB: log(1.0) == 0.0 !!!
deepit([0.0-([], [], GoalsList)], 0, MinError, LogProbBound, ProbLow, ProbUp, 0, ResTime, 0, BddTime),
delete_ptree(1),
retract(low(_,_)),
retract(up(_)).
/* solve_t(L0,Succ,PB,ProbL0,ProbU0) L0 is a list of quadruples (CG,C,P,G) where
CG is the list of ground choices, C is the list of non-ground choices,
P is the probability of CG, G is the list of goals to be resolved,
Succ is the list of explanations found so far, PB is the current prob bound,
ProbL0,ProbU0 are the lower/upper prob bounds */
deepit(GoalsList, Number, MinError, ProbBound, LowerProb1, UpperProb1, ResTime0, ResTime1, BddTime0, BddTime1) :-
% Resetting the clocks...
statistics(walltime, [_, _]),
% Performing resolution...
findall(Prob1-(Gnd1, Var1, Goals1),
(member(Prob0-(Gnd0, Var0, Goals0), GoalsList), explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))),
List),
% Taking elapsed times...
statistics(walltime, [_, ElapResTime]),
ResTime2 is ResTime0 + ElapResTime/1000,
% Building and solving equivalent bdds...
init_ptree(2),
init_ptree(3),
separate(List, [], LowerList0, [], UpperList, [], Incomplete),
insert_list_ptree(LowerList0, 1),
insert_list_ptree(UpperList, 2),
merge_ptree(1,2,3),
length(LowerList0, DeltaLow),
Next is Number + DeltaLow,
eval_lower(Next, ProbLow),
length(UpperList, DeltaUp),
Temp is Next + DeltaUp,
eval_upper(Temp, ProbUp),
delete_ptree(2),
delete_ptree(3),
% Taking elapsed times...
statistics(walltime, [_, ElapBddTime]),
BddTime2 is BddTime0 + (ElapBddTime / 1000),
% Is the current error lower than the minimum error?
(ProbUp - ProbLow < MinError ->
% Setting output parameters' values...
LowerProb1 = ProbLow,
UpperProb1 = ProbUp,
ResTime1 = ResTime2,
BddTime1 = BddTime2;
% Keeping on iterating with accumulated values...
% sufficient without negation:
% D1 = DB,
% necessary for negation
deepit(Incomplete, Next, MinError, ProbBound, LowerProb1, UpperProb1, ResTime2, ResTime1, BddTime2, BddTime1)).
/* separate(List, Low, Up, Next)
* ----------------------------------
* This tail recursive predicate parses the input list and builds the list for
* the lower bound, the upper bound and the pending goals.
* The upper bound list contains both the items of the lower bound list and the
* incomplete ones.
*
* INPUT
* - List: input list.
*
* OUTPUT
* - Low: list for lower bound.
* - Up: list for upper bound.
* - Next: list of pending goals.
*/
separate(List, Low, Up, Next) :-
%% Polarization: initial low, up and next lists are empty.
separate(List, [], Low, [], Up, [], Next).
separate([], Low, Low, Up, Up, Next, Next) :- !.
%% Closing condition: stop if no more results (current lists are now final lists).
separate([_Prob-(Gnd0, [], [])|Tail], Low0, [Gnd0|Low1], Up0, [Gnd0|Up1], Next0, Next1) :- !,
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
separate([Prob0-(Gnd0, Var0, Goals)|Tail], Low0, Low1, Up0, [Gnd1|Up1], Next0, [Prob1-(Gnd1, Var1, Goals)|Next1]) :-
get_groundc(Var0, Gnd2, Var1, 1.0, Prob2),
append(Gnd0, Gnd2, Gnd1),
Prob1 is Prob0 + log(Prob2),
separate(Tail, Low0, Low1, Up0, Up1, Next0, Next1).
/* explore(ProbBound, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1))
* --------------------------------------------------------------------------
* This tail recursive predicate reads current explanation and returns the
* explanation after the current iteration without dropping below the given
* probability bound.
*
* INPUT
* - ProbBound: the desired probability bound;
* - Prob0-(Gnd0, Var0, Goals0): current explanation
* - Gnd0: list of current ground choices,
* - Var0: list of current non-ground choices,
* - Prob0: probability of Gnd0,
* - Goals0: list of current goals.
*
* OUTPUT
* - Prob1-(Gnd1, Var1, Prob1, Goals1): explanation after current iteration
* - Gnd1: list of final ground choices,
* - Var1: list of final non-ground choices,
* - Prob1: probability of Gnd1,
* - Goals1: list of final goals.
*/
explore(_ProbBound, Prob-(Gnd, Var, []), Prob-(Gnd, Var, [])) :- !.
%% Closing condition: stop if no more goals (input values are output values).
explore(ProbBound, Prob-(Gnd, Var, Goals), Prob-(Gnd, Var, Goals)) :-
%% Closing condition: stop if bound has been reached (input values are output values).
Prob =< ProbBound, !.
% Negation, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call((\+ Head)),
explore(ProbBound, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
%% Recursive call: consider next goal (building next values)
% Negation
explore(ProbBound, Prob0-(Gnd0, Var0, [\+ Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :- !,
list2and(HeadList, Head), % ...
findall(Prob-(Gnd, Var, CurrentGoals), explore(ProbBound, 0.0-([], [], HeadList), Prob-(Gnd, Var, CurrentGoals)), List) ->
separate(List, [], LowerBound, [], _UpperBound, [], PendingGoals),
(PendingGoals \= [] ->
Var2 = Var0,
Gnd2 = Gnd0,
Goals1 = [\+ Head|Goals],
explore(ProbBound, Prob0-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals));
%% Recursive call: consider next goal (building next values)
choose_clausesc(Gnd0, Var0, LowerBound, Var),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1))).
%% Recursive call: consider next goal (building next values)
% Main, builtin
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
builtin(Head), !,
call(Head),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Tail), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, def_rule
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
def_rule(Head, Goals0),
append(Goals0, Tail, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
% Main, find_rulec
explore(ProbBound, Prob0-(Gnd0, Var0, [Head|Tail]), Prob1-(Gnd1, Var1, Goals1)) :-
find_rulec(Head, (R, S, N), Goals, Var0, _Prob),
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Tail), Prob1-(Gnd1, Var1, Goals1)).
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals)) :-
(member_eq((N, R, S), Var0);
member_eq((N, R, S), Gnd0)), !,
append(Goals, Goals0, Goals2),
get_groundc(Var0, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals)).
% Recursive call: consider next goal (building next values)
explore_pres(ProbBound, R, S, N, Goals, Prob0-(Gnd0, Var0, Goals0), Prob1-(Gnd1, Var1, Goals1)) :-
append(Var0, [(N, R, S)], Var),
append(Goals, Goals0, Goals2),
get_groundc(Var, Gnd, Var2, 1, Prob),
append(Gnd0, Gnd, Gnd2),
Prob2 is Prob0 + log(Prob),
explore(ProbBound, Prob2-(Gnd2, Var2, Goals2), Prob1-(Gnd1, Var1, Goals1)).
% Recursive call: consider next goal (building next values)
/* eval_lower(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the lower bound by
* running an external command (BDD resolution via files).
*/
eval_lower(Number, Prob) :-
low(Number, Prob).
eval_lower(Number, ProbLow) :-
Number > 0,
low(OldNumber, _),
Number \= OldNumber,
bdd_ptree_map(1, 'bddl.txt', 'bddl.par', 'bddl.map'),
run_file('bddl.txt', 'bddl.par', NewProbLow),
(NewProbLow = timeout ->
low(_, ProbLow);
ProbLow = NewProbLow,
retract(low(_, _)),
assert(low(Number, ProbLow))).
/* eval_upper(Number, Prob)
* ------------------------
* This predicate evaluates if there are proofs for the upper bound by
* running an external command (BDD resolution via files).
*/
eval_upper(0, ProbUp) :- !,
low(_, ProbUp).
eval_upper(_Number, ProbUp) :-
bdd_ptree_map(3, 'bddu.txt', 'bddu.par', 'bddu.map'),
run_file('bddu.txt', 'bddu.par', NewProbUp),
(NewProbUp = timeout->
up(ProbUp);
ProbUp = NewProbUp,
retract(up(_)),
assert(up(ProbUp))).
/* run_file(BDDFile, BDDParFile, Prob)
* -----------------------------------
* This predicate calls for the resolution of a BDD via file.
*/
run_file(BDDFile, BDDParFile, Prob) :-
ResultFile = 'result.txt',
library_directory(Dir),
setting(timeout, BDDTime),
(BDDTime = no ->
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' > ', ResultFile], Command);
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' -t ', BDDTime,' > ', ResultFile], Command)),
%statistics(walltime,_),
shell(Command, Return),
(Return =\= 0 ->
Status = timeout,
Prob = Status;
see(ResultFile),
read(elapsed_construction(_TimeConstruction)),
read(probability(Prob)),
read(elapsed_traversing(_TimeTraversing)),
seen,
%write(probability(Prob)),nl,
%read(_),
%delete_file(ResultFile),
Status = ok
% format("Construction time ~f traversing time ~f~Number",[TimeConstruction, TimeTraversing])
).
%statistics(walltime,[_,E3]),
%format(user,'~w ms BDD processing~Number',[E3]),
% format("Status ~a~Number",[Status]).
/* insert_list_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the given list in a trie.
*/
insert_list_ptree([], _Trie).
insert_list_ptree([Head|Tail], Trie) :-
reverse(Head, Head1),
insert_ptree(Head1, Trie),
insert_list_ptree(Tail, Trie).

235
packages/cplint/approx/.svn/text-base/exact.pl.svn-base Normal file
View File

@@ -0,0 +1,235 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File best.pl
* Goal oriented interpreter for LPADs based on SLDNF
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- 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(system)).
:- use_module(library(ugraphs)).
:- use_module(params).
:- use_module(tptreefile).
:- use_module(utility).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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...
init_ptree(1),
fatto(List),
insert_list_ptree(List, 1),
bdd_ptree_map(1, 'bdd.txt', 'bdd.par', 'bdd.map'),
delete_ptree(1),
run_file('bdd.txt','bdd.par', Temp),
(Temp == timeout ->
Prob is -1.0;
Prob is Temp),
% 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).
/* run_file(BDDFile, BDDParFile, Prob)
* -----------------------------------
* This predicate calls for the resolution of a BDD via file.
*/
run_file(BDDFile, BDDParFile, Prob) :-
ResultFile = 'result.txt',
library_directory(Dir),
setting(timeout, BDDTime),
(BDDTime = no ->
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' > ', ResultFile], Command);
atomic_concat([Dir, '/LPADBDD -l ', BDDFile, ' -i ', BDDParFile,' -t ', BDDTime,' > ', ResultFile], Command)),
%statistics(walltime,_),
shell(Command, Return),
(Return =\= 0 ->
Status = timeout,
Prob = Status;
see(ResultFile),
read(elapsed_construction(_TimeConstruction)),
read(probability(Prob)),
read(elapsed_traversing(_TimeTraversing)),
seen,
%write(probability(Prob)),nl,
%read(_),
%delete_file(ResultFile),
Status = ok
% format("Construction time ~f traversing time ~f~Number",[TimeConstruction, TimeTraversing])
).
%statistics(walltime,[_,E3]),
%format(user,'~w ms BDD processing~Number',[E3]),
% format("Status ~a~Number",[Status]).
/* insert_list_ptree([Head|Tail], Trie)
* ------------------------------------
* This predicate inserts the given list in a trie.
*/
insert_list_ptree([], _Trie).
insert_list_ptree([Head|Tail], Trie) :-
reverse(Head, Head1),
insert_ptree(Head1, Trie),
insert_list_ptree(Tail, Trie).

189
packages/cplint/approx/.svn/text-base/exact_mem.pl.svn-base Normal file
View File

@@ -0,0 +1,189 @@
/*==============================================================================
* 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).

275
packages/cplint/approx/.svn/text-base/montecarlo.pl.svn-base Normal file
View File

@@ -0,0 +1,275 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File: montecarlo.pl
* Solves LPADs with Monte Carlo (main predicate: solve(Goals, Prob, Samples, ResTime, BddTime)
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
/* EXTERNAL FILE
* -------------
* The following libraries are required by the program to work fine.
*/
:- dynamic rule/4, def_rule/2, randx/1, randy/1, randz/1.
:- use_module(library(lists)).
:- use_module(library(random)).
:- use_module(library(ugraphs)).
:- use_module(params).
% :- source.
% :- yap_flag(single_var_warnings, on).
/* 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.
*/
/* Starting seed. */
randx(1).
randy(1).
randz(1).
/* newsample
* ---------
* This predicate programmatically generates and sets a new seed for the
* algorithm.
*/
newsample :-
retract(randx(X)),
randy(Y),
randz(Z),
(X =< 30269 ->
SuccX is X + 1,
assert(randx(SuccX));
assert(randx(1)),
retract(randy(_)),
(Y =< 30307 ->
SuccY is Y + 1,
assert(randy(SuccY));
assert(randy(1)),
retract(randz(_)),
(Z =< 30323 ->
SuccZ is Z + 1,
assert(randz(SuccZ));
assert(randz(1))))),
setrand(rand(X, Y, Z)).
/* solve(Goals, Samples, Time, Lower, Prob, Upper)
* -----------------------------------------------
* This predicate calls the Monte Carlo solving method for the current problem.
* It requires the Goals to fulfil and returns the number of Samples considered,
* the Time required, the extimated Probability and the Lower and Upper bounds.
*
* INPUT
* - Goals: given list of goals to fulfil.
*
* OUTPUT
* - Samples: number of samples considered to solve the problem.
* - Time: time required to solve the problem.
* - Lower: lower end of the confidence interval.
* - Prob: extimated probability.
* - Upper: upper end of the confidence interval.
*/
solve(Goals, Samples, Time, Lower, Prob, Upper) :-
% Retrieving functional parameters...
setting(k, K),
setting(min_error, MinError),
% Resetting the clocks...
statistics(walltime, [_, _]),
% Performing resolution...
montecarlo(0, 0, Goals, K, MinError, Samples, Lower, Prob, Upper),
% Taking elapsed times...
statistics(walltime, [_, ElapTime]),
% Setting values...
Time is ElapTime/1000.
/* montecarlo(Count, Success, Goals, K, MinError, Samples, Lower, Prob, Upper)
* ---------------------------------------------------------------------------
* This tail recursive predicate solves the problem currently in memory with a
* Monte Carlo approach.
* It requires the number of samples and successes so far (Count and Success),
* the desired list of Goals to fulfil, the number K of samples to consider at
* once and the threshold MinError for the binomial proportion confidence
* interval.
* It returns the total number of Samples considered, the Lower and Upper ends
* of the the binomial proportion confidence interval and the extimated Prob.
*
* INPUT
* - Count: number of samples considered so far.
* - Success: number of successfull samples considered so far.
* - Goals: list of goals to fulfil.
* - K: number of samples to consider at once.
* - MinError: threshold for the binomial proportion confidence interval.
*
* OUTPUT
* - Samples: total number of samples considered.
* - Lower: lower end of the the binomial proportion confidence interval.
* - Prob: extimated probability.
* - Upper: upper end of the the binomial proportion confidence interval.
*
* NB: This method is based on the binomial proportion confidence interval and
* the Brown's rule of thumb to avoid the case the sample proportion is
* exactly 0.0 or 1.0 and doesn't make use of BDDs.
*/
montecarlo(Count, Success, Goals, K, MinError, Samples, Lower, Prob, Upper) :-
/* Decomment the following line if you want to test the algorithm with an
incremental seed for each sample.
newsample,
*/
main(Goals, [], _Explan, Valid),
N is Count + 1,
S is Success + Valid,
(N mod K =:= 0 ->
% format("Advancement: ~t~d/~d~30+~n", [S, N]),
P is S / N,
D is N - S,
Semi is 2 * sqrt(P * (1 - P) / N),
Int is 2 * Semi,
/* N * P > 5; N * S / N > 5; S > 5
* N (1 - P) > 5; N (1 - S / N) > 5; N (N - S) / N > 5; N - S > 5
*/
((S > 5, D > 5, (Int < MinError; Int =:= 0)) ->
Samples is N,
Lower is P - Semi,
Prob is P,
Upper is P + Semi;
montecarlo(N, S, Goals, K, MinError, Samples, Lower, Prob, Upper));
montecarlo(N, S, Goals, K, MinError, Samples, Lower, Prob, Upper)).
/* null
* ----
* This is dummy predicate to use sparingly when needed.
* Typical uses are as spying predicate during tracing or as dead branch in
* ( -> ; ) predicate.
*/
null.
/* main(Goals, Explan0, Explan1, Valid)
* ------------------------------------
* This tail recursive predicate looks for a solution to the given Goals
* starting from the given Explan0 and returns the final Explan and 1 (0 otherwise) if it is a
* Valid sample for Montecarlo.
*/
main([], Explan, Explan, 1).
main([\+ Goal|Tail], Explan0, Explan1, Valid) :-
builtin(Goal), !,
(call((\+ Goal)) ->
main(Tail, Explan0, Explan1, Valid);
Explan1 = Explan0,
Valid = 0).
main([Goal|Tail], Explan0, Explan1, Valid) :-
builtin(Goal), !,
(call(Goal) ->
main(Tail, Explan0, Explan1, Valid);
Explan1 = Explan0,
Valid = 0).
main([Goal|Tail], Explan0, Explan1, Valid) :-
findall((IsSample, Goals, Step), explore([Goal|Tail], Explan0, IsSample, Goals, Step), List),
cycle(List, Explan0, Explan1, Valid).
/* explore([Goal|Tail], Explan, Valid, Goals, Step)
* ------------------------------------------------
* This predicate looks for a Body and the Step to reach it from the given Goal
* and Explan and returns 1 (0 otherwise) if they are a Valid sample for
* Montecarlo.
* Please note that Body and Step are meaningfull only when Valid is 1.
*
* This comment has to be fixed.
*/
explore([Goal|Tail], _Explan, 1, Goals, []) :-
def_rule(Goal, Body),
append(Body, Tail, Goals).
explore([Goal|Tail], Explan, Valid, Goals, Step) :-
findrule(Goal, Explan, Valid, Body, (HeadID, RuleID, Subst)),
append(Body, Tail, Goals),
(member_eq((HeadID, RuleID, Subst), Explan) ->
Step = [];
Step = [(HeadID, RuleID, Subst)]).
/* findrule(Goal, Explan, Valid, Body, (HeadID, RuleID, Subst))
* ---------------------------------------------------------------
* This predicate finds a rule that matches with the given Goal and Explan and
* returns 1 (0 otherwise) if it is a Valid sample for Montecarlo.
* If the sample is Valid, the other return parameters are also meaningfull and
* are the Body and (RuleID, Subst, HeadIS) of the rule that matches with the
* given Goal and Explan.
*
* This comment has to be fixed.
*/
findrule(Goal, Explan, Valid, Body, (HeadId, RuleId, Subst)) :-
rule(Goal, _Prob, Required, RuleId, Subst, _Heads, HeadsList, Body),
sample(HeadsList, HeadId),
not_already_present_with_a_different_head(HeadId, RuleId, Subst, Explan),
(HeadId =:= Required ->
Valid = 1;
Valid = 0).
/* sample(Heads, RuleId, HeadId, Subst)
* ------------------------------------
* This tail recursive predicate samples a random head among the given Heads of
* the given RuleId and returns its HeadId and Subst.
*/
sample(HeadList, HeadId) :-
random(Prob),
sample(HeadList, 0, 0, Prob, HeadId), !.
sample([_HeadTerm:HeadProb|Tail], Index, Prev, Prob, HeadId) :-
Succ is Index + 1,
Next is Prev + HeadProb,
(Prob =< Next ->
HeadId = Index;
sample(Tail, Succ, Next, Prob, HeadId)).
/* cycle([(IsSample, Body, [Step])|Tail], Explan0, Explan1, Found)
* -----------------------------------------------------------------
* This tail recursive predicate analyzes the given Body and Step to reach it
* and returns 0 as it's not a Valid sample for Montecarlo.
* If it is Valid, it looks for a solution to the Body and the given Goals
* starting from the Step and the given Explan and returns 1 if it finds a
* Valid one.
* If it does not find it, it considers the next Body and Step and returns their
* Valid value.
*
* NB: This comment needs to be updated.
*/
cycle([], Explan, Explan, 0).
cycle([(0, _Goals, Step)|Tail], Explan0, Explan1, IsSample) :- !,
append(Step, Explan0, Explan2),
cycle(Tail, Explan2, Explan1, IsSample).
cycle([(1, Goals, Step)|Tail], Explan0, Explan1, IsSample) :-
append(Step, Explan0, Explan),
main(Goals, Explan, Explan2, Valid),
(Valid == 1 ->
Explan1 = Explan2,
IsSample = 1;
cycle(Tail, Explan2, Explan1, IsSample)).

122
packages/cplint/approx/.svn/text-base/params.pl.svn-base Normal file
View File

@@ -0,0 +1,122 @@
/*==============================================================================
* LPAD and CP-Logic reasoning suite
* File: params.pl
* Defines and sets parameters needed by other predicates (main: set).
* Copyright (c) 2009, Stefano Bragaglia
*============================================================================*/
:- dynamic setting/2.
% :- source.
% :- yap_flag(single_var_warnings, on).
/* PARAMETER LIST
* --------------
* The following list of parameters declares a few constants used along the
* program.
* The default value for each parameter can be changed using the following
* predicate:
*
* set(Parameter, Value).
*/
/* epsilon_parsing
* ---------------
* This parameter shows the probability's granularity during parsing.
*
* Default value: 0.00001
* Applies to: parsing
*/
setting(epsilon_parsing, 0.00001).
/* ground_body
* -----------
* This parameter tells if both the head and the body of each clause must be
* ground, or else the head only.
* In case the body contains variables not present in the head, it represents
* an existential event.
*
* Default value: false
* Applies to: parsing
*/
setting(ground_body, false).
/* k
* -
* This parameter shows the amount of items of the same type to consider at once.
*
* Default value: 64
* Applies to: bestfirst, bestk, montecarlo
*/
setting(k, 64).
/* min_error
* ---------
* This parameter shows the threshold for the probability interval.
*
* Default value: 0.01
* Applies to: bestfirst, montecarlo
*/
setting(min_error, 0.01).
/* prob_bound
* ----------
* This parameter shows the initial probability bound in a probability bounded
* method.
*
* Default value: 0.01
* Applies to: deepit
*/
setting(prob_bound, 0.001).
/* prob_step
* ---------
* This parameter shows the probability deepening step in a probability bounded
* method.
*
* Default value: 0.001
* Applies to: bestfirst, bestk
*/
setting(prob_step, 0.001).
/* save_dot
* --------
* This parameter tells if a .dot file for variables has be created.
*
* Default value: false
* Applies to: bestfirst, bestk, exact
*/
setting(save_dot, false).
/* timeout
* -------
* This parameter shows the time to wait before killing a bdd solving process.
*
* Default value: 300
* Applies to: bestfirst, bestk, exact
*/
setting(timeout, 300).
/* PREDICATES
* ----------
* The predicates in this section interact with the parameters defined above.
*/
/* set(Parameter, Value)
* ---------------------
* This predicate drops any previously saved value for the given parameter and
* associates it to the new given value.
*
* INPUT
* - Parameter: target parameter for the given new value.
* - Value: new value to assign to the given parameter.
*/
set(Parameter, Value) :-
retract(setting(Parameter, _)),
assert(setting(Parameter, Value)).

344
packages/cplint/approx/.svn/text-base/parsing.pl.svn-base Normal file
View File

@@ -0,0 +1,344 @@
/*==============================================================================
* 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).

727
packages/cplint/approx/.svn/text-base/tptreefile.pl.svn-base Normal file
View File

@@ -0,0 +1,727 @@
%%% -*- Mode: Prolog; -*-
:-source.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% prefix-trees for managing a DNF
% remembers shortest prefix of a conjunction only (i.e. a*b+a*b*c results in a*b only, but b*a+a*b*c is not reduced)
% children are sorted, but branches aren't (to speed up search while keeping structure sharing from proof procedure)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
:- module(ptree,[init_ptree/1,
delete_ptree/1,
rename_ptree/2,
member_ptree/2,
enum_member_ptree/2,
insert_ptree/2,
delete_ptree/2,
edges_ptree/2,
count_ptree/2,
prune_check_ptree/2,
empty_ptree/1,
merge_ptree/3,
bdd_ptree/3,
bdd_ptree_map/4
]).
:-source.
:- use_module(library(tries),
[
trie_open/1,
trie_close/1,
trie_stats/4,
trie_check_entry/3,
trie_get_entry/2,
trie_put_entry/3,
trie_remove_entry/1,
trie_usage/4,
trie_dup/2,
trie_join/2,
trie_traverse/2
]).
:- use_module(library(ordsets),
[
ord_subset/2
]).
:- style_check(all).
%:- yap_flag(unknown,error).
%:- use_module(flags,[problog_flag/2]).
:- ensure_loaded(library(lists)).
:- ensure_loaded(library(system)).
% name lexicon external - internal
sym(1,tree1) :- !.
sym(2,tree2) :- !.
sym(3,tree3) :- !.
sym(N,AN) :- atomic_concat([tree,N],AN).
%%%%%%%%%%%%%%%%%%%%%%%%
% ptree basics
%%%%%%%%%%%%%%%%%%%%%%%%
init_ptree(ID) :-
sym(ID,Sym),
trie_open(Trie),
nb_setval(Sym, Trie).
delete_ptree(ID) :-
sym(ID,Sym),
nb_getval(Sym, Trie), !,
trie_close(Trie),
trie_open(NewTrie),
nb_setval(Sym, NewTrie).
delete_ptree(_).
rename_ptree(OldID,NewID) :-
sym(OldID,OldSym),
sym(NewID,NewSym),
nb_getval(OldSym, Trie),
nb_set_shared_val(NewSym, Trie).
empty_ptree(ID) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_usage(Trie, 0, 0, 0).
%%%%%%%%%%%%%%%%%%%%%%%%
% member
%%%%%%%%%%%%%%%%%%%%%%%%
% non-backtrackable (to check)
member_ptree(List,ID) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_check_entry(Trie, List, _).
% backtrackable (to list)
enum_member_ptree(ID,List) :-
sym(ID,Sym),
nb_getval(Sym, Tree),
trie_path(Tree, List).
trie_path(Tree, List) :-
trie_traverse(Tree,Ref),
trie_get_entry(Ref, List).
%%%%%%%%%%%%%%%%%%%%%%%%
% insert conjunction
%%%%%%%%%%%%%%%%%%%%%%%%
insert_ptree(true,ID) :-
sym(ID,Sym),
!,
nb_getval(Sym, Trie),
trie_close(Trie),
trie_open(NTrie),
trie_put_entry(NTrie, true, _).
insert_ptree(List,ID) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_put_entry(Trie, List, _).
%%%%%%%%%%%%%%%%%%%%%%%%
% delete conjunction
%%%%%%%%%%%%%%%%%%%%%%%%
delete_ptree(List,ID) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_check_entry(Trie, List, Ref),
trie_remove_entry(Ref).
%%%%%%%%
% return list -Edges of all edge labels in ptree
% doesn't use any heuristic to order those for the BDD
% (automatic reordering has to do the job)
%%%%%%%%%
edges_ptree(ID,[]) :-
empty_ptree(ID),
!.
edges_ptree(ID,[]) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_check_entry(Trie, true, _),
!.
edges_ptree(ID,Edges) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
%(
setof(X, trie_literal(Trie, X), Edges).%->
/* true
;
Edges=[]
).*/
trie_literal(Trie, X) :-
trie_traverse(Trie,Ref),
trie_get_entry(Ref, List),
member(X, List).
%%%%%%%%
% number of conjunctions in the tree
%%%%%%%%%
count_ptree(ID,N) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_usage(Trie, N, _, _).
%%%%%%%%
% check whether some branch of ptree is a subset of conjunction List
% useful for pruning the search for proofs (optional due to time overhead)
% currently not implemented, just fails
%%%%%%%
prune_check_ptree(_List,_TreeID) :-
format(user,'FAIL: prune check currently not supported~n',[]),
flush_output(user),
fail.
%%%%%%%%%%%%%
% merge two ptrees
% - take care not to loose proper prefixes that are proofs!
%%%%%%%%%%%%%%%
merge_ptree(ID1,_,ID3) :-
sym(ID1,Sym1),
sym(ID3,Sym3),
nb_getval(Sym1, T1),
trie_check_entry(T1, true, _),
!,
trie_open(T3),
trie_put_entry(T3, true, _),
nb_setval(Sym3, T3).
merge_ptree(_,ID2,ID3) :-
sym(ID2,Sym2),
sym(ID3,Sym3),
nb_getval(Sym2, T2),
trie_check_entry(T2, true, _),
!,
trie_open(T3),
trie_put_entry(T3, true, _),
nb_setval(Sym3, T3).
merge_ptree(ID1,ID2,ID3) :-
sym(ID1,Sym1),
sym(ID2,Sym2),
sym(ID3,Sym3),
nb_getval(Sym1, T1),
nb_getval(Sym2, T2),
trie_dup(T1, T3),
trie_join(T3,T2),
nb_setval(Sym3, T3).
%%%%%%%%%%%%%%%%%%%%%%%%
% write BDD info for given ptree to file
% - initializes leaf BDDs (=variables) first
% - then compresses ptree to exploit subtree sharing
% - bdd_pt/1 does the work on the structure itself
%%%%%%%%%%%%%%%%%%%%%%%%
bdd_ptree(ID,FileBDD,FileParam) :-
bdd_ptree_script(ID,FileBDD,FileParam),
eraseall(map),
eraseall(vars).
% version returning variable mapping
bdd_ptree_map(ID,FileBDD,FileParam,FileMapping) :-
bdd_ptree_script(ID,FileBDD,FileParam),
findall(X,recorded(map,X,_),Map),
add_probs(Map,Mapping),
tell(FileMapping),
write(Mapping),write('.'),
told,
eraseall(map),
eraseall(vars).
add_probs([],[]).
add_probs([m(R,S,Num,Name)|Map],[m(R,S,Num,Name,Prob)|Mapping]) :-
user:rule_by_num(R,S,_N,Head,_Body),
user:get_probs(Head,Prob),
add_probs(Map,Mapping).
% number of variables may be to high:
% counted on trie, but conversion to old tree representation
% transforms A*B+A to A (prefix-test)
bdd_ptree_script(ID,FileBDD,FileParam) :-
assert(v_num(0)),
edges_ptree(ID,Edges),
compute_nvars(Edges,0,NVars,0,NBVars),
tell(FileParam),
bdd_vars_script(Edges),
flush_output,
told,
length(Edges,_VarCount),
assert(c_num(1)),
bdd_pt(ID,CT),!,
c_num(NN),
IntermediateSteps is NN-1,
tell(FileBDD),
format('@BDD1~n~w~n~w~n~w~n~w~n',[NVars,NBVars,0,IntermediateSteps]),
output_compressed_script_only(CT),!,
told,
retractall(c_num(_)),
retractall(v_num(_)),
retractall(compression(_,_)).
compute_nvars([],NV,NV,NBV,NBV).
compute_nvars([(_V,R,S)|T],NV0,NV1,NBV0,NBV1):-
(recorded(vars,v(R,S),_)->
compute_nvars(T,NV0,NV1,NBV0,NBV1)
;
recorda(vars,v(R,S),_),
NV2 is NV0+1,
user:rule_by_num(R,S,_N,Head,_Body),
length(Head,L),
NBV2 is NBV0+integer(ceiling(log(L)/log(2))),
compute_nvars(T,NV2,NV1,NBV2,NBV1)
).
% write parameter file by iterating over all var/not(var) occuring in the tree
/*bdd_vars_script(Edges) :-
bdd_vars_script(Edges,0).
*/
bdd_vars_script([]).
%%%% Bernd, changes for negated ground facts
/*
bdd_vars_script([(_V,R,S)|B],N) :-
recorded(map,m(R,S,_Num,_NameA),_),!,
bdd_vars_script(B,N).
*/
bdd_vars_script([(_V,R,S)|B]) :-
(recorded(map,m(R,S,_Number,_NameA),_)->
true
;
user:rule_by_num(R,S,_N,Head,_Body),
user:get_probs(Head,P),
get_var_name(R,S,_Number,NameA),
length(Head,NV),
format('@~w~n~d~n',[NameA,NV]),
print_probs(P)
),
bdd_vars_script(B).
print_probs([H]):-!,
format("~f~n",[H]).
print_probs([H|T]):-
format("~f ",[H]),
print_probs(T).
%%%%%%%%%%%%%%%%%%%%%%%%
% find top level symbol for script
%%%%%%%%%%%%%%%%%%%%%%%%
% special cases: variable-free formulae
bdd_pt(ID,false) :-
empty_ptree(ID),
!,
once(retractall(c_num(_))),
once(assert(c_num(2))).
bdd_pt(ID,true) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_check_entry(Trie, true, _),
!,
once(retractall(c_num(_))),
once(assert(c_num(2))).
% general case: transform trie to nested tree structure for compression
bdd_pt(ID,CT) :-
sym(ID,Sym),
nb_getval(Sym, Trie),
trie_to_tree(Trie, Tree),
compress_pt(Tree,CT).
trie_to_tree(Trie, Tree) :-
findall(Path,trie_path(Trie, Path), Paths),
add_trees(Paths, [], Tree).
add_trees([], Tree, Tree).
add_trees([List|Paths], Tree0, Tree) :-
ins_pt(List, Tree0, TreeI),
add_trees(Paths, TreeI, Tree).
ins_pt([],_T,[]) :- !.
ins_pt([A|B],[s(A1,AT)|OldT],NewT) :-
compare(Comp, A1, A),
(Comp == = ->
(AT == [] ->
NewT=[s(A1,AT)|OldT]
;
NewT = [s(A1,NewAT)|OldT],
ins_pt(B, AT, NewAT))
;
Comp == > ->
NewT = [s(A1,AT)|Tree],
ins_pt([A|B], OldT, Tree)
;
NewT = [s(A,BTree),s(A1,AT)|OldT],
ins_pt(B,[],BTree)
).
ins_pt([A|B],[],[s(A,NewAT)]) :-
ins_pt(B,[],NewAT).
%%%%%%%%%%%%
% BDD compression: alternates and- and or-levels to build BDD bottom-up
% each sub-BDD will be either a conjunction of a one-node BDD with some BDD or a disjunction of BDDs
% uses the internal database to temporarily store a map of components
%%%%%%%%%%%%
% T is completely compressed and contains single variable
% i.e. T of form x12 or ~x34
compress_pt(T,TT) :-
atom(T),
test_var_name(T),
!,
get_next_name(TT),
assertz(compression(TT,[T])).
% T is completely compressed and contains subtrees
% i.e. T of form 'L56'
compress_pt(T,T) :-
atom(T).
% T not yet compressed
% i.e. T is a tree-term (nested list & s/2 structure)
% -> execute one layer of compression, then check again
compress_pt(T,CT) :-
\+ atom(T),
and_or_compression(T,IT),
compress_pt(IT,CT).
% transform tree-term T into tree-term CT where last two layers have been processed
% i.e. introduce names for subparts (-> Map) and replace (all occurrenes of) subparts by this names
and_or_compression(T,CT) :-
and_comp(T,AT),
or_comp(AT,CT).
% replace leaves that are single child by variable representing father-AND-child
and_comp(T,AT) :-
all_leaves_pt(T,Leaves),
compression_mapping(Leaves,Map),
replace_pt(T,Map,AT).
% replace list of siblings by variable representing their disjunction
or_comp(T,AT) :-
all_leaflists_pt(T,Leaves),
compression_mapping(Leaves,Map),
replace_pt(T,Map,AT).
all_leaves_pt(T,L) :-
all(X,some_leaf_pt(T,X),L).
some_leaf_pt([s(A,[])|_],s(A,[])).
some_leaf_pt([s(A,L)|_],s(A,L)) :-
not_or_atom(L).
some_leaf_pt([s(_,L)|_],X) :-
some_leaf_pt(L,X).
some_leaf_pt([_|L],X) :-
some_leaf_pt(L,X).
all_leaflists_pt(L,[L]) :-
atomlist(L),!.
all_leaflists_pt(T,L) :-
all(X,some_leaflist_pt(T,X),L),!.
all_leaflists_pt(_,[]).
some_leaflist_pt([s(_,L)|_],L) :-
atomlist(L).
some_leaflist_pt([s(_,L)|_],X) :-
some_leaflist_pt(L,X).
some_leaflist_pt([_|L],X) :-
some_leaflist_pt(L,X).
not_or_atom(T) :-
(
T=not(T0)
->
atom(T0);
atom(T)
).
atomlist([]).
atomlist([A|B]) :-
not_or_atom(A),
atomlist(B).
% for each subtree that will be compressed, add its name
% only introduce 'L'-based names when subtree composes elements, store these in compression/2 for printing the script
compression_mapping([],[]).
compression_mapping([First|B],[N-First|BB]) :-
(
First = s((V,R,S),[]) % subtree is literal -> use variable's name x17 from map (add ~ for negative case)
->
recorded(map,m(R,S,_Num,Tmp),_), %check
atomic_concat([Tmp,'-',V],N)
;
(First = s(A,L),not_or_atom(L)) % subtree is node with single completely reduced child -> use next 'L'-based name
-> (get_next_name(N),
assertz(compression(N,s(A,L))))
;
(First = [L],not_or_atom(L)) % subtree is an OR with a single completely reduced element -> use element's name
-> N=L
/*,
recorded(refc,m(L,RefC),Ref),
erase(Ref),
RefC1 is RefC+1,
recorda(refc,m(L,RefC1),_)*/
;
(atomlist(First), % subtree is an OR with only (>1) completely reduced elements -> use next 'L'-based name
get_next_name(N),
assertz(compression(N,First)))
),
compression_mapping(B,BB).
increase_counts([]).
increase_counts([H|T]):-
recorded(refc,m(H,RC),Ref),
erase(Ref),
RC1 is RC+1,
recorda(refc,m(H,RC1),_),
increase_counts(T).
compute_or([A],Node0,Node1):-
recorded(mapnodes,m(A,Node),_),
or(Node0,Node,Node1).
compute_or([A,B|T],Node0,Node1):-
recorded(mapnodes,m(A,Node),_),
or(Node0,Node,Node2),
compute_or([B|T],Node2,Node1).
% replace_pt(+T,+Map,-NT)
% given the tree-term T and the Map of Name-Subtree entries, replace each occurence of Subtree in T with Name -> result NT
replace_pt(T,[],T).
replace_pt([],_,[]).
replace_pt(L,M,R) :-
atomlist(L),
member(R-L,M),
!.
replace_pt([L|LL],[M|MM],R) :-
replace_pt_list([L|LL],[M|MM],R).
replace_pt_list([T|Tree],[M|Map],[C|Compr]) :-
replace_pt_single(T,[M|Map],C),
replace_pt_list(Tree,[M|Map],Compr).
replace_pt_list([],_,[]).
replace_pt_single(s(A,T),[M|Map],Res) :-
atomlist(T),
member(Res-s(A,T),[M|Map]),
!.
replace_pt_single(s(A,T),[M|Map],s(A,Res)) :-
atomlist(T),
member(Res-T,[M|Map]),
!.
replace_pt_single(s(A,T),[M|Map],Res) :-
member(Res-s(A,T),[M|Map]),
!.
replace_pt_single(s(A,T),[M|Map],s(A,TT)) :-
replace_pt_list(T,[M|Map],TT).
replace_pt_single(A,_,A) :-
not_or_atom(A).
output_compressed_script_only(false) :-
!,
format('L1 = FALSE~nL1~n',[]).
output_compressed_script_only(true) :-
!,
format('L1 = TRUE~nL1~n',[]).
output_compressed_script_only(T) :-
once(retract(compression(Short,Long))),
assertz(compression(Short,Long)),
(T = Short ->
format('~w = ',[Short]),
format_compression_script_only(Long),
format('~w~n',[Short])
;
format('~w = ',[Short]),
format_compression_script_only(Long),
output_compressed_script_only(T)
).
format_compression_script_only(s((V,R,S),B0)) :-
recorded(map,m(R,S,_Num,C),_),
atomic_concat([C,'-',V],C1),
format('~w * ~w~n',[C1,B0]).
format_compression_script_only([A]) :-
format('~w~n',[A]).
format_compression_script_only([A,B|C]) :-
format('~w + ',[A]),
format_compression_script_only([B|C]).
%%%%%%%%%%%%
% output for script
% input argument is compressed tree, i.e. true/false or name assigned in last compression step
%%%%%%%%%%%%
output_compressed_script(false) :-
!.
%format('L1 = FALSE~nL1~n',[]).
output_compressed_script(true) :-
!.
%format('L1 = TRUE~nL1~n',[]).
% for each name-subtree pair, write corresponding line to script, e.g. L17 = x4 * L16
% stop after writing definition of root (last entry in compression/2), add it's name to mark end of script
output_compressed_script(T) :-
once(retract(compression(Short,Long))),
(T = Short ->
% format('~w = ',[Short]),
format_compression_script(Long,Short)
% format('~w~n',[Short])
;
% format('~w = ',[Short]),
format_compression_script(Long,Short),
output_compressed_script(T)).
format_compression_script(s((V,R,S),B0),Short) :-!,
% checkme
recorded(map,m(R,S,_Num,C),_),
atomic_concat([C,'-',V],C1),
recorded(mapnodes,m(C1,Node1),_),
recorded(mapnodes,m(B0,Node2),_),
% format('~w * ~w~n',[C1,B0]),
and(Node1,Node2,Node),
recorda(mapnodes,m(Short,Node),_),
recorded(refc,m(C1,RefC1),Ref1),
recorded(refc,m(B0,RefC2),Ref2),
erase(Ref1),
erase(Ref2),
RefC11 is RefC1-1,
RefC21 is RefC2-1,
(RefC11 =:=0->
deref(Node1)
;
recorda(refc,m(C1,RefC11),_)
),
(RefC21 =:=0->
deref(Node2)
;
recorda(refc,m(B0,RefC21),_)
).
format_compression_script([H1],Short):-!,
% format('~w~n',[A]),
recorded(mapnodes,m(H1,Node1),_),
recorded(refc,m(H1,RefC1),Ref1),
erase(Ref1),
RefC11 is RefC1-1,
(RefC11 =:=0->
deref(Node1)
;
recorda(refc,m(H1,RefC11),_)
),
recorda(mapnodes,m(Short,Node1),_).
format_compression_script([H1,H2],Short):-!,
% format('~w + ~w~n',[H1,H2]),
recorded(mapnodes,m(H1,Node1),_),
recorded(refc,m(H1,RefC1),Ref1),
erase(Ref1),
RefC11 is RefC1-1,
recorded(mapnodes,m(H2,Node2),_),
recorded(refc,m(H2,RefC2),Ref2),
erase(Ref2),
RefC21 is RefC2-1,
or(Node1,Node2,Node),
(RefC11 =:=0->
deref(Node1)
;
recorda(refc,m(H1,RefC11),_)
),
(RefC21 =:=0->
deref(Node2)
;
recorda(refc,m(H2,RefC21),_)
),
recorda(mapnodes,m(Short,Node),_).
format_compression_script([H1,H2,H3|T],Short):-
%format('~w + ~w +',[H1,H2]),
recorded(mapnodes,m(H1,Node1),_),
recorded(refc,m(H1,RefC1),Ref1),
erase(Ref1),
RefC11 is RefC1-1,
recorded(mapnodes,m(H2,Node2),_),
recorded(refc,m(H2,RefC2),Ref2),
erase(Ref2),
RefC21 is RefC2-1,
or(Node1,Node2,Node),
(RefC11 =:=0->
deref(Node1)
;
recorda(refc,m(H1,RefC11),_)
),
(RefC21 =:=0->
deref(Node2)
;
recorda(refc,m(H2,RefC21),_)
),
format_compression_script1([H3|T],Node,Short).
format_compression_script1([A],Node1,Short) :-!,
% format('~w~n',[A]),
recorded(mapnodes,m(A,Node2),_),
recorded(refc,m(A,RefC),Ref),
erase(Ref),
or(Node1,Node2,Node),
deref(Node1),
recorda(mapnodes,m(Short,Node),_),
RefC1 is RefC-1,
(RefC1=:=0->
deref(Node2)
;
recorda(refc,m(A,RefC1),_)
).
format_compression_script1([A,B|C],Node1,Short) :-
format('~w + ',[A]),
recorded(mapnodes,m(A,Node2),_),
recorded(refc,m(A,RefC),Ref),
erase(Ref),
or(Node1,Node2,Node),
deref(Node1),
RefC1 is RefC-1,
(RefC1=:=0->
deref(Node2)
;
recorda(refc,m(A,RefC1),_)
),
format_compression_script1([B|C],Node,Short).
%%%%%%%%%%%%%%%%%%%%%%%%
% auxiliaries for translation to BDD
%%%%%%%%%%%%%%%%%%%%%%%%
% prefix the current counter with "L"
get_next_name(Name) :-
retract(c_num(N)),
NN is N+1,
assert(c_num(NN)),
atomic_concat('L',N,Name).
get_next_var_id(N,Name) :-
retract(v_num(N)),
NN is N+1,
assert(v_num(NN)),
atomic_concat('x',N,Name).
% create BDD-var as fact id prefixed by x
% learning.yap relies on this format!
% when changing, also adapt test_var_name/1 below
get_var_name(R,S,Number,NameA) :-
get_next_var_id(Number,NameA),
recorda(map,m(R,S,Number,NameA),_).
% test used by base case of compression mapping to detect single-variable tree
% has to match above naming scheme
test_var_name(T) :-
atomic_concat(x,_,T).

367
packages/cplint/approx/.svn/text-base/utility.pl.svn-base Normal file
View File

@@ -0,0 +1,367 @@
/*==============================================================================
* 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).