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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Makefile.in
View File

@ -487,6 +487,7 @@ all: startup.yss
@USE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE))
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE))
@ENABLE_JPL@ @INSTALL_DLLS@ (cd packages/jpl; $(MAKE))
@ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE))
@ENABLE_CPLINT@ (cd packages/cplint; $(MAKE))
@USE_CUDD@ (cd packages/ProbLog/simplecudd; $(MAKE))

13491
configure vendored
View File

File diff suppressed because it is too large Load Diff

6
configure.in
View File

@ -1140,7 +1140,8 @@ if test ! "$yap_cv_cplint" = "no"
AC_SEARCH_LIBS([g_hash_table_new], [glib-2.0], [CPLINT_LIBS="-lglib-2.0 "], [AC_MSG_ERROR([This package needs glib >=2.0.], [1])], [])
AC_SEARCH_LIBS([array_do_alloc], [glu], [CPLINT_LIBS="-lglu "$CPLINT_LIBS], [AC_MSG_ERROR([This package needs glu.], [1])], [])
AC_SEARCH_LIBS([Cudd_Init], [cu], [CPLINT_LIBS="-lcu "$CPLINT_LIBS], [AC_MSG_ERROR([This package needs glu.], [1])], [-lglu -lm])
ENABLE_CPLINT=""
AC_SEARCH_LIBS([pow], [m], [CPLINT_LIBS="-lm "$CPLINT_LIBS], [AC_MSG_ERROR([This package needs m.], [1])], [-lglu -lm])
ENABLE_CPLINT=""
if test "$target_os" = "cygwin" -o "$target_os" = "mingw32"
then
CPLINT_SHLIB_LD="gcc -shared ../yap.dll"
@ -1633,6 +1634,8 @@ mkdir -p packages/chr
mkdir -p packages/CLPBN
mkdir -p packages/clpqr
mkdir -p packages/cplint
mkdir -p packages/cplint/approx
mkdir -p packages/cplint/approx/simplecuddLPADs
mkdir -p packages/jpl
mkdir -p packages/jpl/src/java
mkdir -p packages/jpl/src/java/jpl
@ -1664,6 +1667,7 @@ AC_CONFIG_FILES([LGPL/clp/Makefile])
AC_CONFIG_FILES([LGPL/swi_console/Makefile])
AC_CONFIG_FILES([packages/CLPBN/Makefile])
AC_CONFIG_FILES([packages/cplint/Makefile])
AC_CONFIG_FILES([packages/cplint/approx/simplecuddLPADs/Makefile])
AC_CONFIG_FILES([packages/PLStream/Makefile])
AC_CONFIG_FILES([packages/plunit/Makefile])
AC_CONFIG_FILES([packages/ProbLog/Makefile ])

28
packages/cplint/Makefile.in
View File

@ -3,16 +3,17 @@
# (EROOT for architecture-dependent files)
#
prefix = @prefix@
exec_prefix = ${prefix}
ROOTDIR = $(prefix)
EROOTDIR = @exec_prefix@
EROOTDIR = ${prefix}
#
# where the binary should be
#
BINDIR = $(ROOTDIR)/bin
BINDIR = $(EROOTDIR)/bin
#
# where YAP should look for libraries
#
LIBDIR=@libdir@/Yap
YAPLIBDIR=${exec_prefix}/lib/Yap
#
# where YAP should look for architecture-independent Prolog libraries
#
@ -20,7 +21,7 @@ SHAREDIR=$(ROOTDIR)/share/Yap
#
#
CC=@CC@
CFLAGS= @CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I$(srcdir)/../include
CFLAGS= @CFLAGS@ $(YAP_EXTRAS) $(DEFS) -I$(srcdir) -I$(srcdir)/../../include
#
#
# You shouldn't need to change what follows.
@ -57,7 +58,18 @@ CPLINT_PROGRAMS= \
$(CPLINT_SRCDIR)/lpadclpbn.pl \
$(CPLINT_SRCDIR)/lpadsld.pl \
$(CPLINT_SRCDIR)/lpad.pl \
$(CPLINT_SRCDIR)/cpl.pl
$(CPLINT_SRCDIR)/cpl.pl \
$(CPLINT_SRCDIR)/approx/bestfirst.pl \
$(CPLINT_SRCDIR)/approx/bestk.pl \
$(CPLINT_SRCDIR)/approx/deepdyn.pl \
$(CPLINT_SRCDIR)/approx/deepit.pl \
$(CPLINT_SRCDIR)/approx/exact.pl \
$(CPLINT_SRCDIR)/approx/exact_mem.pl \
$(CPLINT_SRCDIR)/approx/montecarlo.pl \
$(CPLINT_SRCDIR)/approx/params.pl \
$(CPLINT_SRCDIR)/approx/parsing.pl \
$(CPLINT_SRCDIR)/approx/tptreefile.pl \
$(CPLINT_SRCDIR)/approx/utility.pl
CPLINT_SEMANTICS_PROGRAMS= \
$(CPLINT_SRCDIR)/semlpadsld.pl \
@ -67,7 +79,6 @@ CPLINT_SEMANTICS_PROGRAMS= \
CPLINT_TEST_PROGRAMS= \
$(CPLINT_SRCDIR)/testlpadvel.pl \
$(CPLINT_SRCDIR)/testlpadclpbn.pl \
$(CPLINT_SRCDIR)/testlpadsld_gbtrue.pl \
$(CPLINT_SRCDIR)/testlpadsld_gbfalse.pl \
$(CPLINT_SRCDIR)/testlpad.pl \
@ -157,10 +168,11 @@ install: all
for h in $(CPLINT_DOCS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/cplint/doc; done
for h in $(CPLINT_TEST_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/cplint; done
for h in $(CPLINT_SEMANTICS_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(LIBDIR)
$(INSTALL_PROGRAM) $(SOBJS) $(DESTDIR)$(YAPLIBDIR)
$(INSTALL_PROGRAM) approx/simplecuddLPADs/LPADBDD $(SHAREDIR)
installcheck:
for h in ${CPLINT_TEST_PROGRAMS}; do echo "t. halt." | yap -l $$h; done
for h in ${CPLINT_TEST_PROGRAMS}; do echo "t. halt." | $(BINDIR)/yap -l $$h; done
# use the following target to run individual tests, e.g. make testlpad
test%:

77
packages/cplint/approx/.svn/all-wcprops Normal file
View File

@ -0,0 +1,77 @@
K 25
svn:wc:ra_dav:version-url
V 60
/svn/cplint/!svn/ver/2160/cplint/trunk/cplint_new/approx_src
END
bestfirst.pl
K 25
svn:wc:ra_dav:version-url
V 73
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/bestfirst.pl
END
bestk.pl
K 25
svn:wc:ra_dav:version-url
V 69
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/bestk.pl
END
deepdyn.pl
K 25
svn:wc:ra_dav:version-url
V 71
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/deepdyn.pl
END
deepit.pl
K 25
svn:wc:ra_dav:version-url
V 70
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/deepit.pl
END
INSTALL.txt
K 25
svn:wc:ra_dav:version-url
V 72
/svn/cplint/!svn/ver/2160/cplint/trunk/cplint_new/approx_src/INSTALL.txt
END
exact_mem.pl
K 25
svn:wc:ra_dav:version-url
V 73
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/exact_mem.pl
END
montecarlo.pl
K 25
svn:wc:ra_dav:version-url
V 74
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/montecarlo.pl
END
params.pl
K 25
svn:wc:ra_dav:version-url
V 70
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/params.pl
END
parsing.pl
K 25
svn:wc:ra_dav:version-url
V 71
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/parsing.pl
END
tptreefile.pl
K 25
svn:wc:ra_dav:version-url
V 74
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/tptreefile.pl
END
utility.pl
K 25
svn:wc:ra_dav:version-url
V 71
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/utility.pl
END
exact.pl
K 25
svn:wc:ra_dav:version-url
V 69
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/exact.pl
END

446
packages/cplint/approx/.svn/entries Normal file
View File

@ -0,0 +1,446 @@
9
dir
2205
https://ds.ing.unife.it/svn/cplint/cplint/trunk/cplint_new/approx_src
https://ds.ing.unife.it/svn/cplint
2010-03-15T10:52:08.979119Z
2160
friguzzi
svn:special svn:externals svn:needs-lock
8b881860-fc2d-0410-9739-81b0d24abadf
0
bestfirst.pl
file
2010-03-15T10:10:51.000000Z
cc0ab0375af7a0d3f1075283af40bb42
2010-03-15T10:14:10.890703Z
2154
friguzzi
16349
deepdyn.pl
file
2010-03-15T10:12:51.000000Z
bae676b92cbfdf9e1a534312d701c56b
2010-03-15T10:14:10.890703Z
2154
friguzzi
12041
bestk.pl
file
2010-03-15T10:12:37.000000Z
10bc1754eaa5ed354b87686f4b44ef42
2010-03-15T10:14:10.890703Z
2154
friguzzi
19626
deepit.pl
file
2010-03-15T10:13:06.000000Z
7bf0b9c071d33fcf01ed31fc2a21dfc8
2010-03-15T10:14:10.890703Z
2154
friguzzi
12009
INSTALL.txt
file
2010-03-15T10:51:58.000000Z
995b2f3c1195b166dd28147e3a36db71
2010-03-15T10:52:08.979119Z
2160
friguzzi
354
exact_mem.pl
file
2010-03-15T10:09:31.000000Z
a83ce974957436d11f61969a5024dd99
2010-03-15T10:14:10.890703Z
2154
friguzzi
5546
montecarlo.pl
file
2010-03-15T10:09:31.000000Z
d97412d0fe41b3af1357e5a01d7e04b1
2010-03-15T10:14:10.890703Z
2154
friguzzi
9140
utility.pl
file
2010-03-15T10:09:31.000000Z
26ae6e67bf10751c653519db4037e3d2
2010-03-15T10:14:10.890703Z
2154
friguzzi
9698
simplecuddLPADs
dir
params.pl
file
2010-03-15T10:09:31.000000Z
1ef52cf23908247415d2852252ad766a
2010-03-15T10:14:10.890703Z
2154
friguzzi
2999
parsing.pl
file
2010-03-15T10:09:31.000000Z
7b1ae7dc7abf91883ec268a0d45744a6
2010-03-15T10:14:10.890703Z
2154
friguzzi
9148
tptreefile.pl
file
2010-03-15T10:09:31.000000Z
02811461bc732d74a68b1b8572116370
2010-03-15T10:14:10.890703Z
2154
friguzzi
18024
exact.pl
file
2010-03-15T10:13:20.000000Z
f2bd2e1315dc70c787f3abd14af17539
2010-03-15T10:14:10.890703Z
2154
friguzzi
6731

1
packages/cplint/approx/.svn/format Normal file
View File

@ -0,0 +1 @@
9

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 è stato commentato perchè 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).

451
packages/cplint/approx/bestfirst.pl 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/bestk.pl 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/deepdyn.pl 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/deepit.pl 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/exact.pl 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/exact_mem.pl 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/montecarlo.pl 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/params.pl 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/parsing.pl 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 è stato commentato perchè 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).

47
packages/cplint/approx/simplecuddLPADs/.svn/all-wcprops Normal file
View File

@ -0,0 +1,47 @@
K 25
svn:wc:ra_dav:version-url
V 76
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs
END
ProblogBDD.c
K 25
svn:wc:ra_dav:version-url
V 89
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/ProblogBDD.c
END
simplecudd.h
K 25
svn:wc:ra_dav:version-url
V 89
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/simplecudd.h
END
general.h
K 25
svn:wc:ra_dav:version-url
V 86
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/general.h
END
ProblogBDDclus.c
K 25
svn:wc:ra_dav:version-url
V 93
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/ProblogBDDclus.c
END
simplecudd.c
K 25
svn:wc:ra_dav:version-url
V 89
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/simplecudd.c
END
Makefile
K 25
svn:wc:ra_dav:version-url
V 85
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/Makefile
END
general.c
K 25
svn:wc:ra_dav:version-url
V 86
/svn/cplint/!svn/ver/2154/cplint/trunk/cplint_new/approx_src/simplecuddLPADs/general.c
END

273
packages/cplint/approx/simplecuddLPADs/.svn/entries Normal file
View File

@ -0,0 +1,273 @@
9
dir
2205
https://ds.ing.unife.it/svn/cplint/cplint/trunk/cplint_new/approx_src/simplecuddLPADs
https://ds.ing.unife.it/svn/cplint
2010-03-15T10:14:10.890703Z
2154
friguzzi
svn:special svn:externals svn:needs-lock
8b881860-fc2d-0410-9739-81b0d24abadf
0
simplecudd.h
file
2010-03-15T10:08:01.000000Z
07e7f1b7c2ef1d2e345358b8a993d452
2010-03-15T10:14:10.890703Z
2154
friguzzi
17432
ProblogBDD.c
file
2010-03-15T10:08:01.000000Z
98293257daff85df3f703c11e3f049a4
2010-03-15T10:14:10.890703Z
2154
friguzzi
35511
general.h
file
2010-03-15T10:08:01.000000Z
c4a07810ee4ab51ec579ded4d2467a4b
2010-03-15T10:14:10.890703Z
2154
friguzzi
12030
ProblogBDDclus.c
file
2010-03-15T10:08:01.000000Z
9c3bee903af5a2c4e26d3c413d3ef4f5
2010-03-15T10:14:10.890703Z
2154
friguzzi
36201
simplecudd.c
file
2010-03-15T10:08:01.000000Z
d92d01ea87ba9caa86311df989c8f6a2
2010-03-15T10:14:10.890703Z
2154
friguzzi
67867
Makefile
file
2010-03-15T10:08:01.000000Z
7b252aa4540f97f9955e69cd66cf022e
2010-03-15T10:14:10.890703Z
2154
friguzzi
1335
general.c
file
2010-03-15T10:08:01.000000Z
581112590eceb12912be10381846d207
2010-03-15T10:14:10.890703Z
2154
friguzzi
13543

1
packages/cplint/approx/simplecuddLPADs/.svn/format Normal file
View File

@ -0,0 +1 @@
9

55
packages/cplint/approx/simplecuddLPADs/.svn/text-base/Makefile.svn-base Normal file
View File

@ -0,0 +1,55 @@
#
# default base directory for YAP installation
# (EROOT for architecture-dependent files)
#
prefix = /home/rzf/usr/local
ROOTDIR = $(prefix)
EROOTDIR = ${prefix}
#
# where the binary should be
#
BINDIR = $(EROOTDIR)/bin
#
# where YAP should look for libraries
#
LIBDIR=$(EROOTDIR)/lib/Yap
DESTDIR=$(prefix)/share/Yap
#
#
CC=gcc
#
#
# You shouldn't need to change what follows.
#
INSTALL=/usr/bin/install -c
INSTALL_DATA=${INSTALL} -m 644
INSTALL_PROGRAM=${INSTALL}
SHELL=/bin/sh
RANLIB=ranlib
SHLIB_CFLAGS=-shared -fPIC
SHLIB_SUFFIX=.so
CWD=$(PWD)
#
CUDD = cudd-2.4.1
DYNAMIC =
CFLAGS = -DBP_FREE -O3 -fomit-frame-pointer -Wall -Wstrict-prototypes -Wmissing-prototypes -I/home/rzf/usr/local/include -I/usr/include/glib-2.0 -I/usr/lib/glib-2.0/include
INCLUDE =
LINKFLAGS = -L/home/rzf/usr/local/lib -L/lib/ -lm -lglu
LINKLIBS = -lcu -lm -lglu -lglib-2.0
default: LPADBDD
LPADBDD: ProblogBDD.o simplecudd.o general.o
@echo Making ProblogBDD...
@echo Copyright T. Mantadelis, A. Kimmig, B. Gutmann and Katholieke Universiteit Leuven 2008
$(CC) $(LINKLIBS) $(LINKFLAGS) -I/home/rzf/usr/local/include ProblogBDD.o simplecudd.o general.o $(LINKLIBS) $(LINKFLAGS) -o LPADBDD
%.o : $(srcdir)/%.c
$(CC) $(CFLAGS) $(INCLUDE) $(DYNAMIC) -c $<
clean:
rm -f *.o LPADBDD
install: default
$(INSTALL_PROGRAM) LPADBDD $(DESTDIR)

871
packages/cplint/approx/simplecuddLPADs/.svn/text-base/ProblogBDD.c.svn-base Normal file
View File

@ -0,0 +1,871 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis, A. Kimmig, B. Gutmann *
* and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann *
* File: ProblogBDD.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "simplecudd.h"
#include <signal.h>
#include <time.h>
typedef struct _parameters {
int loadfile;
int savedfile;
int exportfile;
int inputfile;
int debug;
int errorcnt;
int *error;
int method;
int queryid;
int timeout;
double sigmoid_slope;
int online;
int maxbufsize;
char *ppid;
} parameters;
typedef struct _gradientpair {
double probability;
double gradient;
} gradientpair;
typedef struct _extmanager {
DdManager *manager;
DdNode *t, *f;
hisqueue *his;
namedvars varmap;
} extmanager;
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp);
double Prob(extmanager MyManager, DdNode *node, int comp);
int correctPosition(int index,variable v,int posBVar);
double ret_prob(extmanager MyManager, DdNode * bdd);
int argtype(const char *arg);
void printhelp(int argc, char **arg);
parameters loadparam(int argc, char **arg);
parameters params;
void handler(int num);
void pidhandler(int num);
void termhandler(int num);
double sigmoid(double x, double slope);
void myexpand(extmanager MyManager, DdNode *Current);
double CalcProbability(extmanager MyManager, DdNode *Current);
double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current);
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern);
int patterncalculated(char *pattern, extmanager MyManager, int loc);
char * extractpattern(char *thestr);
int main(int argc, char **arg) {
clock_t start, endc, endt;
double elapsedc,elapsedt;
extmanager MyManager;
DdNode *bdd;
bddfileheader fileheader;
int i, ivarcnt, code;
gradientpair tvalue;
double probability = -1.0;
char *varpattern;
varpattern = NULL;
code = -1;
params = loadparam(argc, arg);
if (params.errorcnt > 0) {
printhelp(argc, arg);
for (i = 0; i < params.errorcnt; i++) {
fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]);
}
return -1;
}
if (params.online == 0 && params.loadfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: you must specify a loading file.\n");
return -1;
}
if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l') {
printhelp(argc, arg);
fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [o]nline.\n");
return -1;
}
if (params.debug) DEBUGON;
RAPIDLOADON;
SETMAXBUFSIZE(params.maxbufsize);
signal(SIGINT, termhandler);
if (params.ppid != NULL) {
signal(SIGALRM, pidhandler);
alarm(5);
} else {
signal(SIGALRM, handler);
alarm(params.timeout);
}
if (params.online) {
MyManager.manager = simpleBDDinit(0);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(1, 0);
bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap);
ivarcnt = GetVarCount(MyManager.manager);
} else {
fileheader = ReadFileHeader(arg[params.loadfile]);
switch(fileheader.filetype) {
case BDDFILE_SCRIPT:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedMultiVars(fileheader.varcnt, fileheader.varstart,fileheader.bvarcnt);
if (LoadMultiVariableData(MyManager.manager,MyManager.varmap, arg[params.inputfile]) == -1) return -1;
start = clock();
bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader);
endc=clock();
elapsedc = ((double) (endc - start)) / CLOCKS_PER_SEC;
printf("elapsed_construction(%lf).\n",elapsedc);
ivarcnt = fileheader.varcnt;
break;
case BDDFILE_NODEDUMP:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart);
bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile);
ivarcnt = fileheader.varcnt;
break;
default:
fprintf(stderr, "Error: not a valid file format to load.\n");
return -1;
break;
}
}
alarm(0);
// problem specifics
if (bdd != NULL) {
ivarcnt = RepairVarcnt(&MyManager.varmap);
code = 0;
/*
if (params.inputfile != -1) {
if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1;
if (!all_loaded(MyManager.varmap, 1)) return -1;
}*/
MyManager.his = InitHistory(ivarcnt);
if (params.method != 0) {
switch(arg[params.method][0]) {
case 'g':
for (i = 0; i < MyManager.varmap.varcnt; i++) {
if (MyManager.varmap.vars[i] != NULL) {
varpattern = extractpattern(MyManager.varmap.vars[i]);
if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) {
tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern);
probability = tvalue.probability;
double factor = sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope) * (1 - sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope)) * params.sigmoid_slope;
if (varpattern == NULL) {
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient * factor);
} else {
varpattern[strlen(varpattern) - 2] = '\0';
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], varpattern, tvalue.gradient * factor);
}
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
}
if (varpattern != NULL) free(varpattern);
} else {
fprintf(stderr, "Error: no variable name given for parameter.\n");
}
}
if (probability < 0.0) {
// no nodes, so we have to calculate probability ourself
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
}
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'l':
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'p':
printf("probability(%1.12f).\n", CalcProbability(MyManager, bdd));
break;
case 'o':
onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd);
break;
default:
myexpand(MyManager, bdd);
break;
}
} else {
start=clock();
// simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, "bdd.dot");
printf("probability(%1.12f).\n", ret_prob(MyManager, bdd));
endt=clock();
elapsedt = ((double) (endt - start)) / CLOCKS_PER_SEC;
printf("elapsed_traversing(%lf).\n",elapsedt);
// myexpand(MyManager, bdd);
}
if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]);
if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]);
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
free(MyManager.his);
}
if (MyManager.manager != NULL) {
KillBDD(MyManager.manager);
exit(code);
free(MyManager.varmap.dvalue);
free(MyManager.varmap.ivalue);
free(MyManager.varmap.dynvalue);
for (i = 0; i < MyManager.varmap.varcnt; i++)
{
free(MyManager.varmap.vars[i]);
free(MyManager.varmap.mvars[i].probabilities);
free(MyManager.varmap.mvars[i].booleanVars);
}
free(MyManager.varmap.vars);
free(MyManager.varmap.mvars);
free(MyManager.varmap.bVar2mVar);
}
if (params.error != NULL) free(params.error);
return code;
}
/* Shell Parameters handling */
int argtype(const char *arg) {
if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0;
if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2;
if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3;
if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4;
if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5;
if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6;
if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7;
if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8;
if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9;
if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10;
if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11;
if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12;
if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13;
return -1;
}
void printhelp(int argc, char **arg) {
fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]);
fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n");
fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n");
fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n");
fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n");
fprintf(stderr, "Optional parameters:\n");
fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n");
fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n");
fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [o]nline\n");
fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]);
fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n");
fprintf(stderr, "Extra parameters:\n");
fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n");
fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check works only under POSIX OS\n");
fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n");
fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n");
fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n\n");
fprintf(stderr, "Example: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]);
}
parameters loadparam(int argc, char **arg) {
int i;
parameters params;
params.loadfile = -1;
params.savedfile = -1;
params.exportfile = -1;
params.method = 0;
params.inputfile = -1;
params.debug = 0;
params.errorcnt = 0;
params.queryid = 0;
params.timeout = 0;
params.sigmoid_slope = 1.0;
params.online = 0;
params.maxbufsize = 0;
params.ppid = NULL;
params.error = (int *) malloc(argc * sizeof(int));
for (i = 1; i < argc; i++) {
switch(argtype(arg[i])) {
case 0:
if (argc > i + 1) {
i++;
params.loadfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 2:
if (argc > i + 1) {
i++;
params.exportfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 3:
if (argc > i + 1) {
i++;
params.method = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 4:
if (argc > i + 1) {
i++;
params.inputfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 5:
printhelp(argc, arg);
break;
case 6:
params.debug = 1;
break;
case 7:
if (argc > i + 1) {
i++;
params.queryid = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 8:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.timeout = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 9:
if (argc > i + 1) {
i++;
params.savedfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 10:
if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) {
i++;
params.sigmoid_slope = atof(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 11:
params.online = 1;
break;
case 12:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.maxbufsize = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 13:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1));
strcpy(params.ppid, arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
default:
params.error[params.errorcnt] = i;
params.errorcnt++;
break;
}
}
return params;
}
/* Error Handlers */
void handler(int num) {
fprintf(stderr, "Error: Timeout %i exceeded.\n", params.timeout);
exit(-1);
}
void pidhandler(int num) {
char *s;
if (params.timeout > 0) {
params.timeout -= 5;
if (params.timeout <= 0) {
fprintf(stderr, "Error: Timeout exceeded.\n");
exit(-1);
}
}
s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid)));
strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null");
if (system(s) != 0) exit(4);
signal(SIGALRM, pidhandler);
alarm(5);
free(s);
}
void termhandler(int num) {
exit(3);
}
/* General Functions */
double sigmoid(double x, double slope) {
return 1 / (1 + exp(-x * slope));
}
/* Debugging traverse function */
void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) &&
((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) {
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
printf("l(%s)->", curnode);
myexpand(MyManager, l);
printf("h(%s)->", curnode);
myexpand(MyManager, h);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, 0.0, 0, NULL);
}
}
/* Angelikas Algorithm */
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
double lvalue, hvalue, tvalue;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) return 1.0;
if (Current == MyManager.f) return 0.0;
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) return Found->dvalue;
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcProbability(MyManager, l);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcProbability(MyManager, h);
tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart];
tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL);
return tvalue;
}
/* Bernds Algorithm */
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
gradientpair lvalue, hvalue, tvalue;
double this_probability;
double *gradient;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) {
tvalue.probability = 1.0;
tvalue.gradient = 0.0;
return tvalue;
}
if (Current == MyManager.f) {
tvalue.probability = 0.0;
tvalue.gradient = 0.0;
return tvalue;
}
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) {
tvalue.probability = Found->dvalue;
tvalue.gradient = *((double *) Found->dynvalue);
return tvalue;
}
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern);
this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope);
tvalue.probability = this_probability * hvalue.probability + (1 - this_probability) * lvalue.probability;
tvalue.gradient = this_probability * hvalue.gradient + (1 - this_probability) * lvalue.gradient;
if ((GetIndex(Current) == TargetVar) ||
((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) {
tvalue.gradient += hvalue.probability - lvalue.probability;
}
gradient = (double *) malloc(sizeof(double));
*gradient = tvalue.gradient;
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient);
return tvalue;
}
char * extractpattern(char *thestr) {
char *p;
int i = 0, sl = strlen(thestr);
while((thestr[i] != '_') && (i < sl)) i++;
if (i == sl) return NULL;
i++;
p = (char *) malloc(sizeof(char) * (i + 2));
strncpy(p, thestr, i);
p[i] = '*';
p[i + 1] = '\0';
return p;
}
int patterncalculated(char *pattern, extmanager MyManager, int loc) {
int i;
if (pattern == NULL) return 0;
for (i = loc - 1; i > -1; i--)
if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1;
return 0;
}
double Prob(extmanager MyManager, DdNode *node, int comp)
/* compute the probability of the expression rooted at node
nodes is used to store nodes for which the probability has alread been computed
so that it is not recomputed
*/
{
int mVarIndex,nBit,index;
variable v;
hisnode *Found;
double res;
double value;
//printf("Prob node %d\n",node);
//index=Cudd_NodeReadIndex(node);
//printf("Prob INdex %d\n",index);
if (Cudd_IsConstant(node))
{
value=Cudd_V(node);//node->type.value;
//printf("Value %e comp %d\n",value,comp);
if (comp)//Cudd_IsComplement(node))
//return (1.0-value);
//if (value>0)
{
// printf("return 0");
return 0.0;
}
else
{
// printf("return 1");
return 1.0;
}
/*else
if (value>0)
return 1.0;
else
return 0.0;
*/ //return value;
}
else
{
Found = GetNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node);
if (Found!=NULL)
{
//printf("value found %e\n",Found->dvalue);
return Found->dvalue;
}
else
{
index=Cudd_NodeReadIndex(node);
//printf("node absent %d comp %d\n",node,comp);
//mVarIndex=array_fetch(int,bVar2mVar,index);
mVarIndex=MyManager.varmap.bVar2mVar[index];
//v=array_fetch(variable,vars,mVarIndex);
v=MyManager.varmap.mvars[mVarIndex];
nBit=v.nBit;
// printf("calling prob bool mvar %d nbit %d\n",mVarIndex,nBit);
//scanf("%d",&r);
res=ProbBool(MyManager,node,0,nBit,0,v,comp);
//printf("New val %e\n",res);
AddNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node, res, 0, NULL);
return res;
}
}
}
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp)
/* explores a group of binary variables making up the multivalued variable v */
{
DdNode *T,*F;
double p,res;
double * probs;
int index;
// printf("ProbBool nBit %d\n",nBit);
//scanf("%d",&r);
probs=v.probabilities;
if (nBit==0)
{
//printf("last var bits %d larray %d comp %d\n",bits,array_n(probs),comp);
// printf("bits %d v.nbit %d\n",bits,v.nBit);
if (bits>=v.nVal)
//if (comp)
{
//printf("bits>=v.nbit return 0\n");
return 0.0;
}
//else
//{printf("return 0\n");
//return 1.0;}}
else
{
// printf("Val %d\n",bits);
//p=array_fetch(double,probs,bits);
p=probs[bits];
//printf("prob %e\n",p);
res=p*Prob(MyManager,node,comp);
//printf("prob %e\n",p);
//printf("bottom %e\n",res);
return res;
}
}
else
{
//if (correctPosition(node->index,v,node,posBVar))
index=Cudd_NodeReadIndex(node);
//printf("index %d\n",Cudd_NodeReadIndex(node));
if (correctPosition(index,v,posBVar))
{
//printf("node %d\n",node);
T = Cudd_T(node);//node->type.kids.T;
F = Cudd_E(node);//node->type.kids.E;
bits=bits<<1;
//printf("calling on the true child %di complement %d\n",T,Cudd_IsComplement(T));
res=ProbBool(MyManager,T,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res %e\ncalling on the else child %d c %d\n",res,F,Cudd_IsComplement(F));
//printf("comp %d ",comp);
comp=(!comp && Cudd_IsComplement(F)) || (comp && !Cudd_IsComplement(F));
//printf("comp %d \n",comp);
res=res+
ProbBool(MyManager,F,bits,nBit-1,posBVar+1,v,comp);
//printf("res 2 %e\n",res);
return res;
}
else
{
//printf("absent var\n");
bits=bits<<1;
// printf("Var =1\n");
res=ProbBool(MyManager,node,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res 1 %e\n",res);
//printf("var =0\n");
res=res+
ProbBool(MyManager,node,bits,nBit-1,posBVar+1,v,comp);
// printf("res 2 %e\n",res);
return res;
}
}
}
int correctPosition(int index,variable v,int posBVar)
/* returns 1 is the boolean variable with index posBVar is in the correct position
currently explored by ProbBool */
{
int bvar;
//printf("posbvar %d\n",posBVar);
//printf("length %d\n",array_n(v.booleanVars));
//bvar=array_fetch(DdNode *,v.booleanVars,posBVar);
bvar=v.booleanVars[posBVar];
// return var->index==index;
return(bvar==index);
}
double ret_prob(extmanager MyManager, DdNode * bdd)
{
double prob;
/* dividend is a global variable used by my_hash
it is equal to an unsigned int with binary representation 11..1 */
prob=Prob(MyManager,bdd,Cudd_IsComplement(bdd));
return prob;
}

895
packages/cplint/approx/simplecuddLPADs/.svn/text-base/ProblogBDDclus.c.svn-base Normal file
View File

@ -0,0 +1,895 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis, A. Kimmig, B. Gutmann *
* and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann *
* File: ProblogBDD.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "simplecudd.h"
#include <signal.h>
typedef struct _parameters {
int loadfile;
int savedfile;
int exportfile;
int inputfile;
int debug;
int errorcnt;
int *error;
int method;
int queryid;
int timeout;
double sigmoid_slope;
int online;
int maxbufsize;
char *ppid;
} parameters;
typedef struct _gradientpair {
double probability;
double gradient;
} gradientpair;
typedef struct _extmanager {
DdManager *manager;
DdNode *t, *f;
hisqueue *his;
namedvars varmap;
} extmanager;
GHashTable * nodes; /* hash table that associates nodes with their probability if already
computed, it is defined in glib */
unsigned long dividend;
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp);
double Prob(extmanager MyManager, DdNode *node, int comp);
int correctPosition(int index,variable v, DdNode * node,int posBVar);
gint my_equal(gconstpointer v,gconstpointer v2);
guint my_hash(gconstpointer key);
void dealloc(gpointer key,gpointer value,gpointer user_data);
double ret_prob(extmanager MyManager, DdNode * bdd);
int argtype(const char *arg);
void printhelp(int argc, char **arg);
parameters loadparam(int argc, char **arg);
parameters params;
void handler(int num);
void pidhandler(int num);
void termhandler(int num);
double sigmoid(double x, double slope);
void myexpand(extmanager MyManager, DdNode *Current);
double CalcProbability(extmanager MyManager, DdNode *Current);
double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current);
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern);
int patterncalculated(char *pattern, extmanager MyManager, int loc);
char * extractpattern(char *thestr);
int main(int argc, char **arg) {
extmanager MyManager;
DdNode *bdd;
bddfileheader fileheader;
int i, ivarcnt, code;
gradientpair tvalue;
double probability = -1.0;
char *varpattern;
varpattern = NULL;
code = -1;
params = loadparam(argc, arg);
if (params.errorcnt > 0) {
printhelp(argc, arg);
for (i = 0; i < params.errorcnt; i++) {
fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]);
}
return -1;
}
if (params.online == 0 && params.loadfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: you must specify a loading file.\n");
return -1;
}
if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l') {
printhelp(argc, arg);
fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [o]nline.\n");
return -1;
}
if (params.debug) DEBUGON;
RAPIDLOADON;
SETMAXBUFSIZE(params.maxbufsize);
signal(SIGINT, termhandler);
if (params.ppid != NULL) {
signal(SIGALRM, pidhandler);
alarm(5);
} else {
signal(SIGALRM, handler);
alarm(params.timeout);
}
if (params.online) {
MyManager.manager = simpleBDDinit(0);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(1, 0);
bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap);
ivarcnt = GetVarCount(MyManager.manager);
} else {
fileheader = ReadFileHeader(arg[params.loadfile]);
switch(fileheader.filetype) {
case BDDFILE_SCRIPT:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedMultiVars(fileheader.varcnt, fileheader.varstart,fileheader.bvarcnt);
if (LoadMultiVariableData(MyManager.manager,MyManager.varmap, arg[params.inputfile]) == -1) return -1;
bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader);
ivarcnt = fileheader.varcnt;
break;
case BDDFILE_NODEDUMP:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart);
bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile);
ivarcnt = fileheader.varcnt;
break;
default:
fprintf(stderr, "Error: not a valid file format to load.\n");
return -1;
break;
}
}
alarm(0);
// problem specifics
if (bdd != NULL) {
ivarcnt = RepairVarcnt(&MyManager.varmap);
code = 0;
/*
if (params.inputfile != -1) {
if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1;
if (!all_loaded(MyManager.varmap, 1)) return -1;
}*/
MyManager.his = InitHistory(ivarcnt);
if (params.method != 0) {
switch(arg[params.method][0]) {
case 'g':
for (i = 0; i < MyManager.varmap.varcnt; i++) {
if (MyManager.varmap.vars[i] != NULL) {
varpattern = extractpattern(MyManager.varmap.vars[i]);
if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) {
tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern);
probability = tvalue.probability;
double factor = sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope) * (1 - sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope)) * params.sigmoid_slope;
if (varpattern == NULL) {
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient * factor);
} else {
varpattern[strlen(varpattern) - 2] = '\0';
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], varpattern, tvalue.gradient * factor);
}
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
}
if (varpattern != NULL) free(varpattern);
} else {
fprintf(stderr, "Error: no variable name given for parameter.\n");
}
}
if (probability < 0.0) {
// no nodes, so we have to calculate probability ourself
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
}
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'l':
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'p':
printf("probability(%1.12f).\n", CalcProbability(MyManager, bdd));
break;
case 'o':
onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd);
break;
default:
myexpand(MyManager, bdd);
break;
}
} else {
//simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, "bdd.dot");
printf("probability(%1.12f).\n", ret_prob(MyManager, bdd));
// myexpand(MyManager, bdd);
}
if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]);
if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]);
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
free(MyManager.his);
}
if (MyManager.manager != NULL) {
KillBDD(MyManager.manager);
free(MyManager.varmap.dvalue);
free(MyManager.varmap.ivalue);
free(MyManager.varmap.dynvalue);
for (i = 0; i < MyManager.varmap.varcnt; i++)
{
free(MyManager.varmap.vars[i]);
free(MyManager.varmap.mvars[i].probabilities);
free(MyManager.varmap.mvars[i].booleanVars);
}
free(MyManager.varmap.vars);
free(MyManager.varmap.mvars);
free(MyManager.varmap.bVar2mVar);
}
if (params.error != NULL) free(params.error);
return code;
}
/* Shell Parameters handling */
int argtype(const char *arg) {
if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0;
if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2;
if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3;
if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4;
if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5;
if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6;
if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7;
if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8;
if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9;
if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10;
if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11;
if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12;
if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13;
return -1;
}
void printhelp(int argc, char **arg) {
fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]);
fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n");
fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n");
fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n");
fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n");
fprintf(stderr, "Optional parameters:\n");
fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n");
fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n");
fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [o]nline\n");
fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]);
fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n");
fprintf(stderr, "Extra parameters:\n");
fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n");
fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check works only under POSIX OS\n");
fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n");
fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n");
fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n\n");
fprintf(stderr, "Example: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]);
}
parameters loadparam(int argc, char **arg) {
int i;
parameters params;
params.loadfile = -1;
params.savedfile = -1;
params.exportfile = -1;
params.method = 0;
params.inputfile = -1;
params.debug = 0;
params.errorcnt = 0;
params.queryid = 0;
params.timeout = 0;
params.sigmoid_slope = 1.0;
params.online = 0;
params.maxbufsize = 0;
params.ppid = NULL;
params.error = (int *) malloc(argc * sizeof(int));
for (i = 1; i < argc; i++) {
switch(argtype(arg[i])) {
case 0:
if (argc > i + 1) {
i++;
params.loadfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 2:
if (argc > i + 1) {
i++;
params.exportfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 3:
if (argc > i + 1) {
i++;
params.method = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 4:
if (argc > i + 1) {
i++;
params.inputfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 5:
printhelp(argc, arg);
break;
case 6:
params.debug = 1;
break;
case 7:
if (argc > i + 1) {
i++;
params.queryid = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 8:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.timeout = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 9:
if (argc > i + 1) {
i++;
params.savedfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 10:
if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) {
i++;
params.sigmoid_slope = atof(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 11:
params.online = 1;
break;
case 12:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.maxbufsize = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 13:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1));
strcpy(params.ppid, arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
default:
params.error[params.errorcnt] = i;
params.errorcnt++;
break;
}
}
return params;
}
/* Error Handlers */
void handler(int num) {
fprintf(stderr, "Error: Timeout %i exceeded.\n", params.timeout);
exit(-1);
}
void pidhandler(int num) {
char *s;
if (params.timeout > 0) {
params.timeout -= 5;
if (params.timeout <= 0) {
fprintf(stderr, "Error: Timeout exceeded.\n");
exit(-1);
}
}
s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid)));
strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null");
if (system(s) != 0) exit(4);
signal(SIGALRM, pidhandler);
alarm(5);
free(s);
}
void termhandler(int num) {
exit(3);
}
/* General Functions */
double sigmoid(double x, double slope) {
return 1 / (1 + exp(-x * slope));
}
/* Debugging traverse function */
void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) &&
((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) {
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
printf("l(%s)->", curnode);
myexpand(MyManager, l);
printf("h(%s)->", curnode);
myexpand(MyManager, h);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, 0.0, 0, NULL);
}
}
/* Angelikas Algorithm */
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
double lvalue, hvalue, tvalue;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) return 1.0;
if (Current == MyManager.f) return 0.0;
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) return Found->dvalue;
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcProbability(MyManager, l);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcProbability(MyManager, h);
tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart];
tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL);
return tvalue;
}
/* Bernds Algorithm */
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
gradientpair lvalue, hvalue, tvalue;
double this_probability;
double *gradient;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) {
tvalue.probability = 1.0;
tvalue.gradient = 0.0;
return tvalue;
}
if (Current == MyManager.f) {
tvalue.probability = 0.0;
tvalue.gradient = 0.0;
return tvalue;
}
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) {
tvalue.probability = Found->dvalue;
tvalue.gradient = *((double *) Found->dynvalue);
return tvalue;
}
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern);
this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope);
tvalue.probability = this_probability * hvalue.probability + (1 - this_probability) * lvalue.probability;
tvalue.gradient = this_probability * hvalue.gradient + (1 - this_probability) * lvalue.gradient;
if ((GetIndex(Current) == TargetVar) ||
((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) {
tvalue.gradient += hvalue.probability - lvalue.probability;
}
gradient = (double *) malloc(sizeof(double));
*gradient = tvalue.gradient;
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient);
return tvalue;
}
char * extractpattern(char *thestr) {
char *p;
int i = 0, sl = strlen(thestr);
while((thestr[i] != '_') && (i < sl)) i++;
if (i == sl) return NULL;
i++;
p = (char *) malloc(sizeof(char) * (i + 2));
strncpy(p, thestr, i);
p[i] = '*';
p[i + 1] = '\0';
return p;
}
int patterncalculated(char *pattern, extmanager MyManager, int loc) {
int i;
if (pattern == NULL) return 0;
for (i = loc - 1; i > -1; i--)
if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1;
return 0;
}
double Prob(extmanager MyManager, DdNode *node, int comp)
/* compute the probability of the expression rooted at node
nodes is used to store nodes for which the probability has alread been computed
so that it is not recomputed
*/
{
int index,mVarIndex,nBit;
variable v;
hisnode *Found;
double res;
double value;
//index=node->index;
//printf("Prob node %d\n",node);
//index=Cudd_NodeReadIndex(node);
//printf("Prob INdex %d\n",index);
if (Cudd_IsConstant(node))
{
value=Cudd_V(node);//node->type.value;
//printf("Value %e comp %d\n",value,comp);
if (comp)//Cudd_IsComplement(node))
//return (1.0-value);
//if (value>0)
{
// printf("return 0");
return 0.0;
}
else
{
// printf("return 1");
return 1.0;
}
/*else
if (value>0)
return 1.0;
else
return 0.0;
*/ //return value;
}
else
{
Found = GetNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node);
if (Found!=NULL)
{
//printf("value found %e\n",*value_p);
return Found->dvalue;
}
else
{
index=Cudd_NodeReadIndex(node);
//printf("node absent %d comp %d\n",node,comp);
//mVarIndex=array_fetch(int,bVar2mVar,index);
mVarIndex=MyManager.varmap.bVar2mVar[index];
//v=array_fetch(variable,vars,mVarIndex);
v=MyManager.varmap.mvars[mVarIndex];
nBit=v.nBit;
// printf("calling prob bool mvar %d nbit %d\n",mVarIndex,nBit);
//scanf("%d",&r);
res=ProbBool(MyManager,node,0,nBit,0,v,comp);
//printf("New val %e\n",res);
AddNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node, res, 0, NULL);
return res;
}
}
}
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp)
/* explores a group of binary variables making up the multivalued variable v */
{
DdNode *T,*F;
double p,res;
double * probs;
int index;
// printf("ProbBool nBit %d\n",nBit);
//scanf("%d",&r);
probs=v.probabilities;
if (nBit==0)
{
//printf("last var bits %d larray %d comp %d\n",bits,array_n(probs),comp);
// printf("bits %d v.nbit %d\n",bits,v.nBit);
if (bits>=v.nVal)
//if (comp)
{
//printf("bits>=v.nbit return 0\n");
return 0.0;
}
//else
//{printf("return 0\n");
//return 1.0;}}
else
{
// printf("Val %d\n",bits);
//p=array_fetch(double,probs,bits);
p=probs[bits];
//printf("prob %e\n",p);
res=p*Prob(MyManager,node,comp);
//printf("prob %e\n",p);
//printf("bottom %e\n",res);
return res;
}
}
else
{
//if (correctPosition(node->index,v,node,posBVar))
index=Cudd_NodeReadIndex(node);
//printf("index %d\n",Cudd_NodeReadIndex(node));
if (correctPosition(index,v,node,posBVar))
{
//printf("node %d\n",node);
T = Cudd_T(node);//node->type.kids.T;
F = Cudd_E(node);//node->type.kids.E;
bits=bits<<1;
//printf("calling on the true child %di complement %d\n",T,Cudd_IsComplement(T));
res=ProbBool(MyManager,T,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res %e\ncalling on the else child %d c %d\n",res,F,Cudd_IsComplement(F));
//printf("comp %d ",comp);
comp=(!comp && Cudd_IsComplement(F)) || (comp && !Cudd_IsComplement(F));
//printf("comp %d \n",comp);
res=res+
ProbBool(MyManager,F,bits,nBit-1,posBVar+1,v,comp);
//printf("res 2 %e\n",res);
return res;
}
else
{
//printf("absent var\n");
bits=bits<<1;
// printf("Var =1\n");
res=ProbBool(MyManager,node,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res 1 %e\n",res);
//printf("var =0\n");
res=res+
ProbBool(MyManager,node,bits,nBit-1,posBVar+1,v,comp);
// printf("res 2 %e\n",res);
return res;
}
}
}
int correctPosition(int index,variable v, DdNode * node,int posBVar)
/* returns 1 is the boolean variable with index posBVar is in the correct position
currently explored by ProbBool */
{
DdNode * bvar;
//printf("posbvar %d\n",posBVar);
//printf("length %d\n",array_n(v.booleanVars));
//bvar=array_fetch(DdNode *,v.booleanVars,posBVar);
bvar=v.booleanVars[posBVar];
// return var->index==index;
return(Cudd_NodeReadIndex(bvar)==index);
}
gint my_equal(gconstpointer v,gconstpointer v2)
/* function used by GHashTable to compare two keys */
{
DdNode *a,*b;
a=*(DdNode **)v;
b=*(DdNode **)v2;
return (a==b);
}
guint my_hash(gconstpointer key)
/* function used by GHashTable to hash a key */
{
unsigned int h;
h=(unsigned int)((unsigned long) *((DdNode **)key) % dividend);
return h;
}
void dealloc(gpointer key,gpointer value,gpointer user_data)
{
free(key);
free(value);
}
double ret_prob(extmanager MyManager, DdNode * bdd)
{
int intBits,j;
double prob;
nodes=g_hash_table_new(my_hash,my_equal);
intBits=sizeof(unsigned int)*8;
/* dividend is a global variable used by my_hash
it is equal to an unsigned int with binary representation 11..1 */
dividend=1;
for(j=1;j<intBits;j++)
{
dividend=(dividend<<1)+1;
}
prob=Prob(MyManager,bdd,Cudd_IsComplement(bdd));
g_hash_table_foreach (nodes,dealloc,NULL);
g_hash_table_destroy(nodes);
return prob;
}

234
packages/cplint/approx/simplecuddLPADs/.svn/text-base/general.c.svn-base Normal file
View File

@ -0,0 +1,234 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: general.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "general.h"
/* Number Handling */
int IsRealNumber(char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (c[i] == '.') return IsPosNumber(&c[i + 1]);
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
int IsPosNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
for(i = 0; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return 1;
}
int IsNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
/* File Handling */
char * freadstr(FILE *fd, const char *separators) {
char *str;
int buf, icur = 0, max = 10;
str = (char *) malloc(sizeof(char) * max);
str[0] = '\0';
do {
if ((buf = fgetc(fd)) != EOF) {
if (icur == (max - 1)) {
max = max * 2;
str = (char *) realloc(str, sizeof(char) * max);
}
if (!CharIn((char) buf, separators)) {
str[icur] = (char) buf;
icur++;
str[icur] = '\0';
}
}
} while(!CharIn(buf, separators) && !feof(fd));
return str;
}
int CharIn(const char c, const char *in) {
int i;
for (i = 0; i < strlen(in); i++)
if (c == in[i]) return 1;
return 0;
}
/* string handling */
int patternmatch(char *pattern, char *thestr) {
int i, j = -1, pl = strlen(pattern), sl = strlen(thestr);
for(i = 0; i < pl; i++) {
if (pattern[i] == '*') {
do {
i++;
if (i == pl) return 1;
} while(pattern[i] == '*');
do {
j++;
if (j >= sl) return 0;
if ((thestr[j] == pattern[i]) && patternmatch(pattern + i, thestr + j)) return 1;
} while(1);
} else {
j++;
if (j >= sl) return 0;
if (pattern[i] != thestr[j]) return 0;
}
}
return (pl == sl);
}

159
packages/cplint/approx/simplecuddLPADs/.svn/text-base/general.h.svn-base Normal file
View File

@ -0,0 +1,159 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: general.h *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define IsNumberDigit(c) ('0' <= c && c <= '9')
#define IsSignDigit(c) (c == '+' || c == '-')
#define isOperator(x) (x == '+' || x == '*' || x == '#' || x == '=')
#define freadline(fd) freadstr(fd, "\n");
int IsRealNumber(char *c);
int IsPosNumber(const char *c);
int IsNumber(const char *c);
char * freadstr(FILE *fd, const char *separators);
int CharIn(const char c, const char *in);
int patternmatch(char *pattern, char *thestr);

1747
packages/cplint/approx/simplecuddLPADs/.svn/text-base/simplecudd.c.svn-base Normal file
View File

File diff suppressed because it is too large Load Diff

306
packages/cplint/approx/simplecuddLPADs/.svn/text-base/simplecudd.h.svn-base Normal file
View File

@ -0,0 +1,306 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: simplecudd.h *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <time.h>
#include "util.h"
#include "cudd.h"
#include "cuddInt.h"
#include "general.h"
#define IsHigh(manager, node) HIGH(manager) == node
#define IsLow(manager, node) LOW(manager) == node
#define HIGH(manager) Cudd_ReadOne(manager)
#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager))
#define NOT(node) Cudd_Not(node)
#define GetIndex(node) Cudd_NodeReadIndex(node)
#define GetMVar(manager, index, value, varmap) equality(manager,index,value,varmap)//Cudd_bddIthVar(manager, index)
#define GetVar(manager, index) Cudd_bddIthVar(manager, index)
#define NewVar(manager) Cudd_bddNewVar(manager)
#define KillBDD(manager) Cudd_Quit(manager)
#define GetVarCount(manager) Cudd_ReadSize(manager)
#define DEBUGON _debug = 1
#define DEBUGOFF _debug = 0
#define RAPIDLOADON _RapidLoad = 1
#define RAPIDLOADOFF _RapidLoad = 0
#define SETMAXBUFSIZE(size) _maxbufsize = size
#define BDDFILE_ERROR -1
#define BDDFILE_OTHER 0
#define BDDFILE_SCRIPT 1
#define BDDFILE_NODEDUMP 2
extern int _RapidLoad;
extern int _debug;
extern int _maxbufsize;
typedef struct _bddfileheader {
FILE *inputfile;
int version;
int varcnt;
int bvarcnt;
int varstart;
int intercnt;
int filetype;
} bddfileheader;
typedef struct
{
int nVal,nBit,init;
double * probabilities;
int * booleanVars;
} variable;
typedef struct _namedvars {
int varcnt;
int varstart;
char **vars;
int *loaded;
double *dvalue;
int *ivalue;
void **dynvalue;
variable * mvars;
int * bVar2mVar;
} namedvars;
typedef struct _hisnode {
DdNode *key;
double dvalue;
int ivalue;
void *dynvalue;
} hisnode;
typedef struct _hisqueue {
int cnt;
hisnode *thenode;
} hisqueue;
typedef struct _nodeline {
char *varname;
char *truevar;
char *falsevar;
int nodenum;
int truenode;
int falsenode;
} nodeline;
/* Initialization */
DdManager* simpleBDDinit(int varcnt);
/* BDD Generation */
DdNode* D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader);
DdNode* OnlineGenerateBDD(DdManager *manager, namedvars *varmap);
DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline);
DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline);
DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper);
int getInterBDD(char *function);
char* getFileName(const char *function);
int GetParam(char *inputline, int iParam);
int LoadVariableData(namedvars varmap, char *filename);
int LoadMultiVariableData(DdManager * mgr,namedvars varmap, char *filename);
/* Named variables */
namedvars InitNamedVars(int varcnt, int varstart);
namedvars InitNamedMultiVars(int varcnt, int varstart, int bvarcnt);
void EnlargeNamedVars(namedvars *varmap, int newvarcnt);
int AddNamedVarAt(namedvars varmap, const char *varname, int index);
int AddNamedVar(namedvars varmap, const char *varname);
int AddNamedMultiVar(DdManager *mgr,namedvars varmap, const char *varnamei, int *value);
void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue);
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue);
int GetNamedVarIndex(const namedvars varmap, const char *varname);
int RepairVarcnt(namedvars *varmap);
char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node);
char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node);
int all_loaded(namedvars varmap, int disp);
/* Traversal */
DdNode* HighNodeOf(DdManager *manager, DdNode *node);
DdNode* LowNodeOf(DdManager *manager, DdNode *node);
/* Traversal - History */
hisqueue* InitHistory(int varcnt);
void ReInitHistory(hisqueue *HisQueue, int varcnt);
void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue);
hisnode* GetNode(hisqueue *HisQueue, int varstart, DdNode *node);
int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node);
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd);
/* Save-load */
bddfileheader ReadFileHeader(char *filename);
int CheckFileVersion(const char *version);
DdNode * LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile);
DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current);
DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum);
int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename);
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile);
void ExpandNodes(hisqueue *Nodes, int index, int nodenum);
/* Export */
int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename);
int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename);
DdNode * equality(DdManager *mgr,int varIndex,int value,namedvars varmap);
hisnode* GetNodei1(int *bVar2mVar,hisqueue *HisQueue, int varstart, DdNode *node);
void AddNode1(int *bVar2mVar, hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue);
hisnode* GetNode1(int *bVar2mVar,hisqueue *HisQueue, int varstart, DdNode *node);

54
packages/cplint/approx/simplecuddLPADs/Makefile.in Normal file
View File

@ -0,0 +1,54 @@
#
# default base directory for YAP installation
# (EROOT for architecture-dependent files)
#
prefix = @prefix@
ROOTDIR = $(prefix)
EROOTDIR = ${prefix}
#
# where the binary should be
#
BINDIR = $(EROOTDIR)/bin
#
# where YAP should look for libraries
#
LIBDIR=$(EROOTDIR)/lib/Yap
DESTDIR=$(prefix)/share/Yap
#
#
CC=@CC@
#
#
# You shouldn't need to change what follows.
#
INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
SHELL=/bin/sh
RANLIB=ranlib
SHLIB_CFLAGS=-shared -fPIC
SHLIB_SUFFIX=.so
CWD=$(PWD)
srcdir=@srcdir@
CPLINT_CFLAGS=@CPLINT_CFLAGS@
CPLINT_LDFLAGS=@CPLINT_LDFLAGS@
CPLINT_LIBS=@CPLINT_LIBS@
#
default: LPADBDD
LPADBDD: ProblogBDD.o simplecudd.o general.o
@echo Making ProblogBDD...
@echo Copyright T. Mantadelis, A. Kimmig, B. Gutmann and Katholieke Universiteit Leuven 2008
$(CC) $(CPLINT_LDFLAGS) ProblogBDD.o simplecudd.o general.o $(CPLINT_LIBS) -o LPADBDD
%.o : $(srcdir)/%.c
$(CC) $(CPLINT_CFLAGS) -c $<
clean:
rm -f *.o LPADBDD
install: default
$(INSTALL_PROGRAM) LPADBDD $(DESTDIR)

871
packages/cplint/approx/simplecuddLPADs/ProblogBDD.c Normal file
View File

@ -0,0 +1,871 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis, A. Kimmig, B. Gutmann *
* and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann *
* File: ProblogBDD.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "simplecudd.h"
#include <signal.h>
#include <time.h>
typedef struct _parameters {
int loadfile;
int savedfile;
int exportfile;
int inputfile;
int debug;
int errorcnt;
int *error;
int method;
int queryid;
int timeout;
double sigmoid_slope;
int online;
int maxbufsize;
char *ppid;
} parameters;
typedef struct _gradientpair {
double probability;
double gradient;
} gradientpair;
typedef struct _extmanager {
DdManager *manager;
DdNode *t, *f;
hisqueue *his;
namedvars varmap;
} extmanager;
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp);
double Prob(extmanager MyManager, DdNode *node, int comp);
int correctPosition(int index,variable v,int posBVar);
double ret_prob(extmanager MyManager, DdNode * bdd);
int argtype(const char *arg);
void printhelp(int argc, char **arg);
parameters loadparam(int argc, char **arg);
parameters params;
void handler(int num);
void pidhandler(int num);
void termhandler(int num);
double sigmoid(double x, double slope);
void myexpand(extmanager MyManager, DdNode *Current);
double CalcProbability(extmanager MyManager, DdNode *Current);
double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current);
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern);
int patterncalculated(char *pattern, extmanager MyManager, int loc);
char * extractpattern(char *thestr);
int main(int argc, char **arg) {
clock_t start, endc, endt;
double elapsedc,elapsedt;
extmanager MyManager;
DdNode *bdd;
bddfileheader fileheader;
int i, ivarcnt, code;
gradientpair tvalue;
double probability = -1.0;
char *varpattern;
varpattern = NULL;
code = -1;
params = loadparam(argc, arg);
if (params.errorcnt > 0) {
printhelp(argc, arg);
for (i = 0; i < params.errorcnt; i++) {
fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]);
}
return -1;
}
if (params.online == 0 && params.loadfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: you must specify a loading file.\n");
return -1;
}
if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l') {
printhelp(argc, arg);
fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [o]nline.\n");
return -1;
}
if (params.debug) DEBUGON;
RAPIDLOADON;
SETMAXBUFSIZE(params.maxbufsize);
signal(SIGINT, termhandler);
if (params.ppid != NULL) {
signal(SIGALRM, pidhandler);
alarm(5);
} else {
signal(SIGALRM, handler);
alarm(params.timeout);
}
if (params.online) {
MyManager.manager = simpleBDDinit(0);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(1, 0);
bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap);
ivarcnt = GetVarCount(MyManager.manager);
} else {
fileheader = ReadFileHeader(arg[params.loadfile]);
switch(fileheader.filetype) {
case BDDFILE_SCRIPT:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedMultiVars(fileheader.varcnt, fileheader.varstart,fileheader.bvarcnt);
if (LoadMultiVariableData(MyManager.manager,MyManager.varmap, arg[params.inputfile]) == -1) return -1;
start = clock();
bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader);
endc=clock();
elapsedc = ((double) (endc - start)) / CLOCKS_PER_SEC;
printf("elapsed_construction(%lf).\n",elapsedc);
ivarcnt = fileheader.varcnt;
break;
case BDDFILE_NODEDUMP:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart);
bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile);
ivarcnt = fileheader.varcnt;
break;
default:
fprintf(stderr, "Error: not a valid file format to load.\n");
return -1;
break;
}
}
alarm(0);
// problem specifics
if (bdd != NULL) {
ivarcnt = RepairVarcnt(&MyManager.varmap);
code = 0;
/*
if (params.inputfile != -1) {
if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1;
if (!all_loaded(MyManager.varmap, 1)) return -1;
}*/
MyManager.his = InitHistory(ivarcnt);
if (params.method != 0) {
switch(arg[params.method][0]) {
case 'g':
for (i = 0; i < MyManager.varmap.varcnt; i++) {
if (MyManager.varmap.vars[i] != NULL) {
varpattern = extractpattern(MyManager.varmap.vars[i]);
if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) {
tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern);
probability = tvalue.probability;
double factor = sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope) * (1 - sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope)) * params.sigmoid_slope;
if (varpattern == NULL) {
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient * factor);
} else {
varpattern[strlen(varpattern) - 2] = '\0';
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], varpattern, tvalue.gradient * factor);
}
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
}
if (varpattern != NULL) free(varpattern);
} else {
fprintf(stderr, "Error: no variable name given for parameter.\n");
}
}
if (probability < 0.0) {
// no nodes, so we have to calculate probability ourself
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
}
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'l':
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'p':
printf("probability(%1.12f).\n", CalcProbability(MyManager, bdd));
break;
case 'o':
onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd);
break;
default:
myexpand(MyManager, bdd);
break;
}
} else {
start=clock();
// simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, "bdd.dot");
printf("probability(%1.12f).\n", ret_prob(MyManager, bdd));
endt=clock();
elapsedt = ((double) (endt - start)) / CLOCKS_PER_SEC;
printf("elapsed_traversing(%lf).\n",elapsedt);
// myexpand(MyManager, bdd);
}
if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]);
if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]);
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
free(MyManager.his);
}
if (MyManager.manager != NULL) {
KillBDD(MyManager.manager);
exit(code);
free(MyManager.varmap.dvalue);
free(MyManager.varmap.ivalue);
free(MyManager.varmap.dynvalue);
for (i = 0; i < MyManager.varmap.varcnt; i++)
{
free(MyManager.varmap.vars[i]);
free(MyManager.varmap.mvars[i].probabilities);
free(MyManager.varmap.mvars[i].booleanVars);
}
free(MyManager.varmap.vars);
free(MyManager.varmap.mvars);
free(MyManager.varmap.bVar2mVar);
}
if (params.error != NULL) free(params.error);
return code;
}
/* Shell Parameters handling */
int argtype(const char *arg) {
if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0;
if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2;
if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3;
if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4;
if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5;
if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6;
if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7;
if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8;
if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9;
if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10;
if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11;
if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12;
if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13;
return -1;
}
void printhelp(int argc, char **arg) {
fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]);
fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n");
fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n");
fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n");
fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n");
fprintf(stderr, "Optional parameters:\n");
fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n");
fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n");
fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [o]nline\n");
fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]);
fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n");
fprintf(stderr, "Extra parameters:\n");
fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n");
fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check works only under POSIX OS\n");
fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n");
fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n");
fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n\n");
fprintf(stderr, "Example: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]);
}
parameters loadparam(int argc, char **arg) {
int i;
parameters params;
params.loadfile = -1;
params.savedfile = -1;
params.exportfile = -1;
params.method = 0;
params.inputfile = -1;
params.debug = 0;
params.errorcnt = 0;
params.queryid = 0;
params.timeout = 0;
params.sigmoid_slope = 1.0;
params.online = 0;
params.maxbufsize = 0;
params.ppid = NULL;
params.error = (int *) malloc(argc * sizeof(int));
for (i = 1; i < argc; i++) {
switch(argtype(arg[i])) {
case 0:
if (argc > i + 1) {
i++;
params.loadfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 2:
if (argc > i + 1) {
i++;
params.exportfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 3:
if (argc > i + 1) {
i++;
params.method = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 4:
if (argc > i + 1) {
i++;
params.inputfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 5:
printhelp(argc, arg);
break;
case 6:
params.debug = 1;
break;
case 7:
if (argc > i + 1) {
i++;
params.queryid = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 8:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.timeout = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 9:
if (argc > i + 1) {
i++;
params.savedfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 10:
if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) {
i++;
params.sigmoid_slope = atof(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 11:
params.online = 1;
break;
case 12:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.maxbufsize = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 13:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1));
strcpy(params.ppid, arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
default:
params.error[params.errorcnt] = i;
params.errorcnt++;
break;
}
}
return params;
}
/* Error Handlers */
void handler(int num) {
fprintf(stderr, "Error: Timeout %i exceeded.\n", params.timeout);
exit(-1);
}
void pidhandler(int num) {
char *s;
if (params.timeout > 0) {
params.timeout -= 5;
if (params.timeout <= 0) {
fprintf(stderr, "Error: Timeout exceeded.\n");
exit(-1);
}
}
s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid)));
strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null");
if (system(s) != 0) exit(4);
signal(SIGALRM, pidhandler);
alarm(5);
free(s);
}
void termhandler(int num) {
exit(3);
}
/* General Functions */
double sigmoid(double x, double slope) {
return 1 / (1 + exp(-x * slope));
}
/* Debugging traverse function */
void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) &&
((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) {
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
printf("l(%s)->", curnode);
myexpand(MyManager, l);
printf("h(%s)->", curnode);
myexpand(MyManager, h);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, 0.0, 0, NULL);
}
}
/* Angelikas Algorithm */
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
double lvalue, hvalue, tvalue;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) return 1.0;
if (Current == MyManager.f) return 0.0;
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) return Found->dvalue;
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcProbability(MyManager, l);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcProbability(MyManager, h);
tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart];
tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL);
return tvalue;
}
/* Bernds Algorithm */
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
gradientpair lvalue, hvalue, tvalue;
double this_probability;
double *gradient;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) {
tvalue.probability = 1.0;
tvalue.gradient = 0.0;
return tvalue;
}
if (Current == MyManager.f) {
tvalue.probability = 0.0;
tvalue.gradient = 0.0;
return tvalue;
}
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) {
tvalue.probability = Found->dvalue;
tvalue.gradient = *((double *) Found->dynvalue);
return tvalue;
}
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern);
this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope);
tvalue.probability = this_probability * hvalue.probability + (1 - this_probability) * lvalue.probability;
tvalue.gradient = this_probability * hvalue.gradient + (1 - this_probability) * lvalue.gradient;
if ((GetIndex(Current) == TargetVar) ||
((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) {
tvalue.gradient += hvalue.probability - lvalue.probability;
}
gradient = (double *) malloc(sizeof(double));
*gradient = tvalue.gradient;
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient);
return tvalue;
}
char * extractpattern(char *thestr) {
char *p;
int i = 0, sl = strlen(thestr);
while((thestr[i] != '_') && (i < sl)) i++;
if (i == sl) return NULL;
i++;
p = (char *) malloc(sizeof(char) * (i + 2));
strncpy(p, thestr, i);
p[i] = '*';
p[i + 1] = '\0';
return p;
}
int patterncalculated(char *pattern, extmanager MyManager, int loc) {
int i;
if (pattern == NULL) return 0;
for (i = loc - 1; i > -1; i--)
if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1;
return 0;
}
double Prob(extmanager MyManager, DdNode *node, int comp)
/* compute the probability of the expression rooted at node
nodes is used to store nodes for which the probability has alread been computed
so that it is not recomputed
*/
{
int mVarIndex,nBit,index;
variable v;
hisnode *Found;
double res;
double value;
//printf("Prob node %d\n",node);
//index=Cudd_NodeReadIndex(node);
//printf("Prob INdex %d\n",index);
if (Cudd_IsConstant(node))
{
value=Cudd_V(node);//node->type.value;
//printf("Value %e comp %d\n",value,comp);
if (comp)//Cudd_IsComplement(node))
//return (1.0-value);
//if (value>0)
{
// printf("return 0");
return 0.0;
}
else
{
// printf("return 1");
return 1.0;
}
/*else
if (value>0)
return 1.0;
else
return 0.0;
*/ //return value;
}
else
{
Found = GetNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node);
if (Found!=NULL)
{
//printf("value found %e\n",Found->dvalue);
return Found->dvalue;
}
else
{
index=Cudd_NodeReadIndex(node);
//printf("node absent %d comp %d\n",node,comp);
//mVarIndex=array_fetch(int,bVar2mVar,index);
mVarIndex=MyManager.varmap.bVar2mVar[index];
//v=array_fetch(variable,vars,mVarIndex);
v=MyManager.varmap.mvars[mVarIndex];
nBit=v.nBit;
// printf("calling prob bool mvar %d nbit %d\n",mVarIndex,nBit);
//scanf("%d",&r);
res=ProbBool(MyManager,node,0,nBit,0,v,comp);
//printf("New val %e\n",res);
AddNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node, res, 0, NULL);
return res;
}
}
}
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp)
/* explores a group of binary variables making up the multivalued variable v */
{
DdNode *T,*F;
double p,res;
double * probs;
int index;
// printf("ProbBool nBit %d\n",nBit);
//scanf("%d",&r);
probs=v.probabilities;
if (nBit==0)
{
//printf("last var bits %d larray %d comp %d\n",bits,array_n(probs),comp);
// printf("bits %d v.nbit %d\n",bits,v.nBit);
if (bits>=v.nVal)
//if (comp)
{
//printf("bits>=v.nbit return 0\n");
return 0.0;
}
//else
//{printf("return 0\n");
//return 1.0;}}
else
{
// printf("Val %d\n",bits);
//p=array_fetch(double,probs,bits);
p=probs[bits];
//printf("prob %e\n",p);
res=p*Prob(MyManager,node,comp);
//printf("prob %e\n",p);
//printf("bottom %e\n",res);
return res;
}
}
else
{
//if (correctPosition(node->index,v,node,posBVar))
index=Cudd_NodeReadIndex(node);
//printf("index %d\n",Cudd_NodeReadIndex(node));
if (correctPosition(index,v,posBVar))
{
//printf("node %d\n",node);
T = Cudd_T(node);//node->type.kids.T;
F = Cudd_E(node);//node->type.kids.E;
bits=bits<<1;
//printf("calling on the true child %di complement %d\n",T,Cudd_IsComplement(T));
res=ProbBool(MyManager,T,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res %e\ncalling on the else child %d c %d\n",res,F,Cudd_IsComplement(F));
//printf("comp %d ",comp);
comp=(!comp && Cudd_IsComplement(F)) || (comp && !Cudd_IsComplement(F));
//printf("comp %d \n",comp);
res=res+
ProbBool(MyManager,F,bits,nBit-1,posBVar+1,v,comp);
//printf("res 2 %e\n",res);
return res;
}
else
{
//printf("absent var\n");
bits=bits<<1;
// printf("Var =1\n");
res=ProbBool(MyManager,node,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res 1 %e\n",res);
//printf("var =0\n");
res=res+
ProbBool(MyManager,node,bits,nBit-1,posBVar+1,v,comp);
// printf("res 2 %e\n",res);
return res;
}
}
}
int correctPosition(int index,variable v,int posBVar)
/* returns 1 is the boolean variable with index posBVar is in the correct position
currently explored by ProbBool */
{
int bvar;
//printf("posbvar %d\n",posBVar);
//printf("length %d\n",array_n(v.booleanVars));
//bvar=array_fetch(DdNode *,v.booleanVars,posBVar);
bvar=v.booleanVars[posBVar];
// return var->index==index;
return(bvar==index);
}
double ret_prob(extmanager MyManager, DdNode * bdd)
{
double prob;
/* dividend is a global variable used by my_hash
it is equal to an unsigned int with binary representation 11..1 */
prob=Prob(MyManager,bdd,Cudd_IsComplement(bdd));
return prob;
}

895
packages/cplint/approx/simplecuddLPADs/ProblogBDDclus.c Normal file
View File

@ -0,0 +1,895 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis, A. Kimmig, B. Gutmann *
* and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis, Angelika Kimmig, Bernd Gutmann *
* File: ProblogBDD.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "simplecudd.h"
#include <signal.h>
typedef struct _parameters {
int loadfile;
int savedfile;
int exportfile;
int inputfile;
int debug;
int errorcnt;
int *error;
int method;
int queryid;
int timeout;
double sigmoid_slope;
int online;
int maxbufsize;
char *ppid;
} parameters;
typedef struct _gradientpair {
double probability;
double gradient;
} gradientpair;
typedef struct _extmanager {
DdManager *manager;
DdNode *t, *f;
hisqueue *his;
namedvars varmap;
} extmanager;
GHashTable * nodes; /* hash table that associates nodes with their probability if already
computed, it is defined in glib */
unsigned long dividend;
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp);
double Prob(extmanager MyManager, DdNode *node, int comp);
int correctPosition(int index,variable v, DdNode * node,int posBVar);
gint my_equal(gconstpointer v,gconstpointer v2);
guint my_hash(gconstpointer key);
void dealloc(gpointer key,gpointer value,gpointer user_data);
double ret_prob(extmanager MyManager, DdNode * bdd);
int argtype(const char *arg);
void printhelp(int argc, char **arg);
parameters loadparam(int argc, char **arg);
parameters params;
void handler(int num);
void pidhandler(int num);
void termhandler(int num);
double sigmoid(double x, double slope);
void myexpand(extmanager MyManager, DdNode *Current);
double CalcProbability(extmanager MyManager, DdNode *Current);
double CalcProbabilitySigmoid(extmanager MyManager, DdNode *Current);
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern);
int patterncalculated(char *pattern, extmanager MyManager, int loc);
char * extractpattern(char *thestr);
int main(int argc, char **arg) {
extmanager MyManager;
DdNode *bdd;
bddfileheader fileheader;
int i, ivarcnt, code;
gradientpair tvalue;
double probability = -1.0;
char *varpattern;
varpattern = NULL;
code = -1;
params = loadparam(argc, arg);
if (params.errorcnt > 0) {
printhelp(argc, arg);
for (i = 0; i < params.errorcnt; i++) {
fprintf(stderr, "Error: not known or error at parameter %s.\n", arg[params.error[i]]);
}
return -1;
}
if (params.online == 0 && params.loadfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: you must specify a loading file.\n");
return -1;
}
if (params.method != 0 && arg[params.method][0] != 'g' && arg[params.method][0] != 'p' && arg[params.method][0] != 'o' && arg[params.method][0] != 'l') {
printhelp(argc, arg);
fprintf(stderr, "Error: you must choose a calculation method beetween [p]robability, [g]radient, [l]ine search, [o]nline.\n");
return -1;
}
if (params.debug) DEBUGON;
RAPIDLOADON;
SETMAXBUFSIZE(params.maxbufsize);
signal(SIGINT, termhandler);
if (params.ppid != NULL) {
signal(SIGALRM, pidhandler);
alarm(5);
} else {
signal(SIGALRM, handler);
alarm(params.timeout);
}
if (params.online) {
MyManager.manager = simpleBDDinit(0);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(1, 0);
bdd = OnlineGenerateBDD(MyManager.manager, &MyManager.varmap);
ivarcnt = GetVarCount(MyManager.manager);
} else {
fileheader = ReadFileHeader(arg[params.loadfile]);
switch(fileheader.filetype) {
case BDDFILE_SCRIPT:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedMultiVars(fileheader.varcnt, fileheader.varstart,fileheader.bvarcnt);
if (LoadMultiVariableData(MyManager.manager,MyManager.varmap, arg[params.inputfile]) == -1) return -1;
bdd = FileGenerateBDD(MyManager.manager, MyManager.varmap, fileheader);
ivarcnt = fileheader.varcnt;
break;
case BDDFILE_NODEDUMP:
if (params.inputfile == -1) {
printhelp(argc, arg);
fprintf(stderr, "Error: an input file is necessary for this type of loading file.\n");
return -1;
}
MyManager.manager = simpleBDDinit(fileheader.varcnt);
MyManager.t = HIGH(MyManager.manager);
MyManager.f = LOW(MyManager.manager);
MyManager.varmap = InitNamedVars(fileheader.varcnt, fileheader.varstart);
bdd = LoadNodeDump(MyManager.manager, MyManager.varmap, fileheader.inputfile);
ivarcnt = fileheader.varcnt;
break;
default:
fprintf(stderr, "Error: not a valid file format to load.\n");
return -1;
break;
}
}
alarm(0);
// problem specifics
if (bdd != NULL) {
ivarcnt = RepairVarcnt(&MyManager.varmap);
code = 0;
/*
if (params.inputfile != -1) {
if (LoadVariableData(MyManager.varmap, arg[params.inputfile]) == -1) return -1;
if (!all_loaded(MyManager.varmap, 1)) return -1;
}*/
MyManager.his = InitHistory(ivarcnt);
if (params.method != 0) {
switch(arg[params.method][0]) {
case 'g':
for (i = 0; i < MyManager.varmap.varcnt; i++) {
if (MyManager.varmap.vars[i] != NULL) {
varpattern = extractpattern(MyManager.varmap.vars[i]);
if ((varpattern == NULL) || (!patterncalculated(varpattern, MyManager, i))) {
tvalue = CalcGradient(MyManager, bdd, i + MyManager.varmap.varstart, varpattern);
probability = tvalue.probability;
double factor = sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope) * (1 - sigmoid(MyManager.varmap.dvalue[i], params.sigmoid_slope)) * params.sigmoid_slope;
if (varpattern == NULL) {
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], MyManager.varmap.vars[i], tvalue.gradient * factor);
} else {
varpattern[strlen(varpattern) - 2] = '\0';
printf("query_gradient(%s,%s,%1.12f).\n", arg[params.queryid], varpattern, tvalue.gradient * factor);
}
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
}
if (varpattern != NULL) free(varpattern);
} else {
fprintf(stderr, "Error: no variable name given for parameter.\n");
}
}
if (probability < 0.0) {
// no nodes, so we have to calculate probability ourself
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
}
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'l':
tvalue = CalcGradient(MyManager, bdd, 0 + MyManager.varmap.varstart, NULL);
probability = tvalue.probability;
printf("query_probability(%s,%1.12f).\n", arg[params.queryid], probability);
break;
case 'p':
printf("probability(%1.12f).\n", CalcProbability(MyManager, bdd));
break;
case 'o':
onlinetraverse(MyManager.manager, MyManager.varmap, MyManager.his, bdd);
break;
default:
myexpand(MyManager, bdd);
break;
}
} else {
//simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, "bdd.dot");
printf("probability(%1.12f).\n", ret_prob(MyManager, bdd));
// myexpand(MyManager, bdd);
}
if (params.savedfile > -1) SaveNodeDump(MyManager.manager, MyManager.varmap, bdd, arg[params.savedfile]);
if (params.exportfile > -1) simpleNamedBDDtoDot(MyManager.manager, MyManager.varmap, bdd, arg[params.exportfile]);
ReInitHistory(MyManager.his, MyManager.varmap.varcnt);
free(MyManager.his);
}
if (MyManager.manager != NULL) {
KillBDD(MyManager.manager);
free(MyManager.varmap.dvalue);
free(MyManager.varmap.ivalue);
free(MyManager.varmap.dynvalue);
for (i = 0; i < MyManager.varmap.varcnt; i++)
{
free(MyManager.varmap.vars[i]);
free(MyManager.varmap.mvars[i].probabilities);
free(MyManager.varmap.mvars[i].booleanVars);
}
free(MyManager.varmap.vars);
free(MyManager.varmap.mvars);
free(MyManager.varmap.bVar2mVar);
}
if (params.error != NULL) free(params.error);
return code;
}
/* Shell Parameters handling */
int argtype(const char *arg) {
if (strcmp(arg, "-l") == 0 || strcmp(arg, "--load") == 0) return 0;
if (strcmp(arg, "-e") == 0 || strcmp(arg, "--export") == 0) return 2;
if (strcmp(arg, "-m") == 0 || strcmp(arg, "--method") == 0) return 3;
if (strcmp(arg, "-i") == 0 || strcmp(arg, "--input") == 0) return 4;
if (strcmp(arg, "-h") == 0 || strcmp(arg, "--help") == 0) return 5;
if (strcmp(arg, "-d") == 0 || strcmp(arg, "--debug") == 0) return 6;
if (strcmp(arg, "-id") == 0 || strcmp(arg, "--queryid") == 0) return 7;
if (strcmp(arg, "-t") == 0 || strcmp(arg, "--timeout") == 0) return 8;
if (strcmp(arg, "-sd") == 0 || strcmp(arg, "--savedump") == 0) return 9;
if (strcmp(arg, "-sl") == 0 || strcmp(arg, "--slope") == 0) return 10;
if (strcmp(arg, "-o") == 0 || strcmp(arg, "--online") == 0) return 11;
if (strcmp(arg, "-bs") == 0 || strcmp(arg, "--bufsize") == 0) return 12;
if (strcmp(arg, "-pid") == 0 || strcmp(arg, "--pid") == 0) return 13;
return -1;
}
void printhelp(int argc, char **arg) {
fprintf(stderr, "\nUsage: %s -l [filename] -i [filename] -o (-s(d) [filename] -e [filename] -m [method] -id [queryid] -sl [double]) (-t [seconds] -d -h)\n", arg[0]);
fprintf(stderr, "Generates and traverses a BDD\nMandatory parameters:\n");
fprintf(stderr, "\t-l [filename]\t->\tfilename to load supports two formats:\n\t\t\t\t\t\t1. script with generation instructions\n\t\t\t\t\t\t2. node dump saved file\n");
fprintf(stderr, "\t-i [filename]\t->\tfilename to input problem specifics (mandatory with file formats 1, 2)\n");
fprintf(stderr, "\t-o\t\t->\tgenerates the BDD in online mode instead from a file can be used instead of -l\n");
fprintf(stderr, "Optional parameters:\n");
fprintf(stderr, "\t-sd [filename]\t->\tfilename to save generated BDD in node dump format (fast loading, traverse valid only)\n");
fprintf(stderr, "\t-e [filename]\t->\tfilename to export generated BDD in dot format\n");
fprintf(stderr, "\t-m [method]\t->\tthe calculation method to be used: none(default), [p]robability, [g]radient, [o]nline\n");
fprintf(stderr, "\t-id [queryid]\t->\tthe queries identity name (used by gradient) default: %s\n", arg[0]);
fprintf(stderr, "\t-sl [double]\t->\tthe sigmoid slope (used by gradient) default: 1.0\n");
fprintf(stderr, "Extra parameters:\n");
fprintf(stderr, "\t-t [seconds]\t->\tthe seconds (int) for BDD generation timeout default 0 = no timeout\n");
fprintf(stderr, "\t-pid [pid]\t->\ta process id (int) to check for termination default 0 = no process to check works only under POSIX OS\n");
fprintf(stderr, "\t-bs [bytes]\t->\tthe bytes (int) to use as a maximum buffer size to read files default 0 = no max\n");
fprintf(stderr, "\t-d\t\t->\tRun in debug mode (gives extra messages in stderr)\n");
fprintf(stderr, "\t-h\t\t->\tHelp (displays this message)\n\n");
fprintf(stderr, "Example: %s -l testbdd -i input.txt -m g -id testbdd\n", arg[0]);
}
parameters loadparam(int argc, char **arg) {
int i;
parameters params;
params.loadfile = -1;
params.savedfile = -1;
params.exportfile = -1;
params.method = 0;
params.inputfile = -1;
params.debug = 0;
params.errorcnt = 0;
params.queryid = 0;
params.timeout = 0;
params.sigmoid_slope = 1.0;
params.online = 0;
params.maxbufsize = 0;
params.ppid = NULL;
params.error = (int *) malloc(argc * sizeof(int));
for (i = 1; i < argc; i++) {
switch(argtype(arg[i])) {
case 0:
if (argc > i + 1) {
i++;
params.loadfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 2:
if (argc > i + 1) {
i++;
params.exportfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 3:
if (argc > i + 1) {
i++;
params.method = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 4:
if (argc > i + 1) {
i++;
params.inputfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 5:
printhelp(argc, arg);
break;
case 6:
params.debug = 1;
break;
case 7:
if (argc > i + 1) {
i++;
params.queryid = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 8:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.timeout = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 9:
if (argc > i + 1) {
i++;
params.savedfile = i;
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 10:
if ((argc > i + 1) && (IsRealNumber(arg[i + 1]))) {
i++;
params.sigmoid_slope = atof(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 11:
params.online = 1;
break;
case 12:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.maxbufsize = atoi(arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
case 13:
if ((argc > i + 1) && (IsPosNumber(arg[i + 1]))) {
i++;
params.ppid = (char *) malloc(sizeof(char) * (strlen(arg[i]) + 1));
strcpy(params.ppid, arg[i]);
} else {
params.error[params.errorcnt] = i;
params.errorcnt++;
}
break;
default:
params.error[params.errorcnt] = i;
params.errorcnt++;
break;
}
}
return params;
}
/* Error Handlers */
void handler(int num) {
fprintf(stderr, "Error: Timeout %i exceeded.\n", params.timeout);
exit(-1);
}
void pidhandler(int num) {
char *s;
if (params.timeout > 0) {
params.timeout -= 5;
if (params.timeout <= 0) {
fprintf(stderr, "Error: Timeout exceeded.\n");
exit(-1);
}
}
s = (char *) malloc(sizeof(char) * (19 + strlen(params.ppid)));
strcpy(s, "ps "); strcat(s, params.ppid); strcat(s, " >/dev/null");
if (system(s) != 0) exit(4);
signal(SIGALRM, pidhandler);
alarm(5);
free(s);
}
void termhandler(int num) {
exit(3);
}
/* General Functions */
double sigmoid(double x, double slope) {
return 1 / (1 + exp(-x * slope));
}
/* Debugging traverse function */
void myexpand(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
printf("%s\n", curnode);
if ((Current != MyManager.t) && (Current != MyManager.f) &&
((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) == NULL)) {
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
printf("l(%s)->", curnode);
myexpand(MyManager, l);
printf("h(%s)->", curnode);
myexpand(MyManager, h);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, 0.0, 0, NULL);
}
}
/* Angelikas Algorithm */
double CalcProbability(extmanager MyManager, DdNode *Current) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
double lvalue, hvalue, tvalue;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) return 1.0;
if (Current == MyManager.f) return 0.0;
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) return Found->dvalue;
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcProbability(MyManager, l);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcProbability(MyManager, h);
tvalue = MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart];
tvalue = tvalue * hvalue + lvalue * (1.0 - tvalue);
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue, 0, NULL);
return tvalue;
}
/* Bernds Algorithm */
gradientpair CalcGradient(extmanager MyManager, DdNode *Current, int TargetVar, char *TargetPattern) {
DdNode *h, *l;
hisnode *Found;
char *curnode;
gradientpair lvalue, hvalue, tvalue;
double this_probability;
double *gradient;
if (params.debug) {
curnode = GetNodeVarNameDisp(MyManager.manager, MyManager.varmap, Current);
fprintf(stderr, "%s\n", curnode);
}
if (Current == MyManager.t) {
tvalue.probability = 1.0;
tvalue.gradient = 0.0;
return tvalue;
}
if (Current == MyManager.f) {
tvalue.probability = 0.0;
tvalue.gradient = 0.0;
return tvalue;
}
if ((Found = GetNode(MyManager.his, MyManager.varmap.varstart, Current)) != NULL) {
tvalue.probability = Found->dvalue;
tvalue.gradient = *((double *) Found->dynvalue);
return tvalue;
}
l = LowNodeOf(MyManager.manager, Current);
h = HighNodeOf(MyManager.manager, Current);
if (params.debug) fprintf(stderr, "l(%s)->", curnode);
lvalue = CalcGradient(MyManager, l, TargetVar, TargetPattern);
if (params.debug) fprintf(stderr, "h(%s)->", curnode);
hvalue = CalcGradient(MyManager, h, TargetVar, TargetPattern);
this_probability = sigmoid(MyManager.varmap.dvalue[GetIndex(Current) - MyManager.varmap.varstart], params.sigmoid_slope);
tvalue.probability = this_probability * hvalue.probability + (1 - this_probability) * lvalue.probability;
tvalue.gradient = this_probability * hvalue.gradient + (1 - this_probability) * lvalue.gradient;
if ((GetIndex(Current) == TargetVar) ||
((TargetPattern != NULL) && patternmatch(TargetPattern, MyManager.varmap.vars[GetIndex(Current)]))) {
tvalue.gradient += hvalue.probability - lvalue.probability;
}
gradient = (double *) malloc(sizeof(double));
*gradient = tvalue.gradient;
AddNode(MyManager.his, MyManager.varmap.varstart, Current, tvalue.probability, 0, gradient);
return tvalue;
}
char * extractpattern(char *thestr) {
char *p;
int i = 0, sl = strlen(thestr);
while((thestr[i] != '_') && (i < sl)) i++;
if (i == sl) return NULL;
i++;
p = (char *) malloc(sizeof(char) * (i + 2));
strncpy(p, thestr, i);
p[i] = '*';
p[i + 1] = '\0';
return p;
}
int patterncalculated(char *pattern, extmanager MyManager, int loc) {
int i;
if (pattern == NULL) return 0;
for (i = loc - 1; i > -1; i--)
if (patternmatch(pattern, MyManager.varmap.vars[i])) return 1;
return 0;
}
double Prob(extmanager MyManager, DdNode *node, int comp)
/* compute the probability of the expression rooted at node
nodes is used to store nodes for which the probability has alread been computed
so that it is not recomputed
*/
{
int index,mVarIndex,nBit;
variable v;
hisnode *Found;
double res;
double value;
//index=node->index;
//printf("Prob node %d\n",node);
//index=Cudd_NodeReadIndex(node);
//printf("Prob INdex %d\n",index);
if (Cudd_IsConstant(node))
{
value=Cudd_V(node);//node->type.value;
//printf("Value %e comp %d\n",value,comp);
if (comp)//Cudd_IsComplement(node))
//return (1.0-value);
//if (value>0)
{
// printf("return 0");
return 0.0;
}
else
{
// printf("return 1");
return 1.0;
}
/*else
if (value>0)
return 1.0;
else
return 0.0;
*/ //return value;
}
else
{
Found = GetNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node);
if (Found!=NULL)
{
//printf("value found %e\n",*value_p);
return Found->dvalue;
}
else
{
index=Cudd_NodeReadIndex(node);
//printf("node absent %d comp %d\n",node,comp);
//mVarIndex=array_fetch(int,bVar2mVar,index);
mVarIndex=MyManager.varmap.bVar2mVar[index];
//v=array_fetch(variable,vars,mVarIndex);
v=MyManager.varmap.mvars[mVarIndex];
nBit=v.nBit;
// printf("calling prob bool mvar %d nbit %d\n",mVarIndex,nBit);
//scanf("%d",&r);
res=ProbBool(MyManager,node,0,nBit,0,v,comp);
//printf("New val %e\n",res);
AddNode1(MyManager.varmap.bVar2mVar,MyManager.his, MyManager.varmap.varstart, node, res, 0, NULL);
return res;
}
}
}
double ProbBool(extmanager MyManager, DdNode *node, int bits, int nBit,int posBVar,variable v, int comp)
/* explores a group of binary variables making up the multivalued variable v */
{
DdNode *T,*F;
double p,res;
double * probs;
int index;
// printf("ProbBool nBit %d\n",nBit);
//scanf("%d",&r);
probs=v.probabilities;
if (nBit==0)
{
//printf("last var bits %d larray %d comp %d\n",bits,array_n(probs),comp);
// printf("bits %d v.nbit %d\n",bits,v.nBit);
if (bits>=v.nVal)
//if (comp)
{
//printf("bits>=v.nbit return 0\n");
return 0.0;
}
//else
//{printf("return 0\n");
//return 1.0;}}
else
{
// printf("Val %d\n",bits);
//p=array_fetch(double,probs,bits);
p=probs[bits];
//printf("prob %e\n",p);
res=p*Prob(MyManager,node,comp);
//printf("prob %e\n",p);
//printf("bottom %e\n",res);
return res;
}
}
else
{
//if (correctPosition(node->index,v,node,posBVar))
index=Cudd_NodeReadIndex(node);
//printf("index %d\n",Cudd_NodeReadIndex(node));
if (correctPosition(index,v,node,posBVar))
{
//printf("node %d\n",node);
T = Cudd_T(node);//node->type.kids.T;
F = Cudd_E(node);//node->type.kids.E;
bits=bits<<1;
//printf("calling on the true child %di complement %d\n",T,Cudd_IsComplement(T));
res=ProbBool(MyManager,T,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res %e\ncalling on the else child %d c %d\n",res,F,Cudd_IsComplement(F));
//printf("comp %d ",comp);
comp=(!comp && Cudd_IsComplement(F)) || (comp && !Cudd_IsComplement(F));
//printf("comp %d \n",comp);
res=res+
ProbBool(MyManager,F,bits,nBit-1,posBVar+1,v,comp);
//printf("res 2 %e\n",res);
return res;
}
else
{
//printf("absent var\n");
bits=bits<<1;
// printf("Var =1\n");
res=ProbBool(MyManager,node,bits+1,nBit-1,posBVar+1,v,comp);
//printf("res 1 %e\n",res);
//printf("var =0\n");
res=res+
ProbBool(MyManager,node,bits,nBit-1,posBVar+1,v,comp);
// printf("res 2 %e\n",res);
return res;
}
}
}
int correctPosition(int index,variable v, DdNode * node,int posBVar)
/* returns 1 is the boolean variable with index posBVar is in the correct position
currently explored by ProbBool */
{
DdNode * bvar;
//printf("posbvar %d\n",posBVar);
//printf("length %d\n",array_n(v.booleanVars));
//bvar=array_fetch(DdNode *,v.booleanVars,posBVar);
bvar=v.booleanVars[posBVar];
// return var->index==index;
return(Cudd_NodeReadIndex(bvar)==index);
}
gint my_equal(gconstpointer v,gconstpointer v2)
/* function used by GHashTable to compare two keys */
{
DdNode *a,*b;
a=*(DdNode **)v;
b=*(DdNode **)v2;
return (a==b);
}
guint my_hash(gconstpointer key)
/* function used by GHashTable to hash a key */
{
unsigned int h;
h=(unsigned int)((unsigned long) *((DdNode **)key) % dividend);
return h;
}
void dealloc(gpointer key,gpointer value,gpointer user_data)
{
free(key);
free(value);
}
double ret_prob(extmanager MyManager, DdNode * bdd)
{
int intBits,j;
double prob;
nodes=g_hash_table_new(my_hash,my_equal);
intBits=sizeof(unsigned int)*8;
/* dividend is a global variable used by my_hash
it is equal to an unsigned int with binary representation 11..1 */
dividend=1;
for(j=1;j<intBits;j++)
{
dividend=(dividend<<1)+1;
}
prob=Prob(MyManager,bdd,Cudd_IsComplement(bdd));
g_hash_table_foreach (nodes,dealloc,NULL);
g_hash_table_destroy(nodes);
return prob;
}

234
packages/cplint/approx/simplecuddLPADs/general.c Normal file
View File

@ -0,0 +1,234 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: general.c *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include "general.h"
/* Number Handling */
int IsRealNumber(char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (c[i] == '.') return IsPosNumber(&c[i + 1]);
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
int IsPosNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
for(i = 0; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return 1;
}
int IsNumber(const char *c) {
int i, l;
l = strlen(c);
if (l <= 0) return 0;
if (l == 1) return IsNumberDigit(c[0]);
for(i = 1; i < strlen(c); i++) {
if (!IsNumberDigit(c[i])) return 0;
}
return (IsNumberDigit(c[0]) || IsSignDigit(c[0]));
}
/* File Handling */
char * freadstr(FILE *fd, const char *separators) {
char *str;
int buf, icur = 0, max = 10;
str = (char *) malloc(sizeof(char) * max);
str[0] = '\0';
do {
if ((buf = fgetc(fd)) != EOF) {
if (icur == (max - 1)) {
max = max * 2;
str = (char *) realloc(str, sizeof(char) * max);
}
if (!CharIn((char) buf, separators)) {
str[icur] = (char) buf;
icur++;
str[icur] = '\0';
}
}
} while(!CharIn(buf, separators) && !feof(fd));
return str;
}
int CharIn(const char c, const char *in) {
int i;
for (i = 0; i < strlen(in); i++)
if (c == in[i]) return 1;
return 0;
}
/* string handling */
int patternmatch(char *pattern, char *thestr) {
int i, j = -1, pl = strlen(pattern), sl = strlen(thestr);
for(i = 0; i < pl; i++) {
if (pattern[i] == '*') {
do {
i++;
if (i == pl) return 1;
} while(pattern[i] == '*');
do {
j++;
if (j >= sl) return 0;
if ((thestr[j] == pattern[i]) && patternmatch(pattern + i, thestr + j)) return 1;
} while(1);
} else {
j++;
if (j >= sl) return 0;
if (pattern[i] != thestr[j]) return 0;
}
}
return (pl == sl);
}

159
packages/cplint/approx/simplecuddLPADs/general.h Normal file
View File

@ -0,0 +1,159 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: general.h *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#define IsNumberDigit(c) ('0' <= c && c <= '9')
#define IsSignDigit(c) (c == '+' || c == '-')
#define isOperator(x) (x == '+' || x == '*' || x == '#' || x == '=')
#define freadline(fd) freadstr(fd, "\n");
int IsRealNumber(char *c);
int IsPosNumber(const char *c);
int IsNumber(const char *c);
char * freadstr(FILE *fd, const char *separators);
int CharIn(const char c, const char *in);
int patternmatch(char *pattern, char *thestr);

1747
packages/cplint/approx/simplecuddLPADs/simplecudd.c Normal file
View File

File diff suppressed because it is too large Load Diff

306
packages/cplint/approx/simplecuddLPADs/simplecudd.h Normal file
View File

@ -0,0 +1,306 @@
/******************************************************************************\
* *
* SimpleCUDD library (www.cs.kuleuven.be/~theo/tools/simplecudd.html) *
* SimpleCUDD was developed at Katholieke Universiteit Leuven(www.kuleuven.be) *
* *
* Copyright T. Mantadelis and Katholieke Universiteit Leuven 2008 *
* *
* Author: Theofrastos Mantadelis *
* File: simplecudd.h *
* *
********************************************************************************
* *
* The "Artistic License" *
* *
* Preamble *
* *
* The intent of this document is to state the conditions under which a *
* Package may be copied, such that the Copyright Holder maintains some *
* semblance of artistic control over the development of the package, *
* while giving the users of the package the right to use and distribute *
* the Package in a more-or-less customary fashion, plus the right to make *
* reasonable modifications. *
* *
* Definitions: *
* *
* "Package" refers to the collection of files distributed by the *
* Copyright Holder, and derivatives of that collection of files *
* created through textual modification. *
* *
* "Standard Version" refers to such a Package if it has not been *
* modified, or has been modified in accordance with the wishes *
* of the Copyright Holder as specified below. *
* *
* "Copyright Holder" is whoever is named in the copyright or *
* copyrights for the package. *
* *
* "You" is you, if you're thinking about copying or distributing *
* this Package. *
* *
* "Reasonable copying fee" is whatever you can justify on the *
* basis of media cost, duplication charges, time of people involved, *
* and so on. (You will not be required to justify it to the *
* Copyright Holder, but only to the computing community at large *
* as a market that must bear the fee.) *
* *
* "Freely Available" means that no fee is charged for the item *
* itself, though there may be fees involved in handling the item. *
* It also means that recipients of the item may redistribute it *
* under the same conditions they received it. *
* *
* 1. You may make and give away verbatim copies of the source form of the *
* Standard Version of this Package without restriction, provided that you *
* duplicate all of the original copyright notices and associated disclaimers. *
* *
* 2. You may apply bug fixes, portability fixes and other modifications *
* derived from the Public Domain or from the Copyright Holder. A Package *
* modified in such a way shall still be considered the Standard Version. *
* *
* 3. You may otherwise modify your copy of this Package in any way, provided *
* that you insert a prominent notice in each changed file stating how and *
* when you changed that file, and provided that you do at least ONE of the *
* following: *
* *
* a) place your modifications in the Public Domain or otherwise make them *
* Freely Available, such as by posting said modifications to Usenet or *
* an equivalent medium, or placing the modifications on a major archive *
* site such as uunet.uu.net, or by allowing the Copyright Holder to include *
* your modifications in the Standard Version of the Package. *
* *
* b) use the modified Package only within your corporation or organization. *
* *
* c) rename any non-standard executables so the names do not conflict *
* with standard executables, which must also be provided, and provide *
* a separate manual page for each non-standard executable that clearly *
* documents how it differs from the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 4. You may distribute the programs of this Package in object code or *
* executable form, provided that you do at least ONE of the following: *
* *
* a) distribute a Standard Version of the executables and library files, *
* together with instructions (in the manual page or equivalent) on where *
* to get the Standard Version. *
* *
* b) accompany the distribution with the machine-readable source of *
* the Package with your modifications. *
* *
* c) give non-standard executables non-standard names, and clearly *
* document the differences in manual pages (or equivalent), together *
* with instructions on where to get the Standard Version. *
* *
* d) make other distribution arrangements with the Copyright Holder. *
* *
* 5. You may charge a reasonable copying fee for any distribution of this *
* Package. You may charge any fee you choose for support of this *
* Package. You may not charge a fee for this Package itself. However, *
* you may distribute this Package in aggregate with other (possibly *
* commercial) programs as part of a larger (possibly commercial) software *
* distribution provided that you do not advertise this Package as a *
* product of your own. You may embed this Package's interpreter within *
* an executable of yours (by linking); this shall be construed as a mere *
* form of aggregation, provided that the complete Standard Version of the *
* interpreter is so embedded. *
* *
* 6. The scripts and library files supplied as input to or produced as *
* output from the programs of this Package do not automatically fall *
* under the copyright of this Package, but belong to whoever generated *
* them, and may be sold commercially, and may be aggregated with this *
* Package. If such scripts or library files are aggregated with this *
* Package via the so-called "undump" or "unexec" methods of producing a *
* binary executable image, then distribution of such an image shall *
* neither be construed as a distribution of this Package nor shall it *
* fall under the restrictions of Paragraphs 3 and 4, provided that you do *
* not represent such an executable image as a Standard Version of this *
* Package. *
* *
* 7. C subroutines (or comparably compiled subroutines in other *
* languages) supplied by you and linked into this Package in order to *
* emulate subroutines and variables of the language defined by this *
* Package shall not be considered part of this Package, but are the *
* equivalent of input as in Paragraph 6, provided these subroutines do *
* not change the language in any way that would cause it to fail the *
* regression tests for the language. *
* *
* 8. Aggregation of this Package with a commercial distribution is always *
* permitted provided that the use of this Package is embedded; that is, *
* when no overt attempt is made to make this Package's interfaces visible *
* to the end user of the commercial distribution. Such use shall not be *
* construed as a distribution of this Package. *
* *
* 9. The name of the Copyright Holder may not be used to endorse or promote *
* products derived from this software without specific prior written *
* permission. *
* *
* 10. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR *
* IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED *
* WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. *
* *
* The End *
* *
\******************************************************************************/
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <math.h>
#include <time.h>
#include "util.h"
#include "cudd.h"
#include "cuddInt.h"
#include "general.h"
#define IsHigh(manager, node) HIGH(manager) == node
#define IsLow(manager, node) LOW(manager) == node
#define HIGH(manager) Cudd_ReadOne(manager)
#define LOW(manager) Cudd_Not(Cudd_ReadOne(manager))
#define NOT(node) Cudd_Not(node)
#define GetIndex(node) Cudd_NodeReadIndex(node)
#define GetMVar(manager, index, value, varmap) equality(manager,index,value,varmap)//Cudd_bddIthVar(manager, index)
#define GetVar(manager, index) Cudd_bddIthVar(manager, index)
#define NewVar(manager) Cudd_bddNewVar(manager)
#define KillBDD(manager) Cudd_Quit(manager)
#define GetVarCount(manager) Cudd_ReadSize(manager)
#define DEBUGON _debug = 1
#define DEBUGOFF _debug = 0
#define RAPIDLOADON _RapidLoad = 1
#define RAPIDLOADOFF _RapidLoad = 0
#define SETMAXBUFSIZE(size) _maxbufsize = size
#define BDDFILE_ERROR -1
#define BDDFILE_OTHER 0
#define BDDFILE_SCRIPT 1
#define BDDFILE_NODEDUMP 2
extern int _RapidLoad;
extern int _debug;
extern int _maxbufsize;
typedef struct _bddfileheader {
FILE *inputfile;
int version;
int varcnt;
int bvarcnt;
int varstart;
int intercnt;
int filetype;
} bddfileheader;
typedef struct
{
int nVal,nBit,init;
double * probabilities;
int * booleanVars;
} variable;
typedef struct _namedvars {
int varcnt;
int varstart;
char **vars;
int *loaded;
double *dvalue;
int *ivalue;
void **dynvalue;
variable * mvars;
int * bVar2mVar;
} namedvars;
typedef struct _hisnode {
DdNode *key;
double dvalue;
int ivalue;
void *dynvalue;
} hisnode;
typedef struct _hisqueue {
int cnt;
hisnode *thenode;
} hisqueue;
typedef struct _nodeline {
char *varname;
char *truevar;
char *falsevar;
int nodenum;
int truenode;
int falsenode;
} nodeline;
/* Initialization */
DdManager* simpleBDDinit(int varcnt);
/* BDD Generation */
DdNode* D_BDDAnd(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDNand(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDOr(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDNor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDXor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* D_BDDXnor(DdManager *manager, DdNode *bdd1, DdNode *bdd2);
DdNode* FileGenerateBDD(DdManager *manager, namedvars varmap, bddfileheader fileheader);
DdNode* OnlineGenerateBDD(DdManager *manager, namedvars *varmap);
DdNode* LineParser(DdManager *manager, namedvars varmap, DdNode **inter, int maxinter, char *function, int iline);
DdNode* OnlineLineParser(DdManager *manager, namedvars *varmap, DdNode **inter, int maxinter, char *function, int iline);
DdNode* BDD_Operator(DdManager *manager, DdNode *bdd1, DdNode *bdd2, char Operator, int inegoper);
int getInterBDD(char *function);
char* getFileName(const char *function);
int GetParam(char *inputline, int iParam);
int LoadVariableData(namedvars varmap, char *filename);
int LoadMultiVariableData(DdManager * mgr,namedvars varmap, char *filename);
/* Named variables */
namedvars InitNamedVars(int varcnt, int varstart);
namedvars InitNamedMultiVars(int varcnt, int varstart, int bvarcnt);
void EnlargeNamedVars(namedvars *varmap, int newvarcnt);
int AddNamedVarAt(namedvars varmap, const char *varname, int index);
int AddNamedVar(namedvars varmap, const char *varname);
int AddNamedMultiVar(DdManager *mgr,namedvars varmap, const char *varnamei, int *value);
void SetNamedVarValuesAt(namedvars varmap, int index, double dvalue, int ivalue, void *dynvalue);
int SetNamedVarValues(namedvars varmap, const char *varname, double dvalue, int ivalue, void *dynvalue);
int GetNamedVarIndex(const namedvars varmap, const char *varname);
int RepairVarcnt(namedvars *varmap);
char* GetNodeVarName(DdManager *manager, namedvars varmap, DdNode *node);
char* GetNodeVarNameDisp(DdManager *manager, namedvars varmap, DdNode *node);
int all_loaded(namedvars varmap, int disp);
/* Traversal */
DdNode* HighNodeOf(DdManager *manager, DdNode *node);
DdNode* LowNodeOf(DdManager *manager, DdNode *node);
/* Traversal - History */
hisqueue* InitHistory(int varcnt);
void ReInitHistory(hisqueue *HisQueue, int varcnt);
void AddNode(hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue);
hisnode* GetNode(hisqueue *HisQueue, int varstart, DdNode *node);
int GetNodeIndex(hisqueue *HisQueue, int varstart, DdNode *node);
void onlinetraverse(DdManager *manager, namedvars varmap, hisqueue *HisQueue, DdNode *bdd);
/* Save-load */
bddfileheader ReadFileHeader(char *filename);
int CheckFileVersion(const char *version);
DdNode * LoadNodeDump(DdManager *manager, namedvars varmap, FILE *inputfile);
DdNode * LoadNodeRec(DdManager *manager, namedvars varmap, hisqueue *Nodes, FILE *inputfile, nodeline current);
DdNode * GetIfExists(DdManager *manager, namedvars varmap, hisqueue *Nodes, char *varname, int nodenum);
int SaveNodeDump(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename);
void SaveExpand(DdManager *manager, namedvars varmap, hisqueue *Nodes, DdNode *Current, FILE *outputfile);
void ExpandNodes(hisqueue *Nodes, int index, int nodenum);
/* Export */
int simpleBDDtoDot(DdManager *manager, DdNode *bdd, char *filename);
int simpleNamedBDDtoDot(DdManager *manager, namedvars varmap, DdNode *bdd, char *filename);
DdNode * equality(DdManager *mgr,int varIndex,int value,namedvars varmap);
hisnode* GetNodei1(int *bVar2mVar,hisqueue *HisQueue, int varstart, DdNode *node);
void AddNode1(int *bVar2mVar, hisqueue *HisQueue, int varstart, DdNode *node, double dvalue, int ivalue, void *dynvalue);
hisnode* GetNode1(int *bVar2mVar,hisqueue *HisQueue, int varstart, DdNode *node);

727
packages/cplint/approx/tptreefile.pl 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/utility.pl 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).

2
packages/cplint/cplint_yap.c
View File

@ -123,7 +123,7 @@ static int compute_prob(void)
char * names[1000];
GHashTable * nodes; /* hash table that associates nodes with their probability if already
computed, it is defined in glib */
Cudd_ReorderingType order;
//Cudd_ReorderingType order;
arg1=YAP_ARG1;
arg2=YAP_ARG2;
arg3=YAP_ARG3;

20
packages/cplint/lpadsld.pl
View File

@ -70,7 +70,7 @@ solve(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):-
CPUTime1 is CT1/1000,
statistics(walltime,[_,WT1]),
WallTime1 is WT1/1000,
print_mem,
%print_mem,
build_formula(L,Formula,[],Var,0,Conj),
length(L,ND),
length(Var,NV),
@ -87,7 +87,7 @@ solve(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):-
statistics(walltime,[_,WT2]),
WallTime2 is WT2/1000
;
print_mem,
%print_mem,
Prob=0.0,
statistics(cputime,[_,CT1]),
CPUTime1 is CT1/1000,
@ -96,9 +96,10 @@ solve(GoalsList,Prob,CPUTime1,CPUTime2,WallTime1,WallTime2):-
CPUTime2 =0.0,
statistics(walltime,[_,WT2]),
WallTime2 =0.0
),!,
),!.
/*,
format(user_error,"~nMemory after inference~n",[]),
print_mem.
print_mem.*/
si(GoalsList,ProbL,ProbU,CPUTime):-
statistics(cputime,[_,_]),
@ -239,7 +240,7 @@ solve_cond(Goals,Evidence,Prob):-
(setof(DerivE,find_deriv(Evidence,DerivE),LDupE)->
rem_dup_lists(LDupE,[],LE),
(setof(DerivGE,find_deriv_GE(LE,Goals,DerivGE),LDupGE)->
print_mem,
%print_mem,
rem_dup_lists(LDupGE,[],LGE),
build_formula(LE,FormulaE,[],VarE),
var2numbers(VarE,0,NewVarE),
@ -249,15 +250,16 @@ solve_cond(Goals,Evidence,Prob):-
call_compute_prob(NewVarGE,FormulaGE,ProbGE),
Prob is ProbGE/ProbE
;
print_mem,
%print_mem,
Prob=0.0
)
;
print_mem,
%print_mem,
Prob=undefined
),
).
/*,
format(user_error,"~nMemory after inference~n",[]),
print_mem.
print_mem. */
sci(Goals,Evidence,ProbL,ProbU,CPUTime):-
statistics(cputime,[_,_]),

4
packages/cplint/slg.pl
View File

@ -29,7 +29,7 @@
% Sicstus
/* Begin Sicstus specific code */
append([],L,L).
/* append([],L,L).
append([X|L1],L2,[X|L3]) :- append(L1,L2,L3).
member(X,[X|_]).
@ -37,7 +37,7 @@
memberchk(X,[X|_]) :- !.
memberchk(X,[_|L]) :- memberchk(X,L).
*/
:- dynamic 'slg$prolog'/1, 'slg$tab'/2.
:- dynamic slg_expanding/0.
:- dynamic wfs_trace/0.

1
packages/cplint/testcpl.pl
View File

@ -26,6 +26,7 @@ t:-
format("~nTesting cpl.yap~n~n",[]),
files(F),
statistics(runtime,[_,_]),
set(ground_body,false),
test_files(F,ground_body(false)),
statistics(runtime,[_,T]),
T1 is T /1000,

4
packages/cplint/testlpadvel.pl
View File

@ -9,8 +9,8 @@ Use
to execute the test
*/
%:-use_module(library(lpadvel)).
:-use_module(lpadvelor).
:-use_module(library(lpadvel)).
%:-use_module(lpadvelor).
epsilon(0.000001).

2
packages/cplint/testsemlpad.pl
View File

@ -68,7 +68,7 @@ test_all(F,[H|T]):-
files_modes([
exapprox,
exrange,
threesideddice,
%threesideddice,
%mendels, %ok only with grounding=variables
coin2,
ex,exist,exist1

8
packages/cplint/testsemlpadsld.pl
View File

@ -68,7 +68,7 @@ test_all(F,[H|T]):-
files_modes([
exapprox,
exrange,
threesideddice,
%threesideddice,
%mendels,
school_simple,
coin2,
@ -78,7 +78,7 @@ ex]).
files_variables([
exapprox,
exrange,
threesideddice,
%threesideddice,
mendels,
%school_simple,
coin2,
@ -95,8 +95,8 @@ test((s([a(1)],P),close_to(P,0.2775)),exrange,_).
test((s([a(2)],P),close_to(P,0.36)),exrange,_).
test((s([on(0,1)],P),close_to(P,0.333333333333333)),threesideddice,_).
test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((s([on(2,1)],P),close_to(P,0.148148147703704)),threesideddice,_).
%test((s([on(1,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
%test((s([on(2,1)],P),close_to(P,0.148148147703704)),threesideddice,_).
test((sc([on(2,1)],[on(0,1)],P),close_to(P,0.222222222222222)),threesideddice,_).
test((sc([on(2,1)],[on(1,1)],P),close_to(P,0.333333333333333)),threesideddice,_).