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

Merge branch 'master' of https://github.com/tacgomes/yap6.3

This commit is contained in:
Vitor Santos Costa 2013-01-09 16:48:16 +00:00
parent 649fae4294 2feac46e54
commit ff953eb20a
157 changed files with 6307 additions and 5898 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
packages/CLPBN/Makefile.in
View File

@ -28,9 +28,9 @@ INSTALL=@INSTALL@
INSTALL_DATA=@INSTALL_DATA@
INSTALL_PROGRAM=@INSTALL_PROGRAM@
srcdir=@srcdir@
PDFLATEX=pdflatex
CLPBN_TOP= $(srcdir)/clpbn.yap \
$(srcdir)/pfl.yap
PFL_MANUAL = $(srcdir)/pfl
CLPBN_SRCDIR = $(srcdir)/clpbn
@ -38,6 +38,10 @@ CLPBN_LEARNING_SRCDIR = $(srcdir)/learning
CLPBN_EXDIR = $(srcdir)/examples
CLPBN_TOP= \
$(srcdir)/clpbn.yap \
$(srcdir)/pfl.yap
CLPBN_PROGRAMS= \
$(CLPBN_SRCDIR)/aggregates.yap \
$(CLPBN_SRCDIR)/bdd.yap \
@ -74,15 +78,24 @@ CLPBN_LEARNING_PROGRAMS= \
$(CLPBN_LEARNING_SRCDIR)/learn_utils.yap \
$(CLPBN_LEARNING_SRCDIR)/mle.yap
CLPBN_EXAMPLES= \
$(CLPBN_EXDIR)/burglary-alarm.fg \
$(CLPBN_EXDIR)/burglary-alarm.pfl \
$(CLPBN_EXDIR)/burglary-alarm.uai \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/city.pfl \
$(CLPBN_EXDIR)/comp_workshops.pfl \
$(CLPBN_EXDIR)/social_network1.pfl \
$(CLPBN_EXDIR)/social_network2.pfl \
$(CLPBN_EXDIR)/sprinkler.pfl \
$(CLPBN_EXDIR)/workshop_attrs.pfl
CLPBN_SCHOOL_EXAMPLES= \
$(CLPBN_EXDIR)/School/README \
$(CLPBN_EXDIR)/School/evidence_128.yap \
$(CLPBN_EXDIR)/School/schema.yap \
$(CLPBN_EXDIR)/School/parschema.pfl \
$(CLPBN_EXDIR)/School/school_128.yap \
$(CLPBN_EXDIR)/School/school_32.yap \
$(CLPBN_EXDIR)/School/sch32.yap \
$(CLPBN_EXDIR)/School/school32_data.yap \
$(CLPBN_EXDIR)/School/school_64.yap \
$(CLPBN_EXDIR)/School/tables.yap
@ -102,20 +115,8 @@ CLPBN_LEARNING_EXAMPLES= \
$(CLPBN_EXDIR)/learning/sprinkler_params.yap \
$(CLPBN_EXDIR)/learning/train.yap
CLPBN_EXAMPLES= \
$(CLPBN_EXDIR)/burglary-alarm.fg \
$(CLPBN_EXDIR)/burglary-alarm.pfl \
$(CLPBN_EXDIR)/burglary-alarm.uai \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/city.pfl \
$(CLPBN_EXDIR)/comp_workshops.pfl \
$(CLPBN_EXDIR)/social_domain1.pfl \
$(CLPBN_EXDIR)/social_domain2.pfl \
$(CLPBN_EXDIR)/sprinkler.pfl \
$(CLPBN_EXDIR)/workshop_attrs.pfl
install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_LEARNING_PROGRAMS) $(CLPBN_SCHOOL_EXAMPLES) $(CLPBN_HMMER_EXAMPLES) $(CLPBN_LEARNING_EXAMPLES)
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn
mkdir -p $(DESTDIR)$(SHAREDIR)/clpbn/learning
mkdir -p $(DESTDIR)$(EXDIR)
@ -130,3 +131,13 @@ install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
for h in $(CLPBN_HMMER_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/HMMer; done
for h in $(CLPBN_LEARNING_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/learning; done
docs: $(MANUAL)
$(PDFLATEX) $(PFL_MANUAL)
$(PDFLATEX) $(PFL_MANUAL)
rm -f pfl.aux pfl.bbl pfl.blg pfl.log pfl.out
install_docs: docs
$(INSTALL_DATA) pfl.pdf $(DESTDIR)$(EXDIR)

111
packages/CLPBN/README.txt
View File

@ -1,111 +0,0 @@
Prolog Factor Language (PFL)
Prolog Factor Language (PFL) is a extension of the Prolog language that
allows a natural representation of this first-order probabilistic models
(either directed or undirected). PFL is also capable of solving probabilistic
queries on this models through the implementation of several inference
techniques: variable elimination, belief propagation, lifted variable
elimination and lifted belief propagation.
Language
-------------------------------------------------------------------------------
A graphical model in PFL is represented using parfactors. A PFL parfactor
has the following four components:
Type ; Formulas ; Phi ; Constraint .
- Type refers the type of the network over which the parfactor is defined.
It can be bayes for directed networks, or markov for undirected ones.
- Formulas is a sequence of Prolog terms that define sets of random variables
under the constraint.
- Phi is either a list of parameters or a call to a Prolog goal that will
unify its last argument with a list of parameters.
- Constraint is a list (possible empty) of Prolog goals that will impose
bindings on the logical variables that appear in the formulas.
The "examples" directory contains some popular graphical models described
using PFL.
Querying
-------------------------------------------------------------------------------
Now we show how to use PFL to solve probabilistic queries. We will
use the burlgary alarm network as an example. First, we load the model:
$ yap -l examples/burglary-alarm.yap
Now let's suppose that we want to estimate the probability of a earthquake
ocurred given that mary called. We can do it with the following query:
?- earthquake(X), mary_calls(t).
Suppose now that we want the joint distribution for john_calls and
mary_calls. We can obtain this with the following query:
?- john_calls(X), mary_calls(Y).
Inference Options
-------------------------------------------------------------------------------
PFL supports both ground and lifted inference. The inference algorithm
can be chosen using the set_solver/1 predicate. The following algorithms
are supported:
- lve: generalized counting first-order variable elimination (GC-FOVE)
- hve: (ground) variable elimination
- lbp: lifted first-order belief propagation
- cbp: counting belief propagation
- bp: (ground) belief propagation
- lkc: lifted first-order knowledge compilation
For example, if we want to use ground variable elimination to solve some
query, we need to call first the following goal:
?- set_solver(hve).
It is possible to tweak several parameters of PFL through the
set_horus_flag/2 predicate. The first argument is a key that
identifies the parameter that we desire to tweak, while the second
is some possible value for this key.
The verbosity key controls the level of log information that will be
printed by the corresponding solver. Its possible values are positive
integers. The bigger the number, more log information will be printed.
For example, to view some basic log information we need to call the
following goal:
?- set_horus_flag(verbosity, 1).
The use_logarithms key controls whether the calculations performed
during inference should be done in the log domain or not. Its values
can be true or false. By default is false.
There are also keys specific to the inference algorithm. For example,
elim_heuristic key controls the elimination heuristic that will be
used by ground variable elimination. The following heuristics are
supported:
- sequential
- min_neighbors
- min_weight
- min_fill
- weighted_min_fill
An explanation of this heuristics can be found in Probabilistic Graphical
Models by Daphne Koller.
The schedule, accuracy and max_iter keys are specific for inference
algorithms based on message passing, namely lbp, cbp and bp.
The key schedule can be used to specify the order in which the messages
are sent in belief propagation. The possible values are:
- seq_fixed: at each iteration, all messages are sent in the same order
- seq_random: at each iteration, the messages are sent with a random order
- parallel: at each iteration, the messages are all calculated using the
values of the previous iteration.
- max_residual: the next message to be sent is the one with maximum residual,
(Residual Belief Propagation:Informed Scheduling for Asynchronous Message
Passing)
The max_iter key sets the maximum number of iterations. One iteration
consists in sending all possible messages. The accuracy key indicate
when we should stop sending messages. If the largest difference between
a message sent in the current iteration and one message sent in the previous
iteration is less that accuracy value given, we terminate belief propagation.

38
packages/CLPBN/benchmarks/benchs.sh
View File

@ -1,5 +1,4 @@
function prepare_new_run
{
YAP=~/bin/$SHORTNAME-$SOLVER
@ -17,32 +16,33 @@ function prepare_new_run
function run_solver
{
constraint=$1
echo $LOG_FILE
CONSTRAINT=$1
solver_flag=true
if [ -n "$2" ]; then
if [ $SOLVER = hve ]; then
solver_flag=clpbn_horus:set_horus_flag\(elim_heuristic,$2\)
SOLVER_FLAG=set_horus_flag\(hve_elim_heuristic,$2\)
elif [ $SOLVER = bp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
SOLVER_FLAG=set_horus_flag\(bp_msg_schedule,$2\)
elif [ $SOLVER = cbp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
SOLVER_FLAG=set_horus_flag\(bp_msg_schedule,$2\)
elif [ $SOLVER = lbp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
SOLVER_FLAG=set_horus_flag\(bp_msg_schedule,$2\)
else
echo "unknow flag $2"
fi
fi
/usr/bin/time -o $LOG_FILE -a -f "%U\t%S\t%e\t%M" \
$YAP << EOF >> $LOG_FILE &>> ignore.$LOG_FILE
$YAP << EOF >> ignore.$LOG_FILE 2>> ignore.$LOG_FILE
nogc.
[$NETWORK].
[$constraint].
clpbn_horus:set_solver($SOLVER).
clpbn_horus:set_horus_flag(use_logarithms, true).
clpbn_horus:set_horus_flag(verbosity, 1).
$solver_flag.
[$CONSTRAINT].
set_solver($SOLVER).
set_horus_flag(verbosity, 1).
set_horus_flag(use_logarithms, true).
$SOLVER_FLAG.
$QUERY.
open("$LOG_FILE", 'append', S), format(S, '$constraint ~15+ ', []), close(S).
open("$LOG_FILE", 'append', S), format(S, "$CONSTRAINT ~15+ ", []), close(S).
EOF
}
@ -52,12 +52,16 @@ function clear_log_files
{
rm -f *~
rm -f ../*~
rm -f school/*.log school/*~
rm -f ../school/*.log ../school/*~
rm -f city/*.log city/*~
rm -f ../city/*.log ../city/*~
rm -f workshop_attrs/*.log workshop_attrs/*~
rm -f ../workshop_attrs/*.log ../workshop_attrs/*~
rm -f comp_workshops/*.log comp_workshops/*~
rm -f ../comp_workshops/*.log ../comp_workshops/*~
rm -f city/*.log city/*~
rm -f ../city/*.log ../city/*~
rm -f social_network2/*.log social_network2/*~
rm -f ../social_network2/*.log ../social_network2/*~
rm -f social_network2_evidence/*.log social_network2_evidence/*~
rm -f ../social_network2_evidence/*.log ../social_network2_evidence/*~
echo all done!
}

2
packages/CLPBN/benchmarks/city/bp_tests.sh
View File

@ -33,5 +33,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed
run_all_graphs "bp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/city/cbp_tests.sh
View File

@ -32,5 +32,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "cbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/city/city.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
NETWORK="'../../examples/city'"
NETWORK="'../../examples/city.pfl'"
SHORTNAME="city"
QUERY="is_joe_guilty(X)"

2
packages/CLPBN/benchmarks/city/gen_city.sh
View File

@ -19,7 +19,7 @@ main :-
generate_people(S, N, Counting) :-
Counting > N, !.
generate_people(S, N, Counting) :-
format(S, 'people(p~w, nyc).~n', [Counting]),
format(S, 'person(p~w, nyc).~n', [Counting]),
Counting1 is Counting + 1,
generate_people(S, N, Counting1).

2
packages/CLPBN/benchmarks/city/hve_tests.sh
View File

@ -33,5 +33,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors
run_all_graphs "hve(hve_elim_heuristic=min_neighbors) " min_neighbors

2
packages/CLPBN/benchmarks/city/lbp_tests.sh
View File

@ -32,5 +32,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "lbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/comp_workshops/bp_tests.sh
View File

@ -27,5 +27,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed
run_all_graphs "bp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/comp_workshops/cbp_tests.sh
View File

@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "cbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/comp_workshops/cw.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
NETWORK="'../../examples/comp_workshops'"
NETWORK="'../../examples/comp_workshops.pfl'"
SHORTNAME="cw"
QUERY="series(X)"

2
packages/CLPBN/benchmarks/comp_workshops/gen_workshops.sh
View File

@ -29,7 +29,7 @@ gen(S, NP, NW, Count) :-
gen_workshops(_, _, NW, Count) :-
Count > NW, !.
gen_workshops(S, P, NW, Count) :-
format(S, 'c(p~w,w~w).~n', [P,Count]),
format(S, 'reg(p~w,w~w).~n', [P,Count]),
Count1 is Count + 1,
gen_workshops(S, P, NW, Count1).

2
packages/CLPBN/benchmarks/comp_workshops/hve_tests.sh
View File

@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors
run_all_graphs "hve(hve_elim_heuristic=min_neighbors) " min_neighbors

2
packages/CLPBN/benchmarks/comp_workshops/lbp_tests.sh
View File

@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "lbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/run_all.sh
View File

@ -24,7 +24,7 @@ source lbp_tests.sh
source cbp_tests.sh
cd ..
cd smokers
cd social_network2
source hve_tests.sh
source bp_tests.sh
source lve_tests.sh

129
packages/CLPBN/benchmarks/school/run_school_tests.sh
View File

@ -1,95 +1,64 @@
#!/bin/bash
#cp ~/bin/yap ~/bin/school_all
#YAP=~/bin/school_all
YAP=~/bin/yap
source ../benchs.sh
#OUT_FILE_NAME=results`date "+ %H:%M:%S %d-%m-%Y"`.log
OUT_FILE_NAME=results.log
rm -f $OUT_FILE_NAME
rm -f ignore.$OUT_FILE_NAME
SHORTNAME="school"
SOLVER="school"
# yap -g "['../../../../examples/School/sch32'], [missing5], use_module(library(clpbn/learning/em)), graph(L), clpbn:set_clpbn_flag(em_solver,bp), clpbn_horus:set_horus_flag(inf_alg, bp), statistics(runtime, _), em(L,0.01,10,_,Lik), statistics(runtime, [T,_])."
function run_solver
function learn_params
{
if [ $2 = bp ]
then
if [ $4 = ve ]
then
extra_flag1=clpbn_horus:set_horus_flag\(inf_alg,$4\)
extra_flag2=clpbn_horus:set_horus_flag\(elim_heuristic,$5\)
else
extra_flag1=clpbn_horus:set_horus_flag\(inf_alg,$4\)
extra_flag2=clpbn_horus:set_horus_flag\(schedule,$5\)
fi
else
extra_flag1=true
extra_flag2=true
fi
/usr/bin/time -o "$OUT_FILE_NAME" -a -f "real:%E\tuser:%U\tsys:%S" $YAP << EOF &>> "ignore.$OUT_FILE_NAME"
:- [pos:train].
:- ['../../../../examples/School/sch32'].
:- use_module(library(clpbn/learning/em)).
:- use_module(library(clpbn/bp)).
[$1].
NETWORK="'./../../examples/School/school_32'"
CONSTRAINT=$2
SOLVER=$1
echo $NETWORK
/usr/bin/time -o $LOG_FILE -a -f "%U\t%S\t%e\t%M" \
$YAP << EOF >> ignore.$LOG_FILE 2>> ignore.$LOG_FILE
use_module(library(pfl)).
use_module(library(clpbn/learning/em)).
[$NETWORK].
[$CONSTRAINT].
set_em_solver($SOLVER).
graph(L),
clpbn:set_clpbn_flag(em_solver,$2),
$extra_flag1, $extra_flag2,
em(L,0.01,10,_,Lik),
open("$OUT_FILE_NAME", 'append',S),
format(S, '$3: ~11+ Lik = ~3f, ',[Lik]),
close(S).
% em(L, 0.01, 10, _, Lik),
open("$LOG_FILE", 'append', S),
format(S, "$CONSTRAINT: ~15+ Lik = ~3f\t", [Lik]),
close(S).
EOF
}
function run_all_graphs
{
echo "************************************************************************" >> "$OUT_FILE_NAME"
echo "results for solver $2" >> "$OUT_FILE_NAME"
echo "************************************************************************" >> "$OUT_FILE_NAME"
run_solver missing5 $1 missing5 $3 $4 $5
run_solver missing10 $1 missing10 $3 $4 $5
#run_solver missing20 $1 missing20 $3 $4 $5
#run_solver missing30 $1 missing30 $3 $4 $5
#run_solver missing40 $1 missing40 $3 $4 $5
#run_solver missing50 $1 missing50 $3 $4 $5
}
prepare_new_run
#run_all_graphs bp "hve(min_neighbors) " ve min_neighbors
#run_all_graphs bp "bp(seq_fixed) " bp seq_fixed
#run_all_graphs bp "cbp(seq_fixed) " cbp seq_fixed
exit
write_header hve
learn_params hve missing5
learn_params hve missing10
learn_params hve missing20
#learn_params hve missing30
#learn_params hve missing40
#learn_params hve missing50
write_header ve
learn_params ve missing5
learn_params ve missing10
learn_params ve missing20
#learn_params ve missing30
#learn_params ve missing40
#learn_params hve missing50
run_all_graphs bp "hve(min_neighbors) " ve min_neighbors
run_all_graphs bp "hve(min_weight) " ve min_weight
run_all_graphs bp "hve(min_fill) " ve min_fill
run_all_graphs bp "hve(w_min_fill) " ve weighted_min_fill
run_all_graphs bp "bp(seq_fixed) " bp seq_fixed
run_all_graphs bp "bp(max_residual) " bp max_residual
run_all_graphs bp "cbp(seq_fixed) " cbp seq_fixed
run_all_graphs bp "cbp(max_residual) " cbp max_residual
run_all_graphs gibbs "gibbs "
echo "************************************************************************" >> "$OUT_FILE_NAME"
echo "results for solver ve" >> "$OUT_FILE_NAME"
echo "************************************************************************" >> "$OUT_FILE_NAME"
run_solver missing5 ve missing5 $3 $4 $5
run_solver missing10 ve missing10 $3 $4 $5
run_solver missing20 ve missing20 $3 $4 $5
run_solver missing30 ve missing30 $3 $4 $5
run_solver missing40 ve missing40 $3 $4 $5
#run_solver missing50 ve missing50 $3 $4 $5 #+24h!
echo "************************************************************************" >> "$OUT_FILE_NAME"
echo "results for solver jt" >> "$OUT_FILE_NAME"
echo "************************************************************************" >> "$OUT_FILE_NAME"
run_solver missing5 jt missing5 $3 $4 $5
run_solver missing10 jt missing10 $3 $4 $5
run_solver missing20 jt missing20 $3 $4 $5
#run_solver missing30 jt missing30 $3 $4 $5 #+24h!
#run_solver missing40 jt missing40 $3 $4 $5 #+24h!
#run_solver missing50 jt missing50 $3 $4 $5 #+24h!
exit
write_header bp
learn_params bp missing5
learn_params bp missing10
learn_params bp missing20
#learn_params bp missing30
#learn_params bp missing40
#learn_params bp missing50
write_header cbp
learn_params cbp missing5
learn_params cbp missing10
learn_params cbp missing20
#learn_params cbp missing30
#learn_params cbp missing40
#learn_params cbp missing50

8
packages/CLPBN/benchmarks/smokers_evidence/sm.sh
View File

@ -1,8 +0,0 @@
#!/bin/bash
NETWORK="'../../examples/social_domain2'"
SHORTNAME="sm"
QUERY="query(X)"
POP=500

4
packages/CLPBN/benchmarks/smokers/bp_tests.sh → packages/CLPBN/benchmarks/social_network2/bp_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2.sh
source ../benchs.sh
SOLVER="bp"
@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed
run_all_graphs "bp(bp_msg_shedule=seq_fixed) " seq_fixed

4
packages/CLPBN/benchmarks/smokers/cbp_tests.sh → packages/CLPBN/benchmarks/social_network2/cbp_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2.sh
source ../benchs.sh
SOLVER="cbp"
@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "cbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/smokers/gen_people.sh → packages/CLPBN/benchmarks/social_network2/gen_people.sh
View File

@ -17,7 +17,7 @@ main :-
generate_people(S, N, Counting) :-
Counting > N, !.
generate_people(S, N, Counting) :-
format(S, 'people(p~w).~n', [Counting]),
format(S, 'person(p~w).~n', [Counting]),
Counting1 is Counting + 1,
generate_people(S, N, Counting1).

10
packages/CLPBN/benchmarks/smokers/hve_tests.sh → packages/CLPBN/benchmarks/social_network2/hve_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2.sh
source ../benchs.sh
SOLVER="hve"
@ -26,8 +26,8 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors
#run_all_graphs "hve(elim_heuristic=min_weight) " min_weight
#run_all_graphs "hve(elim_heuristic=min_fill) " min_fill
#run_all_graphs "hve(elim_heuristic=weighted_min_fill) " weighted_min_fill
run_all_graphs "hve(hve_elim_heuristic=min_neighbors) " min_neighbors
#run_all_graphs "hve(hve_elim_heuristic=min_weight) " min_weight
#run_all_graphs "hve(hve_elim_heuristic=min_fill) " min_fill
#run_all_graphs "hve(hve_elim_heuristic=weighted_min_fill) " weighted_min_fill

4
packages/CLPBN/benchmarks/smokers/lbp_tests.sh → packages/CLPBN/benchmarks/social_network2/lbp_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2.sh
source ../benchs.sh
SOLVER="lbp"
@ -26,5 +26,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "lbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/smokers/lve_tests.sh → packages/CLPBN/benchmarks/social_network2/lve_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2.sh
source ../benchs.sh
SOLVER="lve"

4
packages/CLPBN/benchmarks/smokers/sm.sh → packages/CLPBN/benchmarks/social_network2/sn2.sh
View File

@ -1,7 +1,7 @@
#!/bin/bash
NETWORK="'../../examples/social_domain2'"
SHORTNAME="sm"
NETWORK="'../../examples/social_network2.pfl'"
SHORTNAME="sn2"
#QUERY="smokes(p1,t), smokes(p2,t), friends(p1,p2,X)"
QUERY="friends(p1,p2,X)"

4
packages/CLPBN/benchmarks/smokers_evidence/bp_tests.sh → packages/CLPBN/benchmarks/social_network2_evidence/bp_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2ev.sh
source ../benchs.sh
SOLVER="bp"
@ -30,5 +30,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed
run_all_graphs "bp(bp_msg_shedule=seq_fixed) " seq_fixed

4
packages/CLPBN/benchmarks/smokers_evidence/cbp_tests.sh → packages/CLPBN/benchmarks/social_network2_evidence/cbp_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2ev.sh
source ../benchs.sh
SOLVER="cbp"
@ -30,5 +30,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "cbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/smokers_evidence/gen_people.sh → packages/CLPBN/benchmarks/social_network2_evidence/gen_people.sh
View File

@ -26,7 +26,7 @@ main :-
generate_people(S, N, Counting) :-
Counting > N, !.
generate_people(S, N, Counting) :-
format(S, 'people(p~w).~n', [Counting]),
format(S, 'person(p~w).~n', [Counting]),
Counting1 is Counting + 1,
generate_people(S, N, Counting1).

10
packages/CLPBN/benchmarks/smokers_evidence/hve_tests.sh → packages/CLPBN/benchmarks/social_network2_evidence/hve_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2ev.sh
source ../benchs.sh
SOLVER="hve"
@ -30,8 +30,8 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors
#run_all_graphs "hve(elim_heuristic=min_weight) " min_weight
#run_all_graphs "hve(elim_heuristic=min_fill) " min_fill
#run_all_graphs "hve(elim_heuristic=weighted_min_fill) " weighted_min_fill
run_all_graphs "hve(hve_elim_heuristic=min_neighbors) " min_neighbors
#run_all_graphs "hve(hve_elim_heuristic=min_weight) " min_weight
#run_all_graphs "hve(hve_elim_heuristic=min_fill) " min_fill
#run_all_graphs "hve(hve_elim_heuristic=weighted_min_fill) " weighted_min_fill

0
packages/CLPBN/benchmarks/smokers_evidence/lbp_tests.sh → packages/CLPBN/benchmarks/social_network2_evidence/lbp_tests.sh
View File

2
packages/CLPBN/benchmarks/smokers_evidence/lve_tests.sh → packages/CLPBN/benchmarks/social_network2_evidence/lve_tests.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
source sm.sh
source sn2ev.sh
source ../benchs.sh
SOLVER="lve"

8
packages/CLPBN/benchmarks/social_network2_evidence/sn2ev.sh Executable file
View File

@ -0,0 +1,8 @@
#!/bin/bash
NETWORK="'../../examples/social_network2.pfl'"
SHORTNAME="sn2ev"
QUERY="query(X)"
POP=500

2
packages/CLPBN/benchmarks/workshop_attrs/bp_tests.sh
View File

@ -33,5 +33,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed
run_all_graphs "bp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/workshop_attrs/cbp_tests.sh
View File

@ -32,5 +32,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "cbp(bp_msg_shedule=seq_fixed) " seq_fixed

6
packages/CLPBN/benchmarks/workshop_attrs/gen_attrs.sh
View File

@ -23,7 +23,7 @@ main :-
generate_people(S, N, Counting) :-
Counting > N, !.
generate_people(S, N, Counting) :-
format(S, 'people(p~w).~n', [Counting]),
format(S, 'person(p~w).~n', [Counting]),
Counting1 is Counting + 1,
generate_people(S, N, Counting1).
@ -31,9 +31,9 @@ generate_people(S, N, Counting) :-
generate_attrs(S, N, Counting) :-
Counting > N, !.
generate_attrs(S, N, Counting) :-
%format(S, 'people(p~w).~n', [Counting]),
%format(S, 'person(p~w).~n', [Counting]),
format(S, 'markov attends(P)::[t,f], attr~w::[t,f]', [Counting]),
format(S, '; [0.7, 0.3, 0.3, 0.3] ; [people(P)].~n',[]),
format(S, '; [0.7, 0.3, 0.3, 0.3] ; [person(P)].~n',[]),
Counting1 is Counting + 1,
generate_attrs(S, N, Counting1).

2
packages/CLPBN/benchmarks/workshop_attrs/hve_tests.sh
View File

@ -32,5 +32,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors
run_all_graphs "hve(hve_elim_heuristic=min_neighbors) " min_neighbors

2
packages/CLPBN/benchmarks/workshop_attrs/lbp_tests.sh
View File

@ -32,5 +32,5 @@ function run_all_graphs
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed
run_all_graphs "lbp(bp_msg_shedule=seq_fixed) " seq_fixed

2
packages/CLPBN/benchmarks/workshop_attrs/wa.sh
View File

@ -1,6 +1,6 @@
#!/bin/bash
NETWORK="'../../examples/workshop_attrs'"
NETWORK="'../../examples/workshop_attrs.pfl'"
SHORTNAME="wa"
QUERY="series(X)"

607
packages/CLPBN/clpbn.yap
View File

@ -1,210 +1,242 @@
:- module(clpbn, [{}/1,
clpbn_flag/2,
set_clpbn_flag/2,
clpbn_flag/3,
clpbn_key/2,
clpbn_init_solver/4,
clpbn_run_solver/3,
pfl_init_solver/6,
pfl_run_solver/4,
clpbn_finalize_solver/1,
clpbn_init_solver/5,
clpbn_run_solver/4,
clpbn_init_graph/1,
probability/2,
conditional_probability/3,
use_parfactors/1,
op( 500, xfy, with)]).
:- module(clpbn,
[{}/1,
clpbn_flag/2,
set_clpbn_flag/2,
set_solver/1,
set_em_solver/1,
clpbn_flag/3,
clpbn_key/2,
clpbn_init_graph/1,
clpbn_init_solver/4,
clpbn_run_solver/3,
pfl_init_solver/5,
pfl_run_solver/3,
pfl_end_solver/1,
probability/2,
conditional_probability/3,
use_parfactors/1,
op(500, xfy, with)
]).
:- use_module(library(atts)).
:- use_module(library(bhash)).
:- use_module(library(lists)).
:- use_module(library(terms)).
:- use_module(library(maplist)).
:- attribute key/1, dist/2, evidence/1.
:- use_module('clpbn/ve',
[ve/3,
check_if_ve_done/1,
init_ve_solver/4,
run_ve_solver/3,
init_ve_ground_solver/5,
run_ve_ground_solver/3,
call_ve_ground_solver/6
]).
:- use_module('clpbn/jt',
[jt/3,
init_jt_solver/4,
run_jt_solver/3
]).
:- use_module('clpbn/bdd',
[bdd/3,
init_bdd_solver/4,
run_bdd_solver/3,
init_bdd_ground_solver/5,
run_bdd_ground_solver/3,
call_bdd_ground_solver/6
]).
:- use_module('clpbn/gibbs',
[gibbs/3,
check_if_gibbs_done/1,
init_gibbs_solver/4,
run_gibbs_solver/3
]).
:- use_module('clpbn/pgrammar',
[pcg_init_graph/0,
init_pcg_solver/4,
run_pcg_solver/3
]).
:- use_module('clpbn/horus_ground',
[call_horus_ground_solver/6,
check_if_horus_ground_solver_done/1,
init_horus_ground_solver/5,
run_horus_ground_solver/3,
end_horus_ground_solver/1
]).
:- use_module('clpbn/horus_lifted',
[call_horus_lifted_solver/3,
check_if_horus_lifted_solver_done/1,
init_horus_lifted_solver/4,
run_horus_lifted_solver/3,
end_horus_lifted_solver/1
]).
%% :- use_module('clpbn/bnt',
%% [do_bnt/3,
%% check_if_bnt_done/1
%% ]).
:- use_module('clpbn/dists',
[dist/4,
get_dist/4,
get_evidence_position/3,
get_evidence_from_position/3,
additive_dists/6
]).
:- use_module('clpbn/evidence',
[store_evidence/1,
add_stored_evidence/2,
incorporate_evidence/2,
check_stored_evidence/2,
put_evidence/2
]).
:- use_module('clpbn/ground_factors',
[generate_network/5]).
:- use_module('clpbn/utils',
[sort_vars_by_key/3]).
:- use_module('clpbn/graphs',
[clpbn2graph/1]).
:- use_module('clpbn/graphviz',
[clpbn2gviz/4]).
%
% avoid the overhead of using goal_expansion/2.
%
:- multifile
user:term_expansion/2.
:- multifile user:term_expansion/2.
:- dynamic user:term_expansion/2.
:- dynamic
user:term_expansion/2.
:- attribute key/1, dist/2, evidence/1.
:- use_module('clpbn/ve',
[ve/3,
check_if_ve_done/1,
init_ve_solver/4,
run_ve_solver/3,
init_ve_ground_solver/5,
run_ve_ground_solver/3,
call_ve_ground_solver/6
]).
:- use_module('clpbn/horus_ground',
[call_horus_ground_solver/6,
check_if_horus_ground_solver_done/1,
init_horus_ground_solver/5,
run_horus_ground_solver/4,
finalize_horus_ground_solver/1
]).
:- use_module('clpbn/horus_lifted',
[call_horus_lifted_solver/3,
check_if_horus_lifted_solver_done/1,
init_horus_lifted_solver/4,
run_horus_lifted_solver/3,
finalize_horus_lifted_solver/1
]).
:- use_module('clpbn/jt',
[jt/3,
init_jt_solver/4,
run_jt_solver/3
]).
:- use_module('clpbn/bdd',
[bdd/3,
init_bdd_solver/4,
run_bdd_solver/3,
init_bdd_ground_solver/5,
run_bdd_ground_solver/3,
call_bdd_ground_solver/6
]).
%% :- use_module('clpbn/bnt',
%% [do_bnt/3,
%% check_if_bnt_done/1
%% ]).
:- use_module('clpbn/gibbs',
[gibbs/3,
check_if_gibbs_done/1,
init_gibbs_solver/4,
run_gibbs_solver/3
]).
:- use_module('clpbn/pgrammar',
[init_pcg_solver/4,
run_pcg_solver/3,
pcg_init_graph/0
]).
:- use_module('clpbn/graphs',
[
clpbn2graph/1
]).
:- use_module('clpbn/dists',
[
dist/4,
get_dist/4,
get_evidence_position/3,
get_evidence_from_position/3,
additive_dists/6
]).
:- use_module('clpbn/evidence',
[
store_evidence/1,
add_stored_evidence/2,
incorporate_evidence/2,
check_stored_evidence/2,
put_evidence/2
]).
:- use_module('clpbn/utils',
[
sort_vars_by_key/3
]).
:- use_module('clpbn/graphviz',
[clpbn2gviz/4]).
:- use_module(clpbn/ground_factors,
[generate_network/5]).
:- dynamic solver/1,output/1,use/1,suppress_attribute_display/1, parameter_softening/1, em_solver/1, use_parfactors/1.
solver(ve).
em_solver(bp).
solver/1,
em_solver/1,
suppress_attribute_display/1,
parameter_softening/1,
use_parfactors/1,
output/1,
use/1.
:- meta_predicate probability(:,-), conditional_probability(:,:,-).
%output(xbif(user_error)).
%output(gviz(user_error)).
output(no).
solver(hve).
em_solver(hve).
suppress_attribute_display(false).
parameter_softening(m_estimate(10)).
use_parfactors(off).
output(no).
%output(xbif(user_error)).
%output(gviz(user_error)).
clpbn_flag(Flag,Option) :-
ground_solver(ve).
ground_solver(hve).
ground_solver(jt).
ground_solver(bdd).
ground_solver(bp).
ground_solver(cbp).
ground_solver(gibbs).
lifted_solver(lve).
lifted_solver(lkc).
lifted_solver(lbp).
clpbn_flag(Flag, Option) :-
clpbn_flag(Flag, Option, Option).
set_clpbn_flag(Flag,Option) :-
clpbn_flag(Flag, _, Option).
clpbn_flag(output,Before,After) :-
retract(output(Before)),
assert(output(After)).
clpbn_flag(solver,Before,After) :-
retract(solver(Before)),
assert(solver(After)).
clpbn_flag(em_solver,Before,After) :-
retract(em_solver(Before)),
assert(em_solver(After)).
clpbn_flag(bnt_solver,Before,After) :-
retract(bnt:bnt_solver(Before)),
assert(bnt:bnt_solver(After)).
clpbn_flag(bnt_path,Before,After) :-
retract(bnt:bnt_path(Before)),
assert(bnt:bnt_path(After)).
clpbn_flag(bnt_model,Before,After) :-
retract(bnt:bnt_model(Before)),
assert(bnt:bnt_model(After)).
clpbn_flag(suppress_attribute_display,Before,After) :-
retract(suppress_attribute_display(Before)),
assert(suppress_attribute_display(After)).
clpbn_flag(parameter_softening,Before,After) :-
retract(parameter_softening(Before)),
assert(parameter_softening(After)).
clpbn_flag(use_factors,Before,After) :-
retract(use_parfactors(Before)),
assert(use_parfactors(After)).
clpbn_flag(output,Before,After) :-
retract(output(Before)),
assert(output(After)).
set_solver(Solver) :-
set_clpbn_flag(solver,Solver).
set_em_solver(Solver) :-
set_clpbn_flag(em_solver,Solver).
{_} :-
solver(none), !.
{Var = Key with Dist} :-
{ Var = Key with Dist } :-
put_atts(El,[key(Key),dist(DistInfo,Parents)]),
dist(Dist, DistInfo, Key, Parents),
add_evidence(Var,Key,DistInfo,El)
% ,writeln({Var = Key with Dist})
.
.
%
% make sure a query variable is reachable by the garbage collector.
%
% we use a mutable variable to avoid unnecessary trailing.
%
store_var(El) :-
nb_current(clpbn_qvars, Mutable),
store_var(El) :-
nb_current(clpbn_qvars, Mutable),
nonvar(Mutable), !,
get_mutable(Tail, Mutable),
update_mutable(El.Tail, Mutable).
store_var(El) :-
init_clpbn_vars(El).
store_var(El) :-
init_clpbn_vars(El).
init_clpbn_vars(El) :-
create_mutable(El, Mutable),
b_setval(clpbn_qvars, Mutable).
check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
check_constraint((A->D), _, _, (A->D)) :- var(A), !.
check_constraint(Constraint, _, _, Constraint) :-
var(Constraint), !.
check_constraint((A->D), _, _, (A->D)) :-
var(A), !.
check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !,
check_cpt_input_vars(L, Vars, NVars, NL).
check_constraint(Dist, _, _, Dist).
@ -240,17 +272,19 @@ clpbn_marginalise(V, Dist) :-
%
project_attributes(GVars0, _AVars0) :-
use_parfactors(on),
clpbn_flag(solver, Solver), Solver \= fove, !,
clpbn_flag(solver, Solver),
ground_solver(Solver),
generate_network(GVars0, GKeys, Keys, Factors, Evidence),
b_setval(clpbn_query_variables, f(GVars0,Evidence)),
simplify_query(GVars0, GVars),
( GKeys = []
->
(
GKeys = []
->
GVars0 = [V|_],
clpbn_display:put_atts(V, [posterior([],[],[],[])])
;
call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence)
).
).
project_attributes(GVars, AVars) :-
suppress_attribute_display(false),
AVars = [_|_],
@ -264,11 +298,11 @@ project_attributes(GVars, AVars) :-
(output(xbif(XBifStream)) -> clpbn2xbif(XBifStream,ve,AllVars) ; true),
(output(gviz(XBifStream)) -> clpbn2gviz(XBifStream,sort,AllVars,GVars) ; true),
(
Solver = graphs
Solver = graphs
->
write_out(Solver, [[]], AllVars, DiffVars)
write_out(Solver, [[]], AllVars, DiffVars)
;
write_out(Solver, [CLPBNGVars], AllVars, DiffVars)
write_out(Solver, [CLPBNGVars], AllVars, DiffVars)
).
project_attributes(_, _).
@ -322,37 +356,29 @@ get_rid_of_ev_vars([V|LVs0],[V|LVs]) :-
get_rid_of_ev_vars(LVs0,LVs).
% do nothing if we don't have query variables to compute.
write_out(_, [], _, _) :- !.
write_out(graphs, _, AVars, _) :-
clpbn2graph(AVars).
write_out(ve, GVars, AVars, DiffVars) :-
ve(GVars, AVars, DiffVars).
write_out(jt, GVars, AVars, DiffVars) :-
jt(GVars, AVars, DiffVars).
write_out(bdd, GVars, AVars, DiffVars) :-
bdd(GVars, AVars, DiffVars).
write_out(bp, _GVars, _AVars, _DiffVars) :-
writeln('interface not supported any longer').
%bp(GVars, AVars, DiffVars).
write_out(gibbs, GVars, AVars, DiffVars) :-
gibbs(GVars, AVars, DiffVars).
write_out(bnt, GVars, AVars, DiffVars) :-
do_bnt(GVars, AVars, DiffVars).
write_out(fove, GVars, AVars, DiffVars) :-
call_horus_lifted_solver(GVars, AVars, DiffVars).
% call a solver with keys, not actual variables
call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(bdd, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
call_bdd_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
% Call a solver with keys, not actual variables
call_ground_solver(ve, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
call_ve_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(hve, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
clpbn_horus:set_horus_flag(ground_solver, ve),
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(bdd, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
call_bdd_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
clpbn_horus:set_horus_flag(ground_solver, bp),
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(cbp, GVars, GoalKeys, Keys, Factors, Evidence) :- !,
clpbn_horus:set_horus_flag(ground_solver, cbp),
call_horus_ground_solver(GVars, GoalKeys, Keys, Factors, Evidence, _Answ).
call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
% traditional solver
% fall back to traditional solver
b_hash_new(Hash0),
foldl(gvar_in_hash, GVars, Hash0, HashI),
foldl(gvar_in_hash, GVars, Hash0, HashI),
foldl(key_to_var, Keys, AllVars, HashI, Hash1),
foldl(evidence_to_v, Evidence, _EVars, Hash1, Hash),
%writeln(Keys:AllVars),
@ -362,13 +388,51 @@ call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
write_out(Solver, [GVars], AllVars, _),
assert(use_parfactors(on)).
% do nothing if we don't have query variables to compute.
write_out(_, [], _, _) :- !.
write_out(graphs, _, AVars, _) :- !,
clpbn2graph(AVars).
write_out(ve, GVars, AVars, DiffVars) :- !,
ve(GVars, AVars, DiffVars).
write_out(jt, GVars, AVars, DiffVars) :- !,
jt(GVars, AVars, DiffVars).
write_out(bdd, GVars, AVars, DiffVars) :- !,
bdd(GVars, AVars, DiffVars).
write_out(gibbs, GVars, AVars, DiffVars) :- !,
gibbs(GVars, AVars, DiffVars).
write_out(lve, GVars, AVars, DiffVars) :- !,
clpbn_horus:set_horus_flag(lifted_solver, lve),
call_horus_lifted_solver(GVars, AVars, DiffVars).
write_out(lkc, GVars, AVars, DiffVars) :- !,
clpbn_horus:set_horus_flag(lifted_solver, lkc),
call_horus_lifted_solver(GVars, AVars, DiffVars).
write_out(lbp, GVars, AVars, DiffVars) :- !,
clpbn_horus:set_horus_flag(lifted_solver, lbp),
call_horus_lifted_solver(GVars, AVars, DiffVars).
write_out(bnt, GVars, AVars, DiffVars) :- !,
do_bnt(GVars, AVars, DiffVars).
write_out(Solver, _, _, _) :-
format("Error: solver '~w' is unknown.", [Solver]),
fail.
%
% convert a PFL network (without constraints)
% into CLP(BN) for evaluation
%
gvar_in_hash(V, Hash0, Hash) :-
get_atts(V, [key(K)]),
b_hash_insert(Hash0, K, V, Hash).
b_hash_insert(Hash0, K, V, Hash).
key_to_var(K, V, Hash0, Hash0) :-
b_hash_lookup(K, V, Hash0), !.
@ -429,15 +493,15 @@ find_var([_|DVars], V, Key, [_|DKeys]) :-
process_vars([], []).
process_vars([V|Vs], [K|Ks]) :-
process_var(V, K),
process_var(V, K),
process_vars(Vs, Ks).
process_var(V, K) :- get_atts(V, [key(K)]), !.
process_var(V, K) :- get_atts(V, [key(K)]), !.
% oops: this variable has no attributes.
process_var(V, _) :- throw(error(instantiation_error,clpbn(attribute_goal(V)))).
%
% unify a CLPBN variable with something.
% unify a CLPBN variable with something.
%
verify_attributes(Var, T, Goal) :-
get_atts(Var, [key(Key),dist(Dist,Parents)]), !,
@ -452,28 +516,25 @@ bind_clpbn(T, Var, _, _, _, do_not_bind_variable([put_evidence(T,Var)])) :-
bind_clpbn(T, Var, Key, Dist, Parents, []) :- var(T),
get_atts(T, [key(Key1),dist(Dist1,Parents1)]),
(
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1)
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1)
->
(
get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var)
;
get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T)
;
true
)
(
get_atts(T, [evidence(Ev1)]) ->
bind_evidence_from_extra_var(Ev1,Var)
;
get_atts(Var, [evidence(Ev)]) ->
bind_evidence_from_extra_var(Ev,T)
;
true
)
;
fail
fail
).
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bnt),
check_if_bnt_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(ve),
check_if_ve_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bp),
use(hve),
check_if_horus_ground_solver_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(jt),
@ -481,12 +542,21 @@ bind_clpbn(_, Var, _, _, _, _, []) :-
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bdd),
check_if_bdd_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bp),
check_if_horus_ground_solver_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(cbp),
check_if_horus_ground_solver_done(Var), !.
bind_clpbn(_, Var, _, _, _, _, []) :-
use(bnt),
check_if_bnt_done(Var), !.
bind_clpbn(T, Var, Key0, _, _, _, []) :-
get_atts(Var, [key(Key)]), !,
(
Key = Key0 -> true
;
% let us not loose whatever we had.
% let us not loose whatever we had.
put_evidence(T,Var)
).
@ -495,8 +565,8 @@ fresh_attvar(Var, NVar) :-
put_atts(NVar, LAtts).
% I will now allow two CLPBN variables to be bound together.
%bind_clpbns(Key, Dist, Parents, Key, Dist, Parents).
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) :-
% bind_clpbns(Key, Dist, Parents, Key, Dist, Parents).
bind_clpbns(Key, Dist, Parents, Key1, Dist1, Parents1) :-
Key == Key1, !,
get_dist(Dist,_Type,_Domain,_Table),
get_dist(Dist1,_Type1,_Domain1,_Table1),
@ -525,13 +595,22 @@ bind_evidence_from_extra_var(Ev1,Var) :-
bind_evidence_from_extra_var(Ev1,Var) :-
put_atts(Var, [evidence(Ev1)]).
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
user:term_expansion((A :- {}), ( :- true )) :- !, % evidence
prolog_load_context(module, M),
store_evidence(M:A).
clpbn_key(Var,Key) :-
get_atts(Var, [key(Key)]).
%
% only useful for probabilistic context free grammars
%
clpbn_init_graph(pcg) :- !,
pcg_init_graph.
clpbn_init_graph(_).
%
% This is a routine to start a solver, called by the learning procedures (ie, em).
% LVs is a list of lists of variables one is interested in eventually marginalising out
@ -544,94 +623,116 @@ clpbn_init_solver(LVs, Vs0, VarsWithUnboundKeys, State) :-
solver(Solver),
clpbn_init_solver(Solver, LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(gibbs, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(ve, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_ve_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bp, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_horus_ground_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(jt, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_jt_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(bdd, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_bdd_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(gibbs, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_gibbs_solver(LVs, Vs0, VarsWithUnboundKeys, State).
clpbn_init_solver(pcg, LVs, Vs0, VarsWithUnboundKeys, State) :-
init_pcg_solver(LVs, Vs0, VarsWithUnboundKeys, State).
%
% This is a routine to start a solver, called by the learning procedures (ie, em).
% LVs is a list of lists of variables one is interested in eventually marginalising out
% Vs0 gives the original graph
% AllDiffs gives variables that are not fully constrainted, ie, we don't fully know
% the key. In this case, we assume different instances will be bound to different
% values at the end of the day.
%
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, bdd) :-
init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, ve) :-
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, bp) :-
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, VE, hve) :-
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE).
%
% LVs is the list of lists of variables to marginalise
% Vs is the full graph
% Ps are the probabilities on LVs.
%
%
clpbn_run_solver(LVs, LPs, State) :-
solver(Solver),
clpbn_run_solver(Solver, LVs, LPs, State).
clpbn_run_solver(gibbs, LVs, LPs, State) :-
run_gibbs_solver(LVs, LPs, State).
clpbn_run_solver(ve, LVs, LPs, State) :-
run_ve_solver(LVs, LPs, State).
clpbn_run_solver(bp, LVs, LPs, State) :-
run_horus_ground_solver(LVs, LPs, State).
clpbn_run_solver(jt, LVs, LPs, State) :-
run_jt_solver(LVs, LPs, State).
clpbn_run_solver(bdd, LVs, LPs, State) :-
run_bdd_solver(LVs, LPs, State).
clpbn_run_solver(gibbs, LVs, LPs, State) :-
run_gibbs_solver(LVs, LPs, State).
clpbn_run_solver(pcg, LVs, LPs, State) :-
run_pcg_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, ve) :-
%
% This is a routine to start a solver, called by the learning procedures (ie, em).
%
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State) :-
em_solver(Solver),
(lifted_solver(Solver) ->
format("Error: you cannot use a lifted solver for learning.", [Solver]), fail
;
true
),
(ground_solver(Solver) ->
true
;
format("Error: solver '~w' is unknown.", [Solver]), fail
),
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, Solver).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, ve) :- !,
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, hve) :- !,
clpbn_horus:set_horus_flag(ground_solver, ve),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, bdd) :- !,
init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, bp) :- !,
clpbn_horus:set_horus_flag(ground_solver, bp),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(QueryKeys, AllKeys, Factors, Evidence, State, cbp) :- !,
clpbn_horus:set_horus_flag(ground_solver, cbp),
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State).
pfl_init_solver(_, _, _, _, _, Solver) :-
format("Error: solver '~w' can't be used for learning.", [Solver]),
fail.
pfl_run_solver(LVs, LPs, State) :-
em_solver(Solver),
pfl_run_solver(LVs, LPs, State, Solver).
pfl_run_solver(LVs, LPs, State, ve) :- !,
run_ve_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, bdd) :-
pfl_run_solver(LVs, LPs, State, hve) :- !,
run_horus_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, bdd) :- !,
run_bdd_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, bp) :-
run_horus_ground_solver(LVs, LPs, State, bp).
pfl_run_solver(LVs, LPs, State, hve) :-
run_horus_ground_solver(LVs, LPs, State, hve).
pfl_run_solver(LVs, LPs, State, bp) :- !,
run_horus_ground_solver(LVs, LPs, State).
pfl_run_solver(LVs, LPs, State, cbp) :- !,
run_horus_ground_solver(LVs, LPs, State).
pfl_end_solver(State) :-
(em_solver(hve) ; em_solver(bp) ; em_solver(cbp)),
end_horus_ground_solver(State).
pfl_end_solver(_State).
add_keys(Key1+V1,_Key2,Key1+V1).
%
% only useful for probabilistic context free grammars
%
clpbn_init_graph(pcg) :- !,
pcg_init_graph.
clpbn_init_graph(_).
clpbn_finalize_solver(State) :-
solver(bp), !,
functor(State, _, Last),
arg(Last, State, Info),
finalize_horus_ground_solver(Info).
clpbn_finalize_solver(_State).
probability(Goal, Prob) :-
findall(Prob, do_probability(Goal, [], Prob), [Prob]).
conditional_probability(Goal, ListOfGoals, Prob) :-
\+ ground(Goal),
throw(error(ground(Goal),conditional_probability(Goal, ListOfGoals, Prob))).
@ -665,26 +766,26 @@ evidence_to_var(Goal, C, VItem, V) :-
Goal =.. [L|Args],
variabilise_last(Args, C, NArgs, V),
VItem =.. [L|NArgs].
variabilise_last([Arg], Arg, [V], V).
variabilise_last([Arg1,Arg2|Args], Arg, Arg1.NArgs, V) :-
variabilise_last(Arg2.Args, Arg, NArgs, V).
match_probability(VPs, Goal, C, V, Prob) :-
match_probabilities(VPs, Goal, C, V, Prob).
match_probabilities(VPs, Goal, C, V, Prob).
match_probabilities([p(V0=C)=Prob|_], _, C, V, Prob) :-
V0 == V,
!.
V0 == V,
!.
match_probabilities([_|Probs], G, C, V, Prob) :-
match_probabilities(Probs, G, C, V, Prob).
match_probabilities(Probs, G, C, V, Prob).
goal_to_key(_:Goal, Skolem) :-
goal_to_key(Goal, Skolem).
goal_to_key(Goal, Skolem).
goal_to_key(Goal, Skolem) :-
functor(Goal, Na, Ar),
Ar1 is Ar-1,
functor(Skolem, Na, Ar1).
functor(Goal, Na, Ar),
Ar1 is Ar-1,
functor(Skolem, Na, Ar1).
:- use_parfactors(on) -> true ; assert(use_parfactors(off)).

113
packages/CLPBN/clpbn/aggregates.yap
View File

@ -1,42 +1,45 @@
%
%
% generate explicit CPTs
%
:- module(clpbn_aggregates, [
check_for_agg_vars/2,
cpt_average/6,
cpt_average/7,
cpt_max/6,
cpt_min/6,
avg_factors/5
]).
:- module(clpbn_aggregates,
[check_for_agg_vars/2,
cpt_average/6,
cpt_average/7,
cpt_max/6,
cpt_min/6,
avg_factors/5
]).
:- use_module(library(clpbn), [{}/1]).
:- use_module(library(clpbn),
[{}/1]).
:- use_module(library(lists),
[last/2,
sumlist/2,
sum_list/3,
max_list/2,
min_list/2,
nth0/3
]).
[last/2,
sumlist/2,
sum_list/3,
max_list/2,
min_list/2,
nth0/3
]).
:- use_module(library(matrix),
[matrix_new/3,
matrix_to_list/2,
matrix_set/3]).
[matrix_new/3,
matrix_to_list/2,
matrix_set/3
]).
:- use_module(library(clpbn/dists),
[
add_dist/6,
get_dist_domain_size/2]).
[add_dist/6,
get_dist_domain_size/2
]).
:- use_module(library(clpbn/matrix_cpt_utils),
[normalise_CPT_on_lines/3]).
[normalise_CPT_on_lines/3]).
:- use_module(library(pfl),
[skolem/2,
add_ground_factor/5]).
[skolem/2,
add_ground_factor/5
]).
:- use_module(library(bhash)).
@ -60,9 +63,9 @@ simplify_dist(_, _, _, _, Vs0, Vs0).
%
avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
% we keep ev as a list
skolem(Key, Domain),
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
% we keep ev as a list
skolem(Key, Domain),
avg_table(Parents, Parents, Domain, Key, 0, 1.0, NewParents, [], _ExtraSkolems, Id).
% there are 4 cases:
% no evidence on top node
@ -70,17 +73,17 @@ avg_factors(Key, Parents, _Smoothing, NewParents, Id) :-
% evidence on top node *entailed* by values of parents (so there is no real connection)
% evidence incompatible with parents
query_evidence(Key, EvHash, MAT0, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
b_hash_lookup(Key, Ev, EvHash), !,
normalise_CPT_on_lines(MAT0, MAT1, L1),
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
b_hash_lookup(Key, Ev, EvHash), !,
normalise_CPT_on_lines(MAT0, MAT1, L1),
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs).
query_evidence(_, _, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
hash_ev(K=V, Es0, Es) :-
b_hash_insert(Es0, K, V, Es).
b_hash_insert(Es0, K, V, Es).
find_ev(Ev, Key, RemKeys, RemKeys, Ev0, EvF) :-
b_hash_lookup(Key, V, Ev), !,
EvF is Ev0+V.
b_hash_lookup(Key, V, Ev), !,
EvF is Ev0+V.
find_ev(_Evs, Key, RemKeys, [Key|RemKeys], Ev, Ev).
@ -93,11 +96,11 @@ find_ev(_Evs, Key, RemKeys, [Key|RemKeys], Ev, Ev).
% +final CPT
% - New Parents
% + - list of new keys
%
%
avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, Vars, Vs, Vs, Id) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 256,
TabSize =< 256,
/* case gmp is not there !! */
TabSize > 0, !,
average_cpt(Vars, OVars, Domain, TotEvidence, Softness, CPT),
@ -115,7 +118,7 @@ avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, [V1,V2], Vs, [V1,V2|N
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT),
matrix_to_list(CPT, Mat),
add_ground_factor(bayes, Domain, [Key,V1,V2], Mat, Id).
intermediate_table(1,_,[V],V, _, _, I, I, Vs, Vs) :- !.
intermediate_table(2, Op, [V1,V2], V, Key, Softness, I0, If, Vs, Vs) :- !,
If is I0+1,
@ -167,7 +170,7 @@ cpt_min([_|Vars], Key, Els0, CPT, Vs, NewVs) :-
build_avg_table(Vars, OVars, Domain, _, TotEvidence, Softness, CPT, Vars, Vs, Vs) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 256,
TabSize =< 256,
/* case gmp is not there !! */
TabSize > 0, !,
average_cpt(Vars, OVars, Domain, TotEvidence, Softness, CPT).
@ -181,11 +184,11 @@ build_avg_table(Vars, OVars, Domain, Key, TotEvidence, Softness, CPT, [V1,V2], V
build_intermediate_table(LL1, sum(Min,Max), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, sum(Min,Max), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
average_cpt([V1,V2], OVars, Domain, TotEvidence, Softness, CPT).
build_max_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16,
TabSize =< 16,
/* case gmp is not there !! */
TabSize > 0, !,
max_cpt(Vars, Domain, Softness, CPT).
@ -197,11 +200,11 @@ build_max_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewV
build_intermediate_table(LL1, max(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, max(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
max_cpt([V1,V2], Domain, Softness, CPT).
build_min_table(Vars, Domain, Softness, p(Domain, CPT, Vars), Vs, Vs) :-
length(Domain, SDomain),
int_power(Vars, SDomain, 1, TabSize),
TabSize =< 16,
TabSize =< 16,
/* case gmp is not there !! */
TabSize > 0, !,
min_cpt(Vars, Domain, Softness, CPT).
@ -213,7 +216,7 @@ build_min_table(Vars, Domain, Softness, p(Domain, CPT, [V1,V2]), Vs, [V1,V2|NewV
build_intermediate_table(LL1, min(Domain,CPT), L1, V1, Key, 1.0, 0, I1, Vs, Vs1),
build_intermediate_table(LL2, min(Domain,CPT), L2, V2, Key, 1.0, I1, _, Vs1, NewVs),
min_cpt([V1,V2], Domain, Softness, CPT).
int_power([], _, TabSize, TabSize).
int_power([_|L], X, I0, TabSize) :-
I is I0*X,
@ -270,19 +273,21 @@ include_qevidence(_, MAT, MAT, NewParents, NewParents, _, Vs, Vs).
check_consistency(L1, Ev, MAT0, MAT1, L1, MAT, NewParents0, NewParents, Vs, IVs, NewVs) :-
sumlist(L1, Tot),
nth0(Ev, L1, Val),
(Val == Tot ->
MAT1 = MAT,
NewParents = [],
Vs = NewVs
(
Val == Tot
->
MAT1 = MAT,
NewParents = [],
Vs = NewVs
;
Val == 0.0 ->
Val == 0.0 ->
throw(error(domain_error(incompatible_evidence),evidence(Ev)))
;
;
MAT0 = MAT,
NewParents = NewParents0,
IVs = NewVs
).
%
% generate actual table, instead of trusting the solver
@ -299,7 +304,7 @@ get_ds_lengths([],[]).
get_ds_lengths([V|Vs],[Sz|Lengs]) :-
get_vdist_size(V, Sz),
get_ds_lengths(Vs,Lengs).
fill_in_average(Lengs, N, Base, MCPT) :-
generate(Lengs, Case),
average(Case, N, Base, Val),
@ -369,10 +374,10 @@ fill_in_min(_,_).
get_vdist_size(V, Sz) :-
var(V), !,
var(V), !,
clpbn:get_atts(V, [dist(Dist,_)]),
get_dist_domain_size(Dist, Sz).
get_vdist_size(V, Sz) :-
skolem(V, Dom),
skolem(V, Dom),
length(Dom, Sz).

279
packages/CLPBN/clpbn/bdd.yap
View File

@ -9,41 +9,41 @@ V = v(Va, Vb, Vc)
The generic formula is
V <- X, Y
V <- X, Y
Va <- P*X1*Y1 + Q*X2*Y2 + ...
**************************************************/
:- module(clpbn_bdd,
[bdd/3,
set_solver_parameter/2,
init_bdd_solver/4,
init_bdd_ground_solver/5,
run_bdd_solver/3,
run_bdd_ground_solver/3,
finalize_bdd_solver/1,
check_if_bdd_done/1,
call_bdd_ground_solver/6
]).
[bdd/3,
set_solver_parameter/2,
init_bdd_solver/4,
init_bdd_ground_solver/5,
run_bdd_solver/3,
run_bdd_ground_solver/3,
finalize_bdd_solver/1,
check_if_bdd_done/1,
call_bdd_ground_solver/6
]).
:- use_module(library('clpbn/dists'),
[dist/4,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_all_sizes/2,
get_dist_params/2
]).
[dist/4,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_all_sizes/2,
get_dist_params/2
]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
[check_for_agg_vars/2]).
:- use_module(library(atts)).
@ -80,8 +80,8 @@ bdds(bdd).
%
% QVars: all query variables?
%
%
%
%
init_bdd_ground_solver(QueryKeys, AllKeys, Factors, Evidence, bdd(QueryKeys, AllKeys, Factors, Evidence)).
%
@ -93,37 +93,37 @@ run_bdd_ground_solver(_QueryVars, Solutions, bdd(GKeys, Keys, Factors, Evidence)
check_if_bdd_done(_Var).
call_bdd_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_bdd_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_bdd_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
run_solver(QueryKeys, Solutions, BDD).
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_bdd(FactorIds, EvidenceIds, Hash4, Id4, BDD),
run_solver(QueryKeys, Solutions, BDD).
init_bdd(FactorIds, EvidenceIds, Hash, Id, bdd(Term, Leaves, Tops, Hash, Id)) :-
sort_keys(FactorIds, AllVars, Leaves),
rb_new(OrderVs0),
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
rb_new(Vars0),
rb_new(Pars0),
rb_new(Ev0),
foldl(evtotree,EvidenceIds,Ev0,Ev),
rb_new(Fs0),
foldl(ftotree,FactorIds,Fs0,Fs),
init_tops(Leaves,Tops),
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
sort_keys(FactorIds, AllVars, Leaves),
rb_new(OrderVs0),
foldl2(order_key, AllVars, 0, _, OrderVs0, OrderVs),
rb_new(Vars0),
rb_new(Pars0),
rb_new(Ev0),
foldl(evtotree,EvidenceIds,Ev0,Ev),
rb_new(Fs0),
foldl(ftotree,FactorIds,Fs0,Fs),
init_tops(Leaves,Tops),
get_keys_info(AllVars, Ev, Fs, OrderVs, Vars0, _Vars, Pars0, _Pars, Leaves, Tops, Term, []).
order_key( Id, I0, I, OrderVs0, OrderVs) :-
I is I0+1,
rb_insert(OrderVs0, Id, I0, OrderVs).
I is I0+1,
rb_insert(OrderVs0, Id, I0, OrderVs).
evtotree(K=V,Ev0,Ev) :-
rb_insert(Ev0, K, V, Ev).
rb_insert(Ev0, K, V, Ev).
ftotree(F, Fs0, Fs) :-
F = f([K|_Parents],_,_,_),
rb_insert(Fs0, K, F, Fs).
F = f([K|_Parents],_,_,_),
rb_insert(Fs0, K, F, Fs).
bdd([[]],_,_) :- !.
bdd([QueryVars], AllVars, AllDiffs) :-
@ -155,59 +155,59 @@ init_tops([_|Leaves],[_|Tops]) :-
init_tops(Leaves,Tops).
sort_keys(AllFs, AllVars, Leaves) :-
dgraph_new(Graph0),
foldl(add_node, AllFs, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
dgraph_new(Graph0),
foldl(add_node, AllFs, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
add_node(f([K|Parents],_,_,_), Graph0, Graph) :-
dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph).
dgraph_add_vertex(Graph0, K, Graph1),
foldl(add_edge(K), Parents, Graph1, Graph).
add_edge(K, K0, Graph0, Graph) :-
dgraph_add_edge(Graph0, K0, K, Graph).
dgraph_add_edge(Graph0, K0, K, Graph).
sort_vars(AllVars0, AllVars, Leaves) :-
dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
dgraph_new(Graph0),
build_graph(AllVars0, Graph0, Graph),
dgraph_leaves(Graph, Leaves),
dgraph_top_sort(Graph, AllVars).
build_graph([], Graph, Graph).
build_graph([V|AllVars0], Graph0, Graph) :-
clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph).
clpbn:get_atts(V, [dist(_DistId, Parents)]), !,
dgraph_add_vertex(Graph0, V, Graph1),
add_parents(Parents, V, Graph1, GraphI),
build_graph(AllVars0, GraphI, Graph).
build_graph(_V.AllVars0, Graph0, Graph) :-
build_graph(AllVars0, Graph0, Graph).
build_graph(AllVars0, Graph0, Graph).
add_parents([], _V, Graph, Graph).
add_parents([V0|Parents], V, Graph0, GraphF) :-
dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF).
dgraph_add_edge(Graph0, V0, V, GraphI),
add_parents(Parents, V, GraphI, GraphF).
get_keys_info([], _, _, _, Vs, Vs, Ps, Ps, _, _) --> [].
get_keys_info([V|MoreVs], Evs, Fs, OrderVs, Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) },
{ rb_lookup(V, F, Fs) }, !,
{ F = f([V|Parents], _, _, DistId) },
%{writeln(v:DistId:Parents)},
[DIST],
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
[DIST],
{ get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_keys_info(MoreVs, Evs, Fs, OrderVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_key_info(V, F, Fs, Evs, OrderVs, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
reorder_keys(Parents0, OrderVs, Parents, Map),
check_key_p(DistId, F, Map, Parms, _ParmVars, Ps, Ps1),
unbound_parms(Parms, ParmVars),
F = f(_,[Size|_],_,_),
check_key(V, Size, DIST, Vs, Vs1),
DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
% get a list of form [[P00,P01], [P10,P11], [P20,P21]]
foldl(get_key_parent(Fs), Parents, PVars, Vs1, Vs2),
cross_product(Values, Ev, PVars, ParmVars, Formula0),
% (numbervars(Formula0,0,_),writeln(formula0:Ev:Formula0), fail ; true),
get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs).
get_key_evidence(V, Evs, DistId, Tree, Ev, Formula0, Formula, Lvs, Outs).
% (numbervars(Formula,0,_),writeln(formula:Formula), fail ; true).
get_vars_info([], Vs, Vs, Ps, Ps, _, _) --> [].
@ -215,7 +215,7 @@ get_vars_info([V|MoreVs], Vs, VsF, Ps, PsF, Lvs, Outs) -->
{ clpbn:get_atts(V, [dist(DistId, Parents)]) }, !,
%{writeln(v:DistId:Parents)},
[DIST],
{ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
{ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) },
get_vars_info(MoreVs, Vs2, VsF, Ps1, PsF, Lvs, Outs).
get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
get_vars_info(MoreVs, Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs).
@ -298,17 +298,17 @@ generate_3tree(OUT, [[P0,P1,P2]], I00, I10, I20, IR0, N0, N1, N2, R, Exp, _ExpF)
IR is IR0-1,
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
L0 = [P0|L1]
;
;
L0 = L1
),
( satisf(I00, I10+1, I20, IR, N0, N1, N2, R, Exp) ->
L1 = [P1|L2]
;
;
L1 = L2
),
( satisf(I00, I10, I20+1, IR, N0, N1, N2, R, Exp) ->
L2 = [P2]
;
;
L2 = []
),
to_disj(L0, OUT).
@ -316,23 +316,23 @@ generate_3tree(OUT, [[P0,P1,P2]|Ps], I00, I10, I20, IR0, N0, N1, N2, R, Exp, Exp
IR is IR0-1,
( satisf(I00+1, I10, I20, IR, N0, N1, N2, R, Exp) ->
I0 is I00+1, generate_3tree(O0, Ps, I0, I10, I20, IR, N0, N1, N2, R, Exp, ExpF)
->
->
L0 = [P0*O0|L1]
;
;
L0 = L1
),
( satisf(I00, I10+1, I20, IR0, N0, N1, N2, R, Exp) ->
I1 is I10+1, generate_3tree(O1, Ps, I00, I1, I20, IR, N0, N1, N2, R, Exp, ExpF)
->
->
L1 = [P1*O1|L2]
;
;
L1 = L2
),
( satisf(I00, I10, I20+1, IR0, N0, N1, N2, R, Exp) ->
I2 is I20+1, generate_3tree(O2, Ps, I00, I10, I2, IR, N0, N1, N2, R, Exp, ExpF)
->
->
L2 = [P2*O2]
;
;
L2 = []
),
to_disj(L0, OUT).
@ -378,18 +378,18 @@ avg_tree([Vals|PVars], P, Max, Im, IM, Size, O, H0, HF) :-
MaxI is Max-(Size-1),
avg_exp(Vals, PVars, 0, P, MaxI, Size, Im, IM, HI, HF, Exp),
simplify_exp(Exp, Simp).
avg_exp([], _, _, _P, _Max, _Size, _Im, _IM, H, H, 0).
avg_exp([Val|Vals], PVars, I0, P0, Max, Size, Im, IM, HI, HF, O) :-
(Vals = [] -> O=O1 ; O = Val*O1+not(Val)*O2 ),
Im1 is max(0, Im-I0),
IM1 is IM-I0,
( IM1 < 0 -> O1 = 0, H2 = HI; /* we have exceed maximum */
Im1 > Max -> O1 = 0, H2 = HI; /* we cannot make to minimum */
Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI; /* we cannot exceed maximum */
( IM1 < 0 -> O1 = 0, H2 = HI ; /* we have exceed maximum */
Im1 > Max -> O1 = 0, H2 = HI ; /* we cannot make to minimum */
Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI ; /* we cannot exceed maximum */
P is P0+1,
avg_tree(PVars, P, Max, Im1, IM1, Size, O1, HI, H2)
),
),
I is I0+1,
avg_exp(Vals, PVars, I, P0, Max, Size, Im, IM, H2, HF, O2).
@ -434,14 +434,14 @@ bup_avg(V, Size, Domain, Parents0, Vs, Vs2, Lvs, Outs, DIST) :-
bin_sums(Vs, Sums, F) :-
vs_to_sums(Vs, Sums0),
bin_sums(Sums0, Sums, F, []).
vs_to_sums([], []).
vs_to_sums([V|Vs], [Sum|Sums0]) :-
Sum =.. [sum|V],
vs_to_sums(Vs, Sums0).
Sum =.. [sum|V],
vs_to_sums(Vs, Sums0).
bin_sums([Sum], Sum) --> !.
bin_sums(LSums, Sum) -->
bin_sums(LSums, Sum) -->
{ halve(LSums, Sums1, Sums2) },
bin_sums(Sums1, Sum1),
bin_sums(Sums2, Sum2),
@ -458,14 +458,14 @@ head(Take, [H|L], [H|Sums1], Sum2) :-
head(Take1, L, Sums1, Sum2).
sum(Sum1, Sum2, Sum) -->
{ functor(Sum1, _, M1),
functor(Sum2, _, M2),
Max is M1+M2-2,
Max1 is Max+1,
Max0 is M2-1,
functor(Sum, sum, Max1),
Sum1 =.. [_|PVals] },
expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
{ functor(Sum1, _, M1),
functor(Sum2, _, M2),
Max is M1+M2-2,
Max1 is Max+1,
Max0 is M2-1,
functor(Sum, sum, Max1),
Sum1 =.. [_|PVals] },
expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
%
% bottom up step by step
@ -509,12 +509,12 @@ expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, [O=SUM*1|F], F0)
arg(I, NewSums, O),
sum_all(Parents, 0, I0, Max0, Sums, List),
to_disj(List, SUM),
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, F, F0) :-
I is I0+1,
arg(I, Sums, O),
arg(I, NewSums, O),
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
%
%inner loop: find all parents that contribute to A_ji,
@ -536,14 +536,14 @@ sum_all([_V|Vs], Pos, I, Max0, Sums, List) :-
gen_arg(J, Sums, Max, S0) :-
gen_arg(0, Max, J, Sums, S0).
gen_arg(Max, Max, J, Sums, S0) :- !,
I is Max+1,
arg(I, Sums, A),
I is Max+1,
arg(I, Sums, A),
( Max = J -> S0 = A ; S0 = not(A)).
gen_arg(I0, Max, J, Sums, S) :-
I is I0+1,
arg(I, Sums, A),
I is I0+1,
arg(I, Sums, A),
( I0 = J -> S = A*S0 ; S = not(A)*S0),
gen_arg(I, Max, J, Sums, S0).
@ -647,19 +647,19 @@ copy(N, [], [], Ms, Parms0, Parms, ParmVars) :-!,
copy(N, Ms, NewMs, NewMs, Parms0, Parms, ParmVars).
copy(N, D.Ds, ND.NDs, New, El.Parms0, NEl.Parms, V.ParmVars) :-
N1 is N-1,
(El == 0.0 ->
(El == 0.0 ->
NEl = 0,
V = NEl,
ND = D
;El == 1.0 ->
;El == 1.0 ->
NEl = 1,
V = NEl,
ND = 0.0
;El == 0 ->
;El == 0 ->
NEl = 0,
V = NEl,
ND = D
;El =:= 1 ->
;El =:= 1 ->
NEl = 1,
V = NEl,
ND = 0.0,
@ -692,9 +692,9 @@ get_parents(V.Parents, Values.PVars, Vs0, Vs) :-
get_parents(Parents, PVars, Vs1, Vs).
get_key_parent(Fs, V, Values, Vs0, Vs) :-
INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs).
INFO = info(V, _Parent, _Ev, Values, _, _, _),
rb_lookup(V, f(_, [Size|_], _, _), Fs),
check_key(V, Size, INFO, Vs0, Vs).
check_key(V, _, INFO, Vs, Vs) :-
rb_lookup(V, INFO, Vs), !.
@ -809,20 +809,20 @@ skim_for_theta([[P|Other]|More], not(P)*Ps, [Other|Left], New ) :-
skim_for_theta(More, Ps, Left, New ).
get_key_evidence(V, Evs, _, Tree, Ev, F0, F, Leaves, Finals) :-
rb_lookup(V, Pos, Evs), !,
zero_pos(0, Pos, Ev),
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs).
rb_lookup(V, Pos, Evs), !,
zero_pos(0, Pos, Ev),
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F, SendOut, Outs).
% hidden deterministic node, can be removed.
%% get_key_evidence(V, _, DistId, _Tree, Ev, F0, [], _Leaves, _Finals) :-
%% deterministic(V, DistId),
%% deterministic(V, DistId),
%% !,
%% one_list(Ev),
%% eval_outs(F0).
%% eval_outs(F0).
%% no evidence !!!
get_key_evidence(V, _, _, Tree, _Values, F0, F1, Leaves, Finals) :-
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs).
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs).
get_evidence(V, Tree, Ev, F0, F, Leaves, Finals) :-
clpbn:get_atts(V, [evidence(Pos)]), !,
@ -836,17 +836,17 @@ get_evidence(V, _Tree, Ev, F0, [], _Leaves, _Finals) :-
( Name = 'AVG' ; Name = 'MAX' ; Name = 'MIN' ),
!,
one_list(Ev),
eval_outs(F0).
eval_outs(F0).
%% no evidence !!!
get_evidence(V, Tree, _Values, F0, F1, Leaves, Finals) :-
insert_output(Leaves, V, Finals, Tree, Outs, SendOut),
get_outs(F0, F1, SendOut, Outs).
zero_pos(_, _Pos, []).
zero_pos(Pos, Pos, [1|Values]) :- !,
zero_pos(Pos, Pos, [1|Values]) :- !,
I is Pos+1,
zero_pos(I, Pos, Values).
zero_pos(I0, Pos, [0|Values]) :-
zero_pos(I0, Pos, [0|Values]) :-
I is I0+1,
zero_pos(I, Pos, Values).
@ -855,7 +855,7 @@ one_list(1.Ev) :-
one_list(Ev).
%
% insert a node with the disj of all alternatives, this is only done if node ends up to be in the output
% insert a node with the disj of all alternatives, this is only done if node ends up to be in the output
%
insert_output([], _V, [], _Out, _Outs, []).
insert_output(V._Leaves, V0, [Top|_], Top, Outs, [Top = Outs]) :- V == V0, !.
@ -863,7 +863,7 @@ insert_output(_.Leaves, V, _.Finals, Top, Outs, SendOut) :-
insert_output(Leaves, V, Finals, Top, Outs, SendOut).
get_outs([V=F], [V=NF|End], End, V) :- !,
get_outs([V=F], [V=NF|End], End, V) :- !,
% writeln(f0:F),
simplify_exp(F,NF).
get_outs([(V=F)|Outs], [(V=NF)|NOuts], End, (F0 + V)) :-
@ -878,11 +878,11 @@ eval_outs([(V=F)|Outs]) :-
eval_outs(Outs).
run_solver(Qs, LLPs, bdd(Term, Leaves, Nodes, Hash, Id)) :-
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
findall(LPs,
(member(Q, QIds),
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
LLPs).
lists_of_keys_to_ids(Qs, QIds, Hash, _, Id, _),
findall(LPs,
(member(Q, QIds),
run_bdd_solver([Q],LPs,bdd(Term,Leaves,Nodes))),
LLPs).
run_bdd_solver([Vs], LPs, bdd(Term, _Leaves, Nodes)) :-
build_out_node(Nodes, Node),
@ -988,7 +988,7 @@ all_cnfs([info(_V, Tree, Ev, Values, Formula, ParmVars, Parms)|Term], BindsF, IV
v_in(V, [V0|_]) :- V == V0, !.
v_in(V, [_|Vs]) :-
v_in(V, Vs).
v_in(V, Vs).
all_indicators(Values) -->
{ values_to_disj(Values, Disj) },
@ -1017,7 +1017,7 @@ parameters([(V0=Disj*_I0)|Formula], Tree) -->
parameters(Formula, Tree).
% transform V0<- A*B+C*(D+not(E))
% [V0+not(A)+not(B),V0+not(C)+not(D),V0+not(C)+E]
% [V0+not(A)+not(B),V0+not(C)+not(D),V0+not(C)+E]
conj(Disj, V0) -->
{ conj2(Disj, [[V0]], LVs) },
to_disjs(LVs).
@ -1057,11 +1057,10 @@ generate_exclusions([V0|SeenVs], V) -->
build_cnf(CNF, IVs, Indics, AllParms, AllParmValues, Val) :-
%(numbervars(CNF,1,_), writeln(cnf_to_ddnnf(CNF, Vars, IVs, [], F)), fail ; true ),
cnf_to_ddnnf(CNF, AllParms, F),
cnf_to_ddnnf(CNF, AllParms, F),
AllParms = AllParmValues,
IVs = Indics,
term_variables(CNF, Extra),
set_to_ones(Extra),
ddnnf_is(F, Val).

97
packages/CLPBN/clpbn/bnt.yap
View File

@ -1,45 +1,51 @@
:- module(bnt, [do_bnt/3,
create_bnt_graph/2,
check_if_bnt_done/1]).
:- module(bnt,
[do_bnt/3,
create_bnt_graph/2,
check_if_bnt_done/1
]).
:- use_module(library('clpbn/display'), [
clpbn_bind_vals/3]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/dists'), [
get_dist_domain_size/2,
get_dist_domain/2,
get_dist_params/2
]).
:- use_module(library('clpbn/dists'),
[get_dist_domain_size/2,
get_dist_domain/2,
get_dist_params/2
]).
:- use_module(library('clpbn/discrete_utils'), [
reorder_CPT/5]).
:- use_module(library('clpbn/discrete_utils'),
[reorder_CPT/5]).
:- use_module(library(matlab), [start_matlab/1,
close_matlab/0,
matlab_on/0,
matlab_eval_string/1,
matlab_eval_string/2,
matlab_matrix/4,
matlab_vector/2,
matlab_sequence/3,
matlab_initialized_cells/4,
matlab_get_variable/2,
matlab_call/2
]).
:- use_module(library(matlab),
[start_matlab/1,
close_matlab/0,
matlab_on/0,
matlab_eval_string/1,
matlab_eval_string/2,
matlab_matrix/4,
matlab_vector/2,
matlab_sequence/3,
matlab_initialized_cells/4,
matlab_get_variable/2,
matlab_call/2
]).
:- use_module(library(dgraphs), [dgraph_new/1,
dgraph_add_vertices/3,
dgraph_add_edges/3,
dgraph_top_sort/2,
dgraph_vertices/2,
dgraph_edges/2
]).
:- use_module(library(dgraphs),
[dgraph_new/1,
dgraph_add_vertices/3,
dgraph_add_edges/3,
dgraph_top_sort/2,
dgraph_vertices/2,
dgraph_edges/2
]).
:- use_module(library(lists), [append/3,
member/2,nth/3]).
:- use_module(library(lists),
[append/3,
member/2,nth/3
]).
:- use_module(library(ordsets), [
ord_insert/3]).
:- use_module(library(ordsets),
[ord_insert/3]).
:- yap_flag(write_strings,on).
@ -95,7 +101,7 @@ do_bnt(QueryVars, AllVars, AllDiffs) :-
add_evidence(SortedVertices, Size, NumberedVertices),
marginalize(QueryVars, SortedVertices, NumberedVertices, Ps),
clpbn_bind_vals(QueryVars, Ps, AllDiffs).
create_bnt_graph(AllVars, Representatives) :-
create_bnt_graph(AllVars, Representatives, _, _, _).
@ -148,7 +154,7 @@ extract_kvars([V|AllVars],[N-i(V,Parents)|KVars]) :-
extract_kvars(AllVars,KVars).
split_tied_vars([],[],[]).
split_tied_vars([N-i(V,Par)|More],[N-g(Vs,Ns,Es)|TVars],[N|LNs]) :-
split_tied_vars([N-i(V,Par)|More],[N-g(Vs,Ns,Es)|TVars],[N|LNs]) :-
get_pars(Par,N,V,NPs,[],Es0,Es),
get_tied(More,N,Vs,[V],Ns,NPs,Es,Es0,SVars),
split_tied_vars(SVars,TVars,LNs).
@ -200,7 +206,7 @@ extract_graph(AllVars, Graph) :-
dgraph_add_vertices(Graph0, AllVars, Graph1),
get_edges(AllVars,Edges),
dgraph_add_edges(Graph1, Edges, Graph).
get_edges([],[]).
get_edges([V|AllVars],Edges) :-
clpbn:get_atts(V, [dist(_,Parents)]),
@ -218,13 +224,13 @@ number_graph([V|SortedGraph], [I|Is], I0, IF) :-
% clpbn:get_atts(V,[key(K)]),
% write(I:K),nl,
number_graph(SortedGraph, Is, I, IF).
init_bnet(propositional, SortedGraph, NumberedGraph, Size, []) :-
build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size),
bnet <-- mk_bnet(dag, node_sizes, \discrete, discrete_nodes),
dump_cpts(SortedGraph, NumberedGraph).
init_bnet(tied, SortedGraph, NumberedGraph, Size, Representatives) :-
build_dag(SortedGraph, Size),
init_discrete_nodes(SortedGraph, Size),
@ -314,7 +320,7 @@ get_sizes_and_ids([V|Parents],[Id-V|Ids]) :-
extract_vars([], L, L).
extract_vars([_-V|NIds], NParents, Vs) :-
extract_vars(NIds, [V|NParents], Vs).
mkcpt(BayesNet, I, Tab) :-
(BayesNet.'CPD'({I})) <-- tabular_CPD(BayesNet,I,Tab).
@ -330,7 +336,7 @@ create_class_vector([], [], [],[]).
create_class_vector([V|Graph], [I|Is], [Id|Classes], [Id-v(V,I,Parents)|Sets]) :-
clpbn:get_atts(V, [dist(Id,Parents)]),
create_class_vector(Graph, Is,Classes,Sets).
representatives([],[]).
representatives([Class-Rep|Reps1],[Class-Rep|Reps]) :-
nonrepresentatives(Reps1, Class, Reps2),
@ -376,7 +382,7 @@ add_evidence(Graph, Size, Is) :-
mk_evidence(Graph, Is, LN),
matlab_initialized_cells( 1, Size, LN, evidence),
[engine_ev, loglik] <-- enter_evidence(engine, evidence).
mk_evidence([], [], []).
mk_evidence([V|L], [I|Is], [ar(1,I,EvVal1)|LN]) :-
clpbn:get_atts(V, [evidence(EvVal)]), !,
@ -384,7 +390,7 @@ mk_evidence([V|L], [I|Is], [ar(1,I,EvVal1)|LN]) :-
mk_evidence(L, Is, LN).
mk_evidence([_|L], [_|Is], LN) :-
mk_evidence(L, Is, LN).
evidence_val(Ev,Val,[Ev|_],Val) :- !.
evidence_val(Ev,I0,[_|Domain],Val) :-
I1 is I0+1,
@ -403,7 +409,7 @@ marginalize([Vs], SortedVars, NumberedVars,Ps) :-
length(SortedVars,L),
cycle_values(Den, Ev, Vs, L, Vals, Ps).
cycle_values(_D, _Ev, _Vs, _Size, [], []).
cycle_values(_D, _Ev, _Vs, _Size, [], []).
cycle_values(Den,Ev,Vs,Size,[H|T],[HP|TP]):-
mk_evidence_query(Vs, H, EvQuery),
@ -421,5 +427,4 @@ mk_evidence_query([V|L], [H|T], [ar(1,Pos,El)|LN]) :-
get_dist_domain(Id,D),
nth(El,D,H),
mk_evidence_query(L, T, LN).

116
packages/CLPBN/clpbn/connected.yap
View File

@ -1,26 +1,28 @@
:- module(clpbn_connected,
[influences/3,
factor_influences/4,
init_influences/3,
influences/4]
).
[influences/3,
factor_influences/4,
init_influences/3,
influences/4
]).
:- use_module(library(maplist)).
:- use_module(library(dgraphs),
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_neighbors/3,
dgraph_edge/3,
dgraph_transpose/2]).
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_neighbors/3,
dgraph_edge/3,
dgraph_transpose/2
]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_lookup/3,
rb_insert/4,
rb_visit/2]).
[rb_new/1,
rb_lookup/3,
rb_insert/4,
rb_visit/2
]).
factor_influences(Vs, QVars, Ev, LV) :-
init_factor_influences(Vs, G, RG),
@ -59,13 +61,13 @@ build_edges([P|Parents], V, [P-V|Edges]) :-
% search for the set of variables that influence V
influences(Vs, G, RG, Vars) :-
influences(Vs, [], G, RG, Vars).
influences(Vs, [], G, RG, Vars).
% search for the set of variables that influence V
influences(Vs, Evs, G, RG, Vars) :-
rb_new(Visited0),
foldl(influence(Evs, G, RG), Vs, Visited0, Visited),
all_top(Visited, Evs, Vars).
rb_new(Visited0),
foldl(influence(Evs, G, RG), Vs, Visited0, Visited),
all_top(Visited, Evs, Vars).
influence(_, _G, _RG, V, Vs, Vs) :-
rb_lookup(V, [T|B], Vs), T == t, B == b, !.
@ -89,76 +91,78 @@ process_new_variable(V, Evs, G, RG, Vs0, Vs2) :-
% visited
throw_below(Evs, G, RG, Child, Vs0, Vs1) :-
rb_lookup(Child, [_|B], Vs0), !,
(
B == b ->
(
B == b
->
Vs0 = Vs1 % been there before
;
;
B = b, % mark it
handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1)
).
handle_ball_from_above(Child, Evs, G, RG, Vs0, Vs1)
).
throw_below(Evs, G, RG, Child, Vs0, Vs2) :-
rb_insert(Vs0, Child, [_|b], Vs1),
handle_ball_from_above(Child, Evs, G, RG, Vs1, Vs2).
% share this with parents, if we have evidence
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
var(V),
clpbn:get_atts(V,[evidence(_)]), !,
dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
var(V),
clpbn:get_atts(V,[evidence(_)]), !,
dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
nonvar(V),
rb_lookup(V,_,Evs), !,
dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
nonvar(V),
rb_lookup(V,_,Evs), !,
dgraph_neighbors(V, RG, Parents),
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
% propagate to kids, if we do not
handle_ball_from_above(V, Evs, G, RG, Vs0, Vs1) :-
dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
% visited
throw_above(Evs, G, RG, Parent, Vs0, Vs1) :-
rb_lookup(Parent, [T|_], Vs0), !,
(
T == t ->
(
T == t
->
Vs1 = Vs0 % been there before
;
;
T = t, % mark it
handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1)
).
handle_ball_from_below(Parent, Evs, G, RG, Vs0, Vs1)
).
throw_above(Evs, G, RG, Parent, Vs0, Vs2) :-
rb_insert(Vs0, Parent, [t|_], Vs1),
handle_ball_from_below(Parent, Evs, G, RG, Vs1, Vs2).
% share this with parents, if we have evidence
handle_ball_from_below(V, _Evs, _, _, Vs, Vs) :-
var(V),
clpbn:get_atts(V,[evidence(_)]), !.
var(V),
clpbn:get_atts(V,[evidence(_)]), !.
handle_ball_from_below(V, Evs, _, _, Vs, Vs) :-
nonvar(V),
rb_lookup(V, _, Evs), !.
nonvar(V),
rb_lookup(V, _, Evs), !.
% propagate to kids, if we do not
handle_ball_from_below(V, Evs, G, RG, Vs0, Vs1) :-
dgraph_neighbors(V, RG, Parents),
propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1).
dgraph_neighbors(V, RG, Parents),
propagate_ball_from_below(Parents, Evs, V, G, RG, Vs0, Vs1).
propagate_ball_from_below([], Evs, V, G, RG, Vs0, Vs1) :- !,
dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
dgraph_neighbors(V, G, Children),
foldl(throw_below(Evs, G, RG), Children, Vs0, Vs1).
propagate_ball_from_below(Parents, Evs, _V, G, RG, Vs0, Vs1) :-
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
foldl(throw_above(Evs, G, RG), Parents, Vs0, Vs1).
all_top(T, Evs, Vs) :-
rb_visit(T, Pairs),
foldl( get_top(Evs), Pairs, [], Vs).
rb_visit(T, Pairs),
foldl( get_top(Evs), Pairs, [], Vs).
get_top(_EVs, V-[T|_], Vs, [V|Vs]) :-
T == t, !.
T == t, !.
get_top(_EVs, V-_, Vs, [V|Vs]) :-
var(V),
clpbn:get_atts(V,[evidence(_)]), !.
var(V),
clpbn:get_atts(V,[evidence(_)]), !.
get_top(EVs, V-_, Vs, [V|Vs]) :-
nonvar(V),
rb_lookup(V, _, EVs), !.
nonvar(V),
rb_lookup(V, _, EVs), !.
get_top(_, _, Vs, Vs).

23
packages/CLPBN/clpbn/discrete_utils.yap
View File

@ -1,10 +1,14 @@
:- module(discrete_utils, [project_from_CPT/3,
reorder_CPT/5,
get_dist_size/2]).
:- module(discrete_utils,
[project_from_CPT/3,
reorder_CPT/5,
get_dist_size/2
]).
:- use_module(library(clpbn/dists), [get_dist_domain_size/2,
get_dist_domain/2]).
:- use_module(library(clpbn/dists),
[get_dist_domain_size/2,
get_dist_domain/2
]).
%
% remove columns from a table
%
@ -20,11 +24,11 @@ propagate_evidence(V, Evs) :-
clpbn:get_atts(V, [evidence(Ev),dist(Id,_)]), !,
get_dist_domain(Id, Out),
generate_szs_with_evidence(Out,Ev,0,Evs,Found),
(var(Found) ->
clpbn:get_atts(V, [key(K)]),
throw(clpbn(evidence_does_not_match,K,Ev,[Out]))
(var(Found) ->
clpbn:get_atts(V, [key(K)]),
throw(clpbn(evidence_does_not_match,K,Ev,[Out]))
;
true
true
).
propagate_evidence(_, _).
@ -143,4 +147,3 @@ get_sizes([V|Deps], [Sz|Sizes]) :-
get_dist_domain_size(Id,Sz),
get_sizes(Deps, Sizes).

19
packages/CLPBN/clpbn/display.yap
View File

@ -1,17 +1,20 @@
:- module(clpbn_display, [
clpbn_bind_vals/3]).
:- module(clpbn_display,
[clpbn_bind_vals/3]).
:- use_module(library(lists),
[
member/2
]).
[member/2]).
:- use_module(library(clpbn/dists), [get_dist_domain/2]).
:- use_module(library(clpbn/dists),
[get_dist_domain/2]).
:- use_module(library(clpbn), [use_parfactors/1]).
:- use_module(library(clpbn),
[use_parfactors/1]).
:- use_module(library(maplist)).
:- use_module(library(atts)).
:- attribute posterior/4.
@ -75,7 +78,7 @@ clpbn_bind_vals([Vs|MoreVs],[Ps|MorePs],AllDiffs) :-
clpbn_bind_vals2([],_,_) :- !.
% simple case, we want a distribution on a single variable.
clpbn_bind_vals2([V],Ps,AllDiffs) :-
clpbn_bind_vals2([V],Ps,AllDiffs) :-
use_parfactors(on), !,
clpbn:get_atts(V, [key(K)]),
pfl:skolem(K,Vals),

75
packages/CLPBN/clpbn/dists.yap
View File

@ -3,47 +3,51 @@
%
:- module(clpbn_dist,
[
dist/1,
dist/4,
dists/1,
dist_new_table/2,
get_dist/4,
get_dist_matrix/5,
get_possibly_deterministic_dist_matrix/5,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_params/2,
get_dist_key/2,
get_dist_all_sizes/2,
get_evidence_position/3,
get_evidence_from_position/3,
dist_to_term/2,
empty_dist/2,
all_dist_ids/1,
randomise_all_dists/0,
randomise_dist/1,
uniformise_all_dists/0,
uniformise_dist/1,
reset_all_dists/0,
add_dist/6,
additive_dists/6
]).
[dist/1,
dist/4,
dists/1,
dist_new_table/2,
get_dist/4,
get_dist_matrix/5,
get_possibly_deterministic_dist_matrix/5,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_params/2,
get_dist_key/2,
get_dist_all_sizes/2,
get_evidence_position/3,
get_evidence_from_position/3,
dist_to_term/2,
empty_dist/2,
all_dist_ids/1,
randomise_all_dists/0,
randomise_dist/1,
uniformise_all_dists/0,
uniformise_dist/1,
reset_all_dists/0,
add_dist/6,
additive_dists/6
]).
:- use_module(library(lists),[nth0/3,append/3]).
:- use_module(library(lists),
[nth0/3,
append/3
]).
:- use_module(library(clpbn),
[use_parfactors/1]).
[use_parfactors/1]).
:- use_module(library(matrix),
[matrix_new/4,
matrix_new/3,
matrix_to_list/2,
matrix_to_logs/1]).
[matrix_new/4,
matrix_new/3,
matrix_to_list/2,
matrix_to_logs/1
]).
:- use_module(library(clpbn/matrix_cpt_utils),
[random_CPT/2,
uniform_CPT/2]).
[random_CPT/2,
uniform_CPT/2
]).
/*
:- mode dist(+, -).
@ -86,7 +90,7 @@ where Id is the id,
dna for [a,c,g,t]
rna for [a,c,g,u]
reals
********************************************/
@ -365,3 +369,4 @@ reset_all_dists.
additive_dists(ip(Domain,Tabs1), ip(Domain,Tabs2), Parents1, Parents2, ip(Domain,Tabs), Parents) :-
append(Tabs1, Tabs2, Tabs),
append(Parents1, Parents2, Parents).

47
packages/CLPBN/clpbn/evidence.yap
View File

@ -4,36 +4,34 @@
%
:- module(clpbn_evidence,
[
store_evidence/1,
incorporate_evidence/2,
check_stored_evidence/2,
add_stored_evidence/2,
put_evidence/2
]).
[store_evidence/1,
incorporate_evidence/2,
check_stored_evidence/2,
add_stored_evidence/2,
put_evidence/2
]).
:- use_module(library(clpbn), [
{}/1,
clpbn_flag/3,
set_clpbn_flag/2
]).
:- use_module(library(clpbn),
[{}/1,
clpbn_flag/3,
set_clpbn_flag/2
]).
:- use_module(library('clpbn/dists'), [
get_dist/4
]).
:- use_module(library('clpbn/dists'),
[get_dist/4]).
:- use_module(library(rbtrees), [
rb_new/1,
rb_lookup/3,
rb_insert/4
]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_lookup/3,
rb_insert/4
]).
:- meta_predicate store_evidence(:).
:- dynamic node/3, edge/2, evidence/2.
%
% new evidence storage algorithm. The idea is that instead of
% new evidence storage algorithm. The idea is that instead of
% redoing all the evidence every time we query the network, we shall
% keep a precompiled version around.
%
@ -53,9 +51,9 @@ compute_evidence(_,PreviousSolver) :-
set_clpbn_flag(solver, PreviousSolver).
get_clpbn_vars(G, Vars) :-
% attributes:all_attvars(Vars0),
% attributes:all_attvars(Vars0),
once(G),
attributes:all_attvars(Vars).
attributes:all_attvars(Vars).
evidence_error(Ball,PreviousSolver) :-
set_clpbn_flag(solver,PreviousSolver),
@ -63,7 +61,7 @@ evidence_error(Ball,PreviousSolver) :-
store_graph([]).
store_graph([V|Vars]) :-
clpbn:get_atts(V,[key(K),dist(Id,Vs)]),
clpbn:get_atts(V,[key(K),dist(Id,Vs)]),
\+ node(K, Id, _), !,
translate_vars(Vs,TVs),
assert(node(K,Id,TVs)),
@ -86,7 +84,6 @@ add_links([K0|TVs],K) :-
assert(edge(K,K0)),
add_links(TVs,K).
incorporate_evidence(Vs,AllVs) :-
rb_new(Cache0),
create_open_list(Vs, OL, FL, Cache0, CacheI),

97
packages/CLPBN/clpbn/gibbs.yap
View File

@ -8,51 +8,54 @@
%
:- module(clpbn_gibbs,
[gibbs/3,
check_if_gibbs_done/1,
init_gibbs_solver/4,
run_gibbs_solver/3]).
[gibbs/3,
check_if_gibbs_done/1,
init_gibbs_solver/4,
run_gibbs_solver/3
]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_insert/4,
rb_lookup/3]).
[rb_new/1,
rb_insert/4,
rb_lookup/3
]).
:- use_module(library(lists),
[member/2,
append/3,
delete/3,
max_list/2,
sum_list/2]).
[member/2,
append/3,
delete/3,
max_list/2,
sum_list/2
]).
:- use_module(library(ordsets),
[ord_subtract/3]).
[ord_subtract/3]).
:- use_module(library('clpbn/matrix_cpt_utils'), [
project_from_CPT/3,
reorder_CPT/5,
multiply_possibly_deterministic_factors/3,
column_from_possibly_deterministic_CPT/3,
normalise_possibly_deterministic_CPT/2,
list_from_CPT/2]).
:- use_module(library('clpbn/matrix_cpt_utils'),
[project_from_CPT/3,
reorder_CPT/5,
multiply_possibly_deterministic_factors/3,
column_from_possibly_deterministic_CPT/3,
normalise_possibly_deterministic_CPT/2,
list_from_CPT/2
]).
:- use_module(library('clpbn/utils'), [
check_for_hidden_vars/3]).
:- use_module(library('clpbn/utils'),
[check_for_hidden_vars/3]).
:- use_module(library('clpbn/dists'), [
get_possibly_deterministic_dist_matrix/5,
get_dist_domain_size/2]).
:- use_module(library('clpbn/dists'),
[get_possibly_deterministic_dist_matrix/5,
get_dist_domain_size/2
]).
:- use_module(library('clpbn/topsort'), [
topsort/2]).
:- use_module(library('clpbn/topsort'),
[topsort/2]).
:- use_module(library('clpbn/display'), [
clpbn_bind_vals/3]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/connected'),
[
influences/3
]).
[influences/3]).
:- dynamic gibbs_params/3.
@ -134,7 +137,7 @@ graph_representation([V|Vs], Graph, I0, Keys, [I-IParents|TGraph]) :-
graph_representation(Vs, Graph, I, Keys, TGraph).
write_pars([]).
write_pars([V|Parents]) :-
write_pars([V|Parents]) :-
clpbn:get_atts(V, [key(K),dist(I,_)]),write(K:I),nl,
write_pars(Parents).
@ -146,7 +149,7 @@ get_sizes([V|Parents], [Sz|Szs]) :-
parent_indices([], _, []).
parent_indices([V|Parents], Keys, [I|IParents]) :-
rb_lookup(V, I, Keys),
rb_lookup(V, I, Keys),
parent_indices(Parents, Keys, IParents).
@ -171,7 +174,7 @@ propagate2parents([V|NewParents], Table, Variables, Graph, Keys) :-
propagate2parents(NewParents,Table, Variables, Graph, Keys).
add2graph(V, Vals, Table, IParents, Graph, Keys) :-
rb_lookup(V, Index, Keys),
rb_lookup(V, Index, Keys),
(var(Vals) -> true ; length(Vals,Sz)),
arg(Index, Graph, var(V,Index,_,Vals,Sz,VarSlot,_,_,_)),
member(tabular(Table,Index,IParents), VarSlot), !.
@ -236,7 +239,7 @@ mult_list([Sz|Sizes],Mult0,Mult) :-
MultI is Sz*Mult0,
mult_list(Sizes,MultI,Mult).
% compile node as set of facts, faster execution
% compile node as set of facts, faster execution
compile_var(TotSize,I,_Vals,Sz,CPTs,Parents,_Sizes,Graph) :-
TotSize < 1024*64, TotSize > 0, !,
multiply_all(I,Parents,CPTs,Sz,Graph).
@ -246,11 +249,11 @@ compile_var(_,_,_,_,_,_,_,_).
multiply_all(I,Parents,CPTs,Sz,Graph) :-
markov_blanket_instance(Parents,Graph,Values),
(
multiply_all(CPTs,Graph,Probs)
multiply_all(CPTs,Graph,Probs)
->
store_mblanket(I,Values,Probs)
store_mblanket(I,Values,Probs)
;
throw(error(domain_error(bayesian_domain),gibbs_cpt(I,Parents,Values,Sz)))
throw(error(domain_error(bayesian_domain),gibbs_cpt(I,Parents,Values,Sz)))
),
fail.
multiply_all(I,_,_,_,_) :-
@ -280,7 +283,7 @@ fetch_parents([], _, []).
fetch_parents([P|Parents], Graph, [Val|Vals]) :-
arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)),
fetch_parents(Parents, Graph, Vals).
multiply_more([],_,Probs0,LProbs) :-
normalise_possibly_deterministic_CPT(Probs0, Probs),
list_from_CPT(Probs, LProbs0),
@ -296,7 +299,7 @@ accumulate_up_list([P|LProbs], P0, [P1|L]) :-
P1 is P0+P,
accumulate_up_list(LProbs, P1, L).
store_mblanket(I,Values,Probs) :-
recordz(mblanket,m(I,Values,Probs),_).
@ -364,8 +367,8 @@ generate_est_mults([], [], _, [], 1).
generate_est_mults([V|Vs], [I|Is], Graph, [M0|Mults], M) :-
arg(V,Graph,var(_,I,_,_,Sz,_,_,_,_)),
generate_est_mults(Vs, Is, Graph, Mults, M0),
M is M0*Sz.
M is M0*Sz.
gen_e0(0,[]) :- !.
gen_e0(Sz,[0|E0L]) :-
Sz1 is Sz-1,
@ -455,7 +458,7 @@ get_estimate_pos([I|Is], Sample, [M|Mult], V0, V) :-
get_estimate_pos(Is, Sample, Mult, VI, V).
update_estimate_for_var(V0,[X|T],[X1|NT]) :-
( V0 == 0 ->
(V0 == 0 ->
X1 is X+1,
NT = T
;
@ -496,7 +499,7 @@ do_probs([E|Es],Sum,[P|Ps]) :-
show_sorted([], _) :- nl.
show_sorted([I|VarOrder], Graph) :-
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
arg(I,Graph,var(V,I,_,_,_,_,_,_,_)),
clpbn:get_atts(V,[key(K)]),
format('~w ',[K]),
show_sorted(VarOrder, Graph).
@ -528,7 +531,7 @@ add_up_mes(Counts,[me(_,_,Cs)|Chains], Add) :-
sum_lists(Counts, Cs, NCounts),
add_up_mes(NCounts, Chains, Add).
sum_lists([],[],[]).
sum_lists([],[],[]).
sum_lists([Count|Counts], [C|Cs], [NC|NCounts]) :-
NC is Count+C,
sum_lists(Counts, Cs, NCounts).
@ -542,5 +545,3 @@ divide_list([C|Add], Sum, [P|Dist]) :-
P is C/Sum,
divide_list(Add, Sum, Dist).

15
packages/CLPBN/clpbn/graphs.yap
View File

@ -3,13 +3,14 @@
% Just output a graph with all the variables.
%
:- module(clpbn2graph, [clpbn2graph/1]).
:- module(clpbn2graph,
[clpbn2graph/1]).
:- use_module(library('clpbn/utils'), [
check_for_hidden_vars/3]).
:- use_module(library('clpbn/utils'),
[check_for_hidden_vars/3]).
:- use_module(library('clpbn/dists'), [
get_dist/4]).
:- use_module(library('clpbn/dists'),
[get_dist/4]).
:- attribute node/0.
@ -37,7 +38,3 @@ translate_vars([V|Vs],[K|Ks]) :-
clpbn:get_atts(V, [key(K)]),
translate_vars(Vs,Ks).

6
packages/CLPBN/clpbn/graphviz.yap
View File

@ -1,4 +1,6 @@
:- module(clpbn_gviz, [clpbn2gviz/4]).
:- module(clpbn_gviz,
[clpbn2gviz/4]).
clpbn2gviz(Stream, Name, Network, Output) :-
format(Stream, 'digraph ~w {
@ -48,7 +50,7 @@ output_parents1(Stream,[V|L]) :-
put_code(Stream, 0' ), %'
output_parents1(Stream,L).
output_v(V,Stream) :-
output_v(V,Stream) :-
clpbn:get_atts(V,[key(Key)]),
output_key(Stream,Key).

99
packages/CLPBN/clpbn/ground_factors.yap
View File

@ -1,40 +1,34 @@
%parfactor(
% [ability(P),grade(C,S), satisfaction(C,S,P)],
% \phi = [....],
% [P,C,S],
% [P \in [p1,p2,p4], C \in [c1,c3], S \in [s2,s3]]).
% [S \= s2])
:- module(pfl_ground_factors,
[generate_network/5,
f/3
]).
:- use_module(library(bhash),
[b_hash_new/1,
b_hash_lookup/3,
b_hash_insert/4,
b_hash_to_list/2
]).
:- module(pfl_ground_factors, [
generate_network/5,
f/3
]).
:- use_module(library(bhash), [
b_hash_new/1,
b_hash_lookup/3,
b_hash_insert/4,
b_hash_to_list/2]).
:- use_module(library(lists), [
delete/3,
nth0/3,
member/2]).
:- use_module(library(lists),
[member/2]).
:- use_module(library(maplist)).
:- use_module(library(pfl), [
factor/6,
defined_in_factor/2,
skolem/2]).
:- use_module(library(atts)).
:- use_module(library(clpbn/aggregates), [
avg_factors/5]).
:- use_module(library(pfl),
[factor/6,
defined_in_factor/2,
skolem/2
]).
:- use_module(library(clpbn/dists), [
dist/4]).
:- use_module(library(clpbn/aggregates),
[avg_factors/5]).
:- use_module(library(clpbn/dists),
[dist/4]).
:- dynamic currently_defined/1, queue/1, f/4.
@ -48,7 +42,7 @@ generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
b_hash_new(Evidence0),
foldl(include_evidence,AVars, Evidence0, Evidence1),
static_evidence(Evidence1, Evidence),
b_hash_to_list(Evidence, EList0),
b_hash_to_list(Evidence, EList0),
maplist(pair_to_evidence,EList0, EList),
maplist(queue_evidence, EList),
foldl(run_through_query(Evidence), QueryVars, [], QueryKeys),
@ -59,20 +53,20 @@ generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
% clean global stateq
%
init_global_search :-
retractall(queue(_)),
retractall(currently_defined(_)),
retractall(f(_,_,_)).
retractall(queue(_)),
retractall(currently_defined(_)),
retractall(f(_,_,_)).
pair_to_evidence(K-E, K=E).
include_evidence(V, Evidence0, Evidence) :-
clpbn:get_atts(V,[key(K),evidence(E)]), !,
(
b_hash_lookup(K, E1, Evidence0)
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
;
b_hash_insert(Evidence0, K, E, Evidence)
b_hash_insert(Evidence0, K, E, Evidence)
).
include_evidence(_, Evidence, Evidence).
@ -82,16 +76,16 @@ static_evidence(Evidence0, Evidence) :-
include_static_evidence(K=E, Evidence0, Evidence) :-
(
b_hash_lookup(K, E1, Evidence0)
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
;
b_hash_insert(Evidence0, K, E, Evidence)
b_hash_insert(Evidence0, K, E, Evidence)
).
queue_evidence(K=_) :-
queue_in(K).
queue_in(K).
run_through_query(Evidence, V, QueryKeys, QueryKeys) :-
clpbn:get_atts(V,[key(K)]),
@ -122,11 +116,11 @@ propagate.
do_propagate(K) :-
%writeln(-K),
\+ currently_defined(K),
( ground(K) -> assert(currently_defined(K)) ; true),
( ground(K) -> assert(currently_defined(K)) ; true),
(
defined_in_factor(K, ParFactor),
add_factor(ParFactor, Ks)
*->
*->
true
;
throw(error(no_defining_factor(K)))
@ -136,28 +130,29 @@ do_propagate(K) :-
queue_in(K1),
fail.
do_propagate(_K) :-
propagate.
propagate.
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
% writeln(+Ks),
( Ks = [K,Els], var(Els)
->
% aggregate factor
% writeln(+Ks),
(
Ks = [K,Els], var(Els)
->
% aggregate factor
once(run(Constraints)),
avg_factors(K, Els, 0.0, NewKeys, NewId),
NKs = [K|NewKeys]
;
;
run(Constraints),
NKs = Ks,
Id = NewId
),
(
f(Type, NewId, NKs)
->
f(Type, NewId, NKs)
->
true
;
;
assert(f(Type, NewId, NKs))
).
).
run([Goal|Goals]) :-
call(user:Goal),

50
packages/CLPBN/clpbn/hmm.yap
View File

@ -1,19 +1,20 @@
:- module(hmm, [init_hmm/0,
hmm_state/1,
emission/1]).
:- module(hmm,
[init_hmm/0,
hmm_state/1,
emission/1
]).
:- ensure_loaded(library(clpbn)).
:- use_module(library(lists),
[nth/3]).
[nth/3]).
:- use_module(library(nbhash),
[nb_hash_new/2,
nb_hash_lookup/3,
nb_hash_insert/3
]).
[nb_hash_new/2,
nb_hash_lookup/3,
nb_hash_insert/3
]).
:- ensure_loaded(library(tries)).
@ -46,22 +47,19 @@ hmm_state(N/A,Mod) :-
Key =.. [T|KArgs],
Head =.. [N|LArgs],
asserta_static( (Mod:Head :-
( First > 2 ->
Last = Key, !
;
nb_getval(trie, Trie), trie_check_entry(Trie, Key, _)
->
% leave work for solver!
%
Last = Key, !
;
% first time we saw this entry
nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
fail
)
)
).
(First > 2 ->
Last = Key, !
;
nb_getval(trie, Trie), trie_check_entry(Trie, Key, _) ->
% leave work for solver!
Last = Key, !
;
% first time we saw this entry
nb_getval(trie, Trie), trie_put_entry(Trie, Key, _),
fail
)
)).
build_args(4,[A,B,C,D],[A,B,C],A,D).
build_args(3, [A,B,C], [A,B],A,C).
build_args(2, [A,B], [A],A,B).
@ -79,5 +77,3 @@ cvt_vals([A|B],[A|B]).
find_probs(Logs,Nth,Log) :-
arg(Nth,Logs,Log).

81
packages/CLPBN/clpbn/horus.yap
View File

@ -1,65 +1,56 @@
/*******************************************************
Horus Interface
********************************************************/
:- module(clpbn_horus,
[set_solver/1,
set_horus_flag/1,
cpp_create_lifted_network/3,
cpp_create_ground_network/4,
cpp_set_parfactors_params/2,
cpp_set_factors_params/2,
cpp_run_lifted_solver/3,
cpp_run_ground_solver/3,
cpp_set_vars_information/2,
cpp_set_horus_flag/2,
cpp_free_lifted_network/1,
cpp_free_ground_network/1
]).
:- use_module(library(clpbn),
[set_clpbn_flag/2]).
patch_things_up :-
assert_static(clpbn_horus:cpp_set_horus_flag(_,_)).
warning :-
format(user_error,"Horus library not installed: cannot use bp, fove~n.",[]).
[set_horus_flag/2,
cpp_create_lifted_network/3,
cpp_create_ground_network/4,
cpp_set_parfactors_params/3,
cpp_set_factors_params/3,
cpp_run_lifted_solver/3,
cpp_run_ground_solver/3,
cpp_set_vars_information/2,
cpp_set_horus_flag/2,
cpp_free_lifted_network/1,
cpp_free_ground_network/1
]).
:- catch(load_foreign_files([horus], [], init_predicates), _, patch_things_up)
-> true ; warning.
-> true ; warning.
set_solver(ve) :- !, set_clpbn_flag(solver,ve).
set_solver(bdd) :- !, set_clpbn_flag(solver,bdd).
set_solver(jt) :- !, set_clpbn_flag(solver,jt).
set_solver(gibbs) :- !, set_clpbn_flag(solver,gibbs).
set_solver(lve) :- !, set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, lve).
set_solver(lbp) :- !, set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, lbp).
set_solver(lkc) :- !, set_clpbn_flag(solver,fove), set_horus_flag(lifted_solver, lkc).
set_solver(hve) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, ve).
set_solver(bp) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, bp).
set_solver(cbp) :- !, set_clpbn_flag(solver,bp), set_horus_flag(ground_solver, cbp).
set_solver(S) :- throw(error('unknown solver ', S)).
patch_things_up :-
assert_static(clpbn_horus:cpp_set_horus_flag(_,_)).
warning :-
format(user_error,"Horus library not installed: cannot use hve, bp, cbp, lve, lkc and lbp~n.",[]).
set_horus_flag(K,V) :- cpp_set_horus_flag(K,V).
:- cpp_set_horus_flag(schedule, seq_fixed).
%:- cpp_set_horus_flag(schedule, seq_random).
%:- cpp_set_horus_flag(schedule, parallel).
%:- cpp_set_horus_flag(schedule, max_residual).
:- cpp_set_horus_flag(verbosity, 0).
:- cpp_set_horus_flag(accuracy, 0.0001).
%:- cpp_set_horus_flag(use_logarithms, false).
:- cpp_set_horus_flag(use_logarithms, true).
:- cpp_set_horus_flag(max_iter, 1000).
%:- cpp_set_horus_flag(hve_elim_heuristic, sequential).
%:- cpp_set_horus_flag(hve_elim_heuristic, min_neighbors).
%:- cpp_set_horus_flag(hve_elim_heuristic, min_weight).
%:- cpp_set_horus_flag(hve_elim_heuristic, min_fill).
:- cpp_set_horus_flag(hve_elim_heuristic, weighted_min_fill).
:- cpp_set_horus_flag(use_logarithms, false).
% :- cpp_set_horus_flag(use_logarithms, true).
:- cpp_set_horus_flag(bp_msg_schedule, seq_fixed).
%:- cpp_set_horus_flag(bp_msg_schedule, seq_random).
%:- cpp_set_horus_flag(bp_msg_schedule, parallel).
%:- cpp_set_horus_flag(bp_msg_schedule, max_residual).
:- cpp_set_horus_flag(bp_accuracy, 0.0001).
:- cpp_set_horus_flag(bp_max_iter, 1000).

131
packages/CLPBN/clpbn/horus_ground.yap
View File

@ -1,102 +1,89 @@
/*******************************************************
Interface to Horus Ground Solvers. Used by:
- Variable Elimination
- Belief Propagation
- Counting Belief Propagation
- Variable Elimination
- Belief Propagation
- Counting Belief Propagation
********************************************************/
:- module(clpbn_horus_ground,
[call_horus_ground_solver/6,
check_if_horus_ground_solver_done/1,
init_horus_ground_solver/5,
run_horus_ground_solver/4,
finalize_horus_ground_solver/1
]).
[call_horus_ground_solver/6,
check_if_horus_ground_solver_done/1,
init_horus_ground_solver/5,
run_horus_ground_solver/3,
end_horus_ground_solver/1
]).
:- use_module(horus,
[cpp_create_ground_network/4,
cpp_set_factors_params/2,
cpp_run_ground_solver/3,
cpp_set_vars_information/2,
cpp_free_ground_network/1,
set_solver/1
]).
[cpp_create_ground_network/4,
cpp_set_factors_params/3,
cpp_run_ground_solver/3,
cpp_free_ground_network/1,
cpp_set_vars_information/2
]).
:- use_module(library('clpbn/dists'),
[dist/4,
get_dist_domain/2,
get_dist_domain_size/2,
get_dist_params/2
]).
:- use_module(library('clpbn/numbers'),
[lists_of_keys_to_ids/6,
keys_to_numbers/7
]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library(clpbn/numbers)).
:- use_module(library(charsio),
[term_to_atom/2]).
[clpbn_bind_vals/3]).
:- use_module(library(pfl),
[skolem/2]).
[get_pfl_parameters/2,
skolem/2
]).
:- use_module(library(charsio),
[term_to_atom/2]).
:- use_module(library(maplist)).
:- use_module(library(lists)).
:- use_module(library(atts)).
:- use_module(library(bhash)).
call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence,
Output) :-
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State),
run_horus_ground_solver([QueryKeys], Solutions, State),
clpbn_bind_vals([QueryVars], Solutions, Output),
end_horus_ground_solver(State).
call_horus_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, State),
run_solver(State, [QueryKeys], Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output),
finalize_horus_ground_solver(State).
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence,
state(Network,Hash,Id,DistIds)) :-
factors_type(Factors, Type),
keys_to_numbers(AllKeys, Factors, Evidence, Hash, Id, FacIds, EvIds),
%writeln(network:(type=Type, factors=FacIds, evidence=EvIds)), nl,
cpp_create_ground_network(Type, FacIds, EvIds, Network),
%maplist(term_to_atom, AllKeys, VarNames),
%maplist(get_domain, AllKeys, Domains),
%cpp_set_vars_information(VarNames, Domains),
maplist(get_dist_id, FacIds, DistIds0),
sort(DistIds0, DistIds).
init_horus_ground_solver(QueryKeys, AllKeys, Factors, Evidence, state(Network,Hash4,Id4)) :-
get_factors_type(Factors, Type),
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
cpp_create_ground_network(Type, FactorIds, EvidenceIds, Network),
%writeln(network:(Type, FactorIds, EvidenceIds, Network)), writeln(''),
maplist(get_var_information, AllKeys, StatesNames),
maplist(term_to_atom, AllKeys, KeysAtoms),
cpp_set_vars_information(KeysAtoms, StatesNames).
run_horus_ground_solver(QueryKeys, Solutions,
state(Network,Hash,Id, DistIds)) :-
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
%maplist(get_pfl_parameters, DistIds, DistParams),
%cpp_set_factors_params(Network, DistIds, DistParams),
cpp_run_ground_solver(Network, QueryIds, Solutions).
run_horus_ground_solver(_QueryVars, Solutions, horus(GKeys, Keys, Factors, Evidence), Solver) :-
set_solver(Solver),
call_horus_ground_solver_for_probabilities(GKeys, Keys, Factors, Evidence, Solutions).
end_horus_ground_solver(state(Network,_Hash,_Id, _DistIds)) :-
cpp_free_ground_network(Network).
% TODO this is not beeing called!
finalize_horus_ground_solver(state(Network,_Hash,_Id)) :-
cpp_free_ground_network(Network).
factors_type([f(bayes, _, _)|_], bayes) :- ! .
factors_type([f(markov, _, _)|_], markov) :- ! .
run_solver(state(Network,Hash,Id), QueryKeys, Solutions) :-
%get_dists_parameters(DistIds, DistsParams),
%cpp_set_factors_params(Network, DistsParams),
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash, _, Id, _),
cpp_run_ground_solver(Network, QueryIds, Solutions).
get_dist_id(f(_, _, _, DistId), DistId).
get_factors_type([f(bayes, _, _)|_], bayes) :- ! .
get_factors_type([f(markov, _, _)|_], markov) :- ! .
get_var_information(_:Key, Domain) :- !,
skolem(Key, Domain).
get_var_information(Key, Domain) :-
skolem(Key, Domain).
%get_dists_parameters([],[]).
%get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :-
% get_dist_params(Id, Params),
% get_dists_parameters(Ids, DistsInfo).
get_domain(_:Key, Domain) :- !,
skolem(Key, Domain).
get_domain(Key, Domain) :-
skolem(Key, Domain).

165
packages/CLPBN/clpbn/horus_lifted.yap
View File

@ -1,148 +1,115 @@
/*******************************************************
Interface to Horus Lifted Solvers. Used by:
- Generalized Counting First-Order Variable Elimination (GC-FOVE)
- Lifted First-Order Belief Propagation
- Lifted First-Order Knowledge Compilation
- Generalized Counting First-Order Variable Elimination (GC-FOVE)
- Lifted First-Order Belief Propagation
- Lifted First-Order Knowledge Compilation
********************************************************/
:- module(clpbn_horus_lifted,
[call_horus_lifted_solver/3,
check_if_horus_lifted_solver_done/1,
init_horus_lifted_solver/4,
run_horus_lifted_solver/3,
finalize_horus_lifted_solver/1
]).
[call_horus_lifted_solver/3,
check_if_horus_lifted_solver_done/1,
init_horus_lifted_solver/4,
run_horus_lifted_solver/3,
end_horus_lifted_solver/1
]).
:- use_module(horus,
[cpp_create_lifted_network/3,
cpp_set_parfactors_params/2,
cpp_run_lifted_solver/3,
cpp_free_lifted_network/1
]).
[cpp_create_lifted_network/3,
cpp_set_parfactors_params/3,
cpp_run_lifted_solver/3,
cpp_free_lifted_network/1
]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/dists'),
[get_dist_params/2]).
[clpbn_bind_vals/3]).
:- use_module(library(pfl),
[factor/6,
skolem/2,
get_pfl_parameters/2
]).
[factor/6,
skolem/2,
get_pfl_parameters/2
]).
:- use_module(library(maplist)).
call_horus_lifted_solver(QueryVars, AllVars, Output) :-
init_horus_lifted_solver(_, AllVars, _, State),
run_horus_lifted_solver(QueryVars, Solutions, State),
clpbn_bind_vals(QueryVars, Solutions, Output),
finalize_horus_lifted_solver(State).
init_horus_lifted_solver(_, AllVars, _, State),
run_horus_lifted_solver(QueryVars, Solutions, State),
clpbn_bind_vals(QueryVars, Solutions, Output),
end_horus_lifted_solver(State).
init_horus_lifted_solver(_, AllVars, _, state(ParfactorList, DistIds)) :-
get_parfactors(Parfactors),
get_dist_ids(Parfactors, DistIds0),
sort(DistIds0, DistIds),
get_observed_vars(AllVars, ObservedVars),
%writeln(parfactors:Parfactors:'\n'),
%writeln(evidence:ObservedVars:'\n'),
cpp_create_lifted_network(Parfactors, ObservedVars, ParfactorList).
init_horus_lifted_solver(_, AllVars, _, state(Network, DistIds)) :-
get_parfactors(Parfactors),
get_observed_keys(AllVars, ObservedKeys),
%writeln(network:(parfactors=Parfactors, evidence=ObservedKeys)), nl,
cpp_create_lifted_network(Parfactors, ObservedKeys, Network),
maplist(get_dist_id, Parfactors, DistIds0),
sort(DistIds0, DistIds).
run_horus_lifted_solver(QueryVars, Solutions, state(ParfactorList, DistIds)) :-
get_query_keys(QueryVars, QueryKeys),
get_dists_parameters(DistIds, DistsParams),
%writeln(dists:DistsParams), writeln(''),
cpp_set_parfactors_params(ParfactorList, DistsParams),
cpp_run_lifted_solver(ParfactorList, QueryKeys, Solutions).
run_horus_lifted_solver(QueryVars, Solutions, state(Network, DistIds)) :-
maplist(get_query_keys, QueryVars, QueryKeys),
%maplist(get_pfl_parameters, DistIds,DistsParams),
%cpp_set_parfactors_params(Network, DistIds, DistsParams),
cpp_run_lifted_solver(Network, QueryKeys, Solutions).
finalize_horus_lifted_solver(state(ParfactorList, _)) :-
cpp_free_lifted_network(ParfactorList).
end_horus_lifted_solver(state(Network, _)) :-
cpp_free_lifted_network(Network).
%
% Enumerate all parfactors and enumerate their domain as tuples.
%
:- table get_parfactors/1.
%
% enumerate all parfactors and enumerate their domain as tuples.
%
% output is list of pf(
% Id: an unique number
% Ks: a list of keys, also known as the pf formula [a(X),b(Y),c(X,Y)]
% Vs: the list of free variables [X,Y]
% Phi: the table following usual CLP(BN) convention
% Tuples: ground bindings for variables in Vs, of the form [fv(x,y)]
%
get_parfactors(Factors) :-
findall(F, is_factor(F), Factors).
findall(F, is_factor(F), Factors).
is_factor(pf(Id, Ks, Rs, Phi, Tuples)) :-
factor(_Type, Id, Ks, Vs, Table, Constraints),
get_ranges(Ks,Rs),
Table \= avg,
gen_table(Table, Phi),
all_tuples(Constraints, Vs, Tuples).
factor(_Type, Id, Ks, Vs, Table, Constraints),
maplist(get_range, Ks, Rs),
Table \= avg,
gen_table(Table, Phi),
all_tuples(Constraints, Vs, Tuples).
get_ranges([],[]).
get_ranges(K.Ks, Range.Rs) :- !,
skolem(K,Domain),
length(Domain,Range),
get_ranges(Ks, Rs).
get_range(K, Range) :-
skolem(K, Domain),
length(Domain, Range).
gen_table(Table, Phi) :-
( is_list(Table)
->
Phi = Table
;
call(user:Table, Phi)
).
( is_list(Table) -> Phi = Table ; call(user:Table, Phi) ).
all_tuples(Constraints, Tuple, Tuples) :-
setof(Tuple, Constraints^run(Constraints), Tuples).
setof(Tuple, Constraints^run(Constraints), Tuples).
run([]).
run(Goal.Constraints) :-
user:Goal,
run(Constraints).
user:Goal,
run(Constraints).
get_dist_ids([], []).
get_dist_ids(pf(Id, _, _, _, _).Parfactors, Id.DistIds) :-
get_dist_ids(Parfactors, DistIds).
get_dist_id(pf(DistId, _, _, _, _), DistId).
get_observed_vars([], []).
get_observed_vars(V.AllAttVars, [K:E|ObservedVars]) :-
clpbn:get_atts(V,[key(K)]),
( clpbn:get_atts(V,[evidence(E)]) ; pfl:evidence(K,E) ), !,
get_observed_vars(AllAttVars, ObservedVars).
get_observed_vars(V.AllAttVars, ObservedVars) :-
clpbn:get_atts(V,[key(_K)]), !,
get_observed_vars(AllAttVars, ObservedVars).
get_observed_keys([], []).
get_observed_keys(V.AllAttVars, [K:E|ObservedKeys]) :-
clpbn:get_atts(V,[key(K)]),
( clpbn:get_atts(V,[evidence(E)]) ; pfl:evidence(K,E) ), !,
get_observed_keys(AllAttVars, ObservedKeys).
get_observed_keys(_V.AllAttVars, ObservedKeys) :-
get_observed_keys(AllAttVars, ObservedKeys).
get_query_keys([], []).
get_query_keys(E1.L1, E2.L2) :-
get_query_keys_2(E1,E2),
get_query_keys(L1, L2).
get_query_keys_2([], []).
get_query_keys_2(V.AttVars, [RV|RVs]) :-
clpbn:get_atts(V,[key(RV)]), !,
get_query_keys_2(AttVars, RVs).
get_dists_parameters([], []).
get_dists_parameters([Id|Ids], [dist(Id, Params)|DistsInfo]) :-
get_pfl_parameters(Id, Params),
get_dists_parameters(Ids, DistsInfo).
get_query_keys(V.AttVars, K.Ks) :-
clpbn:get_atts(V,[key(K)]), !,
get_query_keys(AttVars, Ks).

199
packages/CLPBN/clpbn/jt.yap
View File

@ -1,89 +1,93 @@
:- module(jt, [jt/3,
init_jt_solver/4,
run_jt_solver/3]).
:- module(jt,
[jt/3,
init_jt_solver/4,
run_jt_solver/3
]).
:- use_module(library(dgraphs),
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_transpose/2,
dgraph_to_ugraph/2,
ugraph_to_dgraph/2,
dgraph_neighbors/3
]).
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertex/3,
dgraph_add_vertices/3,
dgraph_edges/2,
dgraph_vertices/2,
dgraph_transpose/2,
dgraph_to_ugraph/2,
ugraph_to_dgraph/2,
dgraph_neighbors/3
]).
:- use_module(library(undgraphs),
[undgraph_new/1,
undgraph_add_edge/4,
undgraph_add_edges/3,
undgraph_del_vertex/3,
undgraph_del_vertices/3,
undgraph_vertices/2,
undgraph_edges/2,
undgraph_neighbors/3,
undgraph_edge/3,
dgraph_to_undgraph/2
]).
[undgraph_new/1,
undgraph_add_edge/4,
undgraph_add_edges/3,
undgraph_del_vertex/3,
undgraph_del_vertices/3,
undgraph_vertices/2,
undgraph_edges/2,
undgraph_neighbors/3,
undgraph_edge/3,
dgraph_to_undgraph/2
]).
:- use_module(library(wundgraphs),
[wundgraph_new/1,
wundgraph_max_tree/3,
wundgraph_add_edges/3,
wundgraph_add_vertices/3,
wundgraph_to_undgraph/2
]).
[wundgraph_new/1,
wundgraph_max_tree/3,
wundgraph_add_edges/3,
wundgraph_add_vertices/3,
wundgraph_to_undgraph/2
]).
:- use_module(library(rbtrees),
[rb_new/1,
rb_insert/4,
rb_lookup/3]).
[rb_new/1,
rb_insert/4,
rb_lookup/3
]).
:- use_module(library(ordsets),
[ord_subset/2,
ord_insert/3,
ord_intersection/3,
ord_del_element/3,
ord_memberchk/2]).
[ord_subset/2,
ord_insert/3,
ord_intersection/3,
ord_del_element/3,
ord_memberchk/2
]).
:- use_module(library(lists),
[reverse/2]).
[reverse/2]).
:- use_module(library(maplist)).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
[check_for_agg_vars/2]).
:- use_module(library('clpbn/dists'),
[get_dist_domain_size/2,
get_dist_domain/2,
get_dist_matrix/5]).
[get_dist_domain_size/2,
get_dist_domain/2,
get_dist_matrix/5
]).
:- use_module(library('clpbn/matrix_cpt_utils'),
[project_from_CPT/3,
reorder_CPT/5,
unit_CPT/2,
multiply_CPTs/4,
divide_CPTs/3,
normalise_CPT/2,
expand_CPT/4,
get_CPT_sizes/2,
reset_CPT_that_disagrees/5,
sum_out_from_CPT/4,
list_from_CPT/2]).
[project_from_CPT/3,
reorder_CPT/5,
unit_CPT/2,
multiply_CPTs/4,
divide_CPTs/3,
normalise_CPT/2,
expand_CPT/4,
get_CPT_sizes/2,
reset_CPT_that_disagrees/5,
sum_out_from_CPT/4,
list_from_CPT/2
]).
:- use_module(library('clpbn/display'), [
clpbn_bind_vals/3]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/connected'),
[
init_influences/3,
influences/4
]).
[init_influences/3,
influences/4
]).
jt([[]],_,_) :- !.
@ -94,7 +98,7 @@ jt(LLVs,Vs0,AllDiffs) :-
init_jt_solver(LLVs, Vs0, _, State) :-
check_for_agg_vars(Vs0, Vs1),
check_for_agg_vars(Vs0, Vs1),
init_influences(Vs1, G, RG),
maplist(init_jt_solver_for_question(G, RG), LLVs, State).
@ -131,7 +135,7 @@ run_vars([V|LVs], Edges, [V|Vs], [CPTVars-dist([V|Parents],Id)|CPTs], Ev) :-
add_evidence_from_vars(V, [e(V,P)|Evs], Evs) :-
clpbn:get_atts(V, [evidence(P)]), !.
add_evidence_from_vars(_, Evs, Evs).
find_nth0([Id|_], Id, P, P) :- !.
find_nth0([_|D], Id, P0, P) :-
P1 is P0+1,
@ -159,7 +163,7 @@ initial_graph(_,Parents, CPTs) :-
% from the very beginning.
dgraph_transpose(V1, V2),
dgraph_to_ugraph(V2, Parents).
problem_graph([], []).
problem_graph([V|BNet], GraphF) :-
@ -171,7 +175,7 @@ add_parents([], _, Graph, Graph).
add_parents([P|Parents], V, Graph0, [P-V|GraphF]) :-
add_parents(Parents, V, Graph0, GraphF).
% From David Page's lectures
test_graph(0,
[1-3,2-3,2-4,5-4,5-7,10-7,10-9,11-9,3-6,4-6,7-8,9-8,6-12,8-12],
@ -228,19 +232,19 @@ choose([V|Vertices], Graph, Score0, _, _, Best, _, Cliques0, Cliques, EdgesF) :-
ord_insert(Neighbors, V, PossibleClique),
new_edges(Neighbors, Graph, NewEdges),
(
% simplicial edge
NewEdges == []
% simplicial edge
NewEdges == []
->
!,
Best = V,
NewEdges = EdgesF,
length(PossibleClique,L),
Cliques = [L-PossibleClique|Cliques0]
!,
Best = V,
NewEdges = EdgesF,
length(PossibleClique,L),
Cliques = [L-PossibleClique|Cliques0]
;
% cliquelength(PossibleClique,1,CL),
length(PossibleClique,CL),
CL < Score0, !,
choose(Vertices,Graph,CL,NewEdges, V, Best, CL-PossibleClique, Cliques0,Cliques,EdgesF)
% cliquelength(PossibleClique,1,CL),
length(PossibleClique,CL),
CL < Score0, !,
choose(Vertices,Graph,CL,NewEdges, V, Best, CL-PossibleClique, Cliques0,Cliques,EdgesF)
).
choose([_|Vertices], Graph, Score0, Edges0, BestSoFar, Best, Clique, Cliques0, Cliques, EdgesF) :-
choose(Vertices,Graph,Score0,Edges0, BestSoFar, Best, Clique, Cliques0,Cliques,EdgesF).
@ -285,18 +289,17 @@ get_links([Sz-Clique|Cliques], SoFar, Vertices, Edges0, Edges) :-
get_links(Cliques, [Clique|SoFar], Vertices, EdgesI, Edges).
get_links([_|Cliques], SoFar, Vertices, Edges0, Edges) :-
get_links(Cliques, SoFar, Vertices, Edges0, Edges).
add_clique_edges([], _, _, Edges, Edges).
add_clique_edges([Clique1|Cliques], Clique, Sz, Edges0, EdgesF) :-
ord_intersection(Clique1, Clique, Int),
Int \== Clique,
(
Int = [] ->
add_clique_edges(Cliques, Clique, Sz, Edges0, EdgesF)
(Int = [] ->
add_clique_edges(Cliques, Clique, Sz, Edges0, EdgesF)
;
% we connect
length(Int, LSz),
add_clique_edges(Cliques, Clique, Sz, [Clique-(Clique1-LSz)|Edges0], EdgesF)
% we connect
length(Int, LSz),
add_clique_edges(Cliques, Clique, Sz, [Clique-(Clique1-LSz)|Edges0], EdgesF)
).
root(WTree, JTree) :-
@ -358,25 +361,25 @@ get_cpts([], _, [], []).
get_cpts([CPT|CPts], [], [], [CPT|CPts]) :- !.
get_cpts([[I|MCPT]-Info|CPTs], [J|Clique], MyCPTs, MoreCPTs) :-
compare(C,I,J),
( C == < ->
(C == < ->
% our CPT cannot be a part of the clique.
MoreCPTs = [[I|MCPT]-Info|LeftoverCPTs],
get_cpts(CPTs, [J|Clique], MyCPTs, LeftoverCPTs)
;
C == = ->
% our CPT cannot be a part of the clique.
get_cpt(MCPT, Clique, I, Info, MyCPTs, MyCPTs0, MoreCPTs, MoreCPTs0),
get_cpts(CPTs, [J|Clique], MyCPTs0, MoreCPTs0)
;
% the first element in our CPT may not be in a clique
get_cpts([[I|MCPT]-Info|CPTs], Clique, MyCPTs, MoreCPTs)
C == = ->
% our CPT cannot be a part of the clique.
get_cpt(MCPT, Clique, I, Info, MyCPTs, MyCPTs0, MoreCPTs, MoreCPTs0),
get_cpts(CPTs, [J|Clique], MyCPTs0, MoreCPTs0)
;
% the first element in our CPT may not be in a clique
get_cpts([[I|MCPT]-Info|CPTs], Clique, MyCPTs, MoreCPTs)
).
get_cpt(MCPT, Clique, I, Info, [[I|MCPT]-Info|MyCPTs], MyCPTs, MoreCPTs, MoreCPTs) :-
ord_subset(MCPT, Clique), !.
get_cpt(MCPT, _, I, Info, MyCPTs, MyCPTs, [[I|MCPT]-Info|MoreCPTs], MoreCPTs).
translate_edges([], [], []).
translate_edges([E1-E2|Edges], [(E1-A)-(E2-B)|NEdges], [E1-A,E2-B|Vs]) :-
translate_edges(Edges, NEdges, Vs).
@ -385,13 +388,13 @@ match_vs(_,[]).
match_vs([K-A|Cls],[K1-B|KVs]) :-
compare(C, K, K1),
(C == = ->
A = B,
match_vs([K-A|Cls], KVs)
A = B,
match_vs([K-A|Cls], KVs)
;
C = < ->
match_vs(Cls,[K1-B|KVs])
C = < ->
match_vs(Cls,[K1-B|KVs])
;
match_vs([K-A|Cls],KVs)
match_vs([K-A|Cls],KVs)
).
fill_with_cpts(tree(Clique-Dists,Leafs), tree(Clique-NewDists,NewLeafs)) :-

151
packages/CLPBN/clpbn/matrix_cpt_utils.yap
View File

@ -1,51 +1,54 @@
:- module(clpbn_matrix_utils,
[init_CPT/3,
project_from_CPT/3,
sum_out_from_CPT/5,
project_from_CPT/6,
reorder_CPT/5,
get_CPT_sizes/2,
normalise_CPT/2,
multiply_CPTs/4,
multiply_CPTs/6,
divide_CPTs/3,
expand_CPT/4,
reset_CPT_that_disagrees/5,
unit_CPT/2,
sum_out_from_CPT/4,
list_from_CPT/2,
multiply_factors/3,
normalise_possibly_deterministic_CPT/2,
column_from_possibly_deterministic_CPT/3,
multiply_possibly_deterministic_factors/3,
random_CPT/2,
uniform_CPT/2,
uniform_CPT_as_list/2,
normalise_CPT_on_lines/3]).
[init_CPT/3,
project_from_CPT/3,
sum_out_from_CPT/5,
project_from_CPT/6,
reorder_CPT/5,
get_CPT_sizes/2,
normalise_CPT/2,
multiply_CPTs/4,
multiply_CPTs/6,
divide_CPTs/3,
expand_CPT/4,
reset_CPT_that_disagrees/5,
unit_CPT/2,
sum_out_from_CPT/4,
list_from_CPT/2,
multiply_factors/3,
normalise_possibly_deterministic_CPT/2,
column_from_possibly_deterministic_CPT/3,
multiply_possibly_deterministic_factors/3,
random_CPT/2,
uniform_CPT/2,
uniform_CPT_as_list/2,
normalise_CPT_on_lines/3
]).
:- use_module(library(matrix),
[matrix_new/4,
matrix_new_set/4,
matrix_select/4,
matrix_dims/2,
matrix_size/2,
matrix_shuffle/3,
matrix_expand/3,
matrix_op/4,
matrix_dims/2,
matrix_sum/2,
matrix_sum_logs_out/3,
matrix_sum_out/3,
matrix_sum_logs_out_several/3,
matrix_op_to_all/4,
matrix_to_exps2/1,
matrix_to_logs/1,
matrix_set_all_that_disagree/5,
matrix_to_list/2,
matrix_agg_lines/3,
matrix_agg_cols/3,
matrix_op_to_lines/4,
matrix_column/3]).
[matrix_new/4,
matrix_new_set/4,
matrix_select/4,
matrix_dims/2,
matrix_size/2,
matrix_shuffle/3,
matrix_expand/3,
matrix_op/4,
matrix_dims/2,
matrix_sum/2,
matrix_sum_logs_out/3,
matrix_sum_out/3,
matrix_sum_logs_out_several/3,
matrix_op_to_all/4,
matrix_to_exps2/1,
matrix_to_logs/1,
matrix_set_all_that_disagree/5,
matrix_to_list/2,
matrix_agg_lines/3,
matrix_agg_cols/3,
matrix_op_to_lines/4,
matrix_column/3
]).
init_CPT(List, Sizes, TAB) :-
matrix_new(floats, Sizes, List, TAB),
@ -84,7 +87,7 @@ evidence(V, Pos) :-
clpbn:get_atts(V, [evidence(Pos)]).
vnth([V1|Deps], N, V, N, Deps) :-
V == V1, !.
V == V1, !.
vnth([V1|Deps], N0, V, N, [V1|NDeps]) :-
N1 is N0+1,
vnth(Deps, N1, V, N, NDeps).
@ -93,21 +96,21 @@ reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
var(Vs), !,
order_vec(Vs0,Vs,Map),
(
Vs == Vs0
Vs == Vs0
->
TF = T0
TF = T0
;
matrix_shuffle(T0,Map,TF)
matrix_shuffle(T0,Map,TF)
),
matrix_dims(TF, Sizes).
reorder_CPT(Vs0,T0,Vs,TF,Sizes) :-
mapping(Vs0,Vs,Map),
(
Vs == Vs0
Vs == Vs0
->
TF = T0
TF = T0
;
matrix_shuffle(T0,Map,TF)
matrix_shuffle(T0,Map,TF)
),
matrix_dims(TF, Sizes).
@ -124,7 +127,7 @@ add_indices([V|Vs0],I0,[V-I0|Is]) :-
get_els([], [], []).
get_els([V-I|NIs], [V|Vs], [I|Map]) :-
get_els(NIs, Vs, Map).
mapping(Vs0,Vs,Map) :-
add_indices(Vs0,0,I1s),
add_indices( Vs,I2s),
@ -167,26 +170,26 @@ expand_tabs([], [], [V2|Deps2], [S2|Sz2], [S2|Map1], [0|Map2], [V2|NDeps]) :-
expand_tabs([V1|Deps1], [S1|Sz1], [V2|Deps2], [S2|Sz2], Map1, Map2, NDeps) :-
compare(C,V1,V2),
(C == = ->
NDeps = [V1|MDeps],
Map1 = [0|M1],
Map2 = [0|M2],
NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, Deps2, Sz2, M1, M2, MDeps)
NDeps = [V1|MDeps],
Map1 = [0|M1],
Map2 = [0|M2],
NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, Deps2, Sz2, M1, M2, MDeps)
;
C == < ->
NDeps = [V1|MDeps],
Map1 = [0|M1],
Map2 = [S1|M2],
NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, [V2|Deps2], [S2|Sz2], M1, M2, MDeps)
;
NDeps = [V2|MDeps],
Map1 = [S2|M1],
Map2 = [0|M2],
NDeps = [V2|MDeps],
expand_tabs([V1|Deps1], [S1|Sz1], Deps2, Sz2, M1, M2, MDeps)
C == < ->
NDeps = [V1|MDeps],
Map1 = [0|M1],
Map2 = [S1|M2],
NDeps = [V1|MDeps],
expand_tabs(Deps1, Sz1, [V2|Deps2], [S2|Sz2], M1, M2, MDeps)
;
NDeps = [V2|MDeps],
Map1 = [S2|M1],
Map2 = [0|M2],
NDeps = [V2|MDeps],
expand_tabs([V1|Deps1], [S1|Sz1], Deps2, Sz2, M1, M2, MDeps)
).
normalise_CPT(MAT,NMAT) :-
matrix_to_exps2(MAT),
matrix_sum(MAT, Sum),
@ -204,9 +207,9 @@ generate_map([V|DimsNew], [V0|Dims0], [0|Map]) :- V == V0, !,
generate_map(DimsNew, Dims0, Map).
generate_map([V|DimsNew], Dims0, [Sz|Map]) :-
clpbn:get_atts(V, [dist(Id,_)]),
clpbn_dist:get_dist_domain_size(Id, Sz),
clpbn_dist:get_dist_domain_size(Id, Sz),
generate_map(DimsNew, Dims0, Map).
unit_CPT(V,CPT) :-
clpbn:get_atts(V, [dist(Id,_)]),
clpbn_dist:get_dist_domain_size(Id, Sz),
@ -284,7 +287,7 @@ uniform_CPT(Dims, M) :-
normalise_possibly_deterministic_CPT(M1, M).
normalise_CPT_on_lines(MAT0, MAT2, L1) :-
matrix_agg_cols(MAT0, +, MAT1),
matrix_agg_cols(MAT0, +, MAT1),
matrix_sum(MAT1, SUM),
matrix_op_to_all(MAT1, /, SUM, MAT2),
matrix:matrix_to_list(MAT2,L1).

25
packages/CLPBN/clpbn/numbers.yap
View File

@ -1,17 +1,17 @@
:- module(clpbn_numbers,
[
keys_to_numbers/7,
keys_to_numbers/9,
lists_of_keys_to_ids/6
]).
[keys_to_numbers/7,
keys_to_numbers/9,
lists_of_keys_to_ids/6
]).
:- use_module(library(bhash)).
:- use_module(library(maplist)).
:- use_module(library(pfl),
[skolem/2,
get_pfl_cpt/5
]).
[skolem/2,
get_pfl_cpt/5
]).
%
% convert key representation into numeric representation
@ -30,16 +30,16 @@ keys_to_numbers(AllKeys, Factors, Evidence, Hash0, Hash4, Id0, Id4, FactorIds, E
foldl2(key_to_id, SKeys, _, Hash3, Hash4, Id3, Id4).
lists_of_keys_to_ids(QueryKeys, QueryIds, Hash0, Hash, Id0, Id) :-
foldl2(list_of_keys_to_ids, QueryKeys, QueryIds, Hash0, Hash, Id0, Id).
foldl2(list_of_keys_to_ids, QueryKeys, QueryIds, Hash0, Hash, Id0, Id).
list_of_keys_to_ids(List, IdList, Hash0, Hash, I0, I) :-
foldl2(key_to_id, List, IdList, Hash0, Hash, I0, I).
key_to_id(Key, Id, Hash0, Hash0, I0, I0) :-
b_hash_lookup(Key, Id, Hash0), !.
b_hash_lookup(Key, Id, Hash0), !.
key_to_id(Key, I0, Hash0, Hash, I0, I) :-
b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1.
b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1.
factor_to_id(Ev, f(_, DistId, Keys), f(Ids, Ranges, CPT, DistId), Hash0, Hash, I0, I) :-
get_pfl_cpt(DistId, Keys, Ev, NKeys, CPT),
@ -60,4 +60,3 @@ evidence_to_id(Key=Ev, I0=Ev, Hash0, Hash, I0, I) :-
b_hash_insert(Hash0, Key, I0, Hash),
I is I0+1.

67
packages/CLPBN/clpbn/pgrammar.yap
View File

@ -2,30 +2,29 @@
:- style_check(all).
:- module(clpbn_pgrammar,[grammar_to_atts/1,
grammar_prob/2,
grammar_mle/2,
init_pcg_solver/4,
run_pcg_solver/3,
pcg_init_graph/0]).
:- module(clpbn_pgrammar,
[grammar_to_atts/1,
grammar_prob/2,
grammar_mle/2,
init_pcg_solver/4,
run_pcg_solver/3,
pcg_init_graph/0
]).
:- load_files([library(clpbn)],
[ if(not_loaded),
silent(true)
]).
[if(not_loaded), silent(true)]).
:- use_module([library(lists)],
[ sum_list/2
]).
[sum_list/2]).
:- use_module([library(matrix)],
[ matrix_new/3,
matrix_add/3,
matrix_get/3,
matrix_op/4,
matrix_op_to_all/4,
matrix_set_all/2
]).
[matrix_new/3,
matrix_add/3,
matrix_get/3,
matrix_op/4,
matrix_op_to_all/4,
matrix_set_all/2
]).
:- op(600, xfy,'::').
@ -71,9 +70,9 @@ grammar_mle(S,_,P) :-
nb_getval(best,p(P,S)), P > 0.0.
user:term_expansion((P::H --> B), Goal) :-
functor(H,A0,_),
% a-->b to a(p(K,P,C,[Cs])) --> b(Cs)
convert_to_internal(H, B, IH, IB, Id),
functor(H,A0,_),
% a-->b to a(p(K,P,C,[Cs])) --> b(Cs)
convert_to_internal(H, B, IH, IB, Id),
expand_term((IH --> IB),(NH :- NB)),
prolog_load_context(module, Mod),
functor(NH,N,A),
@ -99,8 +98,8 @@ add_to_predicate(M:EH1,M:EH,M:H0,NH,NB,Key,Choice,P,Id,(EH1:-NB)) :-
% now ensure_tabled works.
ensure_tabled(M,H0,EH),
assert_static(M:(EH :-
clpbn_pgrammar:p_rule(M,EH,Key,Choice),
M:EH1)),
clpbn_pgrammar:p_rule(M,EH,Key,Choice),
M:EH1)),
Choice = 1,
new_id(Key,P,Choice,Id),
assert_static(M:ptab(EH,Choice,P)),
@ -140,18 +139,18 @@ convert_body_to_internal({A}, {A}) --> !.
convert_body_to_internal(B, IB) -->
[V],
{
B =.. [Na|Args],
build_internal(Na,NaInternal),
IB =.. [NaInternal,V|Args]
B =.. [Na|Args],
build_internal(Na,NaInternal),
IB =.. [NaInternal,V|Args]
}.
new_id(Key,P,Choice,Id) :-
(
predicate_property(id(_,_,_,_),number_of_clauses(Id))
predicate_property(id(_,_,_,_),number_of_clauses(Id))
->
true
true
;
Id = 0
Id = 0
),
assert(id(Id,Key,P,Choice)).
@ -177,7 +176,7 @@ get_internal(S, InternalS, Arg) :-
extract_probability(p(Id,Goals), P) :-
id(Id,_,P0,_),
LogP0 is log(P0),
LogP0 is log(P0),
extract_logprobability(Goals, LogP0, LogP),
P is exp(LogP).
@ -211,11 +210,11 @@ path_choices(InternalS, Proof) :-
new_id(Id) :-
(nb_getval(grammar_id,Id) ->
I1 is Id+1,
nb_setval(grammar_id,I1)
I1 is Id+1,
nb_setval(grammar_id,I1)
;
nb_setval(grammar_id,1),
Id = 0
nb_setval(grammar_id,1),
Id = 0
).
find_dom(K, Vs, Ps) :-

158
packages/CLPBN/clpbn/table.yap
View File

@ -8,49 +8,49 @@
*/
:- module(clpbn_table,
[clpbn_table/1,
clpbn_tableallargs/1,
clpbn_table_nondet/1,
clpbn_tabled_clause/2,
clpbn_tabled_clause_ref/3,
clpbn_tabled_retract/2,
clpbn_tabled_abolish/1,
clpbn_tabled_asserta/1,
clpbn_tabled_assertz/1,
clpbn_tabled_asserta/2,
clpbn_tabled_assertz/2,
clpbn_tabled_dynamic/1,
clpbn_tabled_number_of_clauses/2,
clpbn_reset_tables/0,
clpbn_reset_tables/1,
clpbn_is_tabled/1
]).
[clpbn_table/1,
clpbn_tableallargs/1,
clpbn_table_nondet/1,
clpbn_tabled_clause/2,
clpbn_tabled_clause_ref/3,
clpbn_tabled_retract/2,
clpbn_tabled_abolish/1,
clpbn_tabled_asserta/1,
clpbn_tabled_assertz/1,
clpbn_tabled_asserta/2,
clpbn_tabled_assertz/2,
clpbn_tabled_dynamic/1,
clpbn_tabled_number_of_clauses/2,
clpbn_reset_tables/0,
clpbn_reset_tables/1,
clpbn_is_tabled/1
]).
:- use_module(library(bhash),
[b_hash_new/4,
b_hash_lookup/3,
b_hash_insert/4]).
[b_hash_new/4,
b_hash_lookup/3,
b_hash_insert/4
]).
:- meta_predicate clpbn_table(:),
clpbn_tabled_clause(:.?),
clpbn_tabled_clause_ref(:.?,?),
clpbn_tabled_retract(:),
clpbn_tabled_abolish(:),
clpbn_tabled_asserta(:),
clpbn_tabled_assertz(:),
clpbn_tabled_asserta(:,-),
clpbn_tabled_assertz(:,-),
clpbn_tabled_number_of_clauses(:,-),
clpbn_tabled_asserta(:),
clpbn_tabled_assertz(:),
clpbn_tabled_asserta(:,-),
clpbn_tabled_assertz(:,-),
clpbn_tabled_number_of_clauses(:,-),
clpbn_is_tabled(:).
:- use_module(library(terms), [
instantiated_term_hash/4,
variant/2
]).
:- use_module(library(terms),
[instantiated_term_hash/4,
variant/2
]).
:- use_module(evidence, [
put_evidence/2
]).
:- use_module(evidence,
[put_evidence/2]).
:- dynamic clpbn_table/3.
@ -108,30 +108,28 @@ clpbn_table(F/N,M) :-
L0 = [_|Args0],
IGoal =.. [NF|Args0],
asserta(clpbn_table(S, M, IGoal)),
assert(
(M:S :-
!,
% write(S: ' ' ),
b_getval(clpbn_tables, Tab),
% V2 is unbound.
( b_hash_lookup(Key, V2, Tab) ->
% (attvar(V2) -> writeln(ok:A0:V2) ; writeln(error(V2:should_be_attvar(S)))),
( var(A0) -> A0 = V2 ; put_evidence(A0, V2) )
;
% writeln(new),
b_hash_insert(Tab, Key, V2, NewTab),
b_setval(clpbn_tables,NewTab),
once(M:Goal), !,
% enter evidence after binding.
( var(A0) -> A0 = V2 ; put_evidence(A0, V2) )
;
clpbn:clpbn_flag(solver,none) ->
true
;
throw(error(tabled_clpbn_predicate_should_never_fail,S))
)
)
).
assert((M:S :-
!,
% write(S: ' ' ),
b_getval(clpbn_tables, Tab),
% V2 is unbound.
(b_hash_lookup(Key, V2, Tab) ->
% (attvar(V2) -> writeln(ok:A0:V2) ; writeln(error(V2:should_be_attvar(S)))),
(var(A0) -> A0 = V2 ; put_evidence(A0, V2))
;
% writeln(new),
b_hash_insert(Tab, Key, V2, NewTab),
b_setval(clpbn_tables,NewTab),
once(M:Goal), !,
% enter evidence after binding.
(var(A0) -> A0 = V2 ; put_evidence(A0, V2))
;
clpbn:clpbn_flag(solver,none) ->
true
;
throw(error(tabled_clpbn_predicate_should_never_fail,S))
)
)).
take_tail([V], V, [], V1, [V1]) :- !.
take_tail([A|L0], V, [A|L1], V1, [A|L2]) :-
@ -154,19 +152,17 @@ clpbn_tableallargs(F/N,M) :-
atom_concat(F, '___tabled', NF),
NKey =.. [NF|Args],
asserta(clpbn_table(Key, M, NKey)),
assert(
(M:Key :-
!,
b_getval(clpbn_tables, Tab),
( b_hash_lookup(Key, Out, Tab) ->
true
;
b_hash_insert(Tab, Key, Out, NewTab),
b_setval(clpbn_tables, NewTab),
once(M:NKey)
)
)
).
assert((M:Key :-
!,
b_getval(clpbn_tables, Tab),
(b_hash_lookup(Key, Out, Tab) ->
true
;
b_hash_insert(Tab, Key, Out, NewTab),
b_setval(clpbn_tables, NewTab),
once(M:NKey)
)
)).
clpbn_table_nondet(M:X) :- !,
clpbn_table_nondet(X,M).
@ -185,18 +181,17 @@ clpbn_table_nondet(F/N,M) :-
atom_concat(F, '___tabled', NF),
NKey =.. [NF|Args],
asserta(clpbn_table(Key, M, NKey)),
assert(
(M:Key :- % writeln(in:Key),
b_getval(clpbn_tables, Tab),
( b_hash_lookup(Key, Out, Tab) ->
fail
;
b_hash_insert(Tab, Key, Out, NewTab),
b_setval(clpbn_tables, NewTab),
M:NKey
)
)
).
assert((M:Key :-
% writeln(in:Key),
b_getval(clpbn_tables, Tab),
(b_hash_lookup(Key, Out, Tab) ->
fail
;
b_hash_insert(Tab, Key, Out, NewTab),
b_setval(clpbn_tables, NewTab),
M:NKey
)
)).
user:term_expansion((P :- Gs), NC) :-
clpbn_table(P, M, NP),
@ -364,4 +359,3 @@ clpbn_is_tabled(M:Clause, _) :- !,
clpbn_is_tabled(Head, M) :-
clpbn_table(Head, M, _).

13
packages/CLPBN/clpbn/topsort.yap
View File

@ -1,11 +1,13 @@
:- module(topsort, [topsort/2]).
:- module(topsort,
[topsort/2]).
:- use_module(library(dgraphs),
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertices/3,
dgraph_top_sort/2]).
[dgraph_new/1,
dgraph_add_edges/3,
dgraph_add_vertices/3,
dgraph_top_sort/2
]).
/* simple implementation of a topological sorting algorithm */
/* graph is as Node-[Parents] */
@ -31,4 +33,3 @@ add_edges([], _V) --> [].
add_edges([P|Parents], V) --> [P-V],
add_edges(Parents, V).

35
packages/CLPBN/clpbn/utils.yap
View File

@ -1,9 +1,11 @@
:- module(clpbn_utils, [
clpbn_not_var_member/2,
clpbn_var_member/2,
check_for_hidden_vars/3,
sort_vars_by_key/3,
sort_vars_by_key_and_parents/3]).
:- module(clpbn_utils,
[clpbn_not_var_member/2,
clpbn_var_member/2,
check_for_hidden_vars/3,
sort_vars_by_key/3,
sort_vars_by_key_and_parents/3
]).
%
% It may happen that variables from a previous query may still be around.
@ -52,21 +54,19 @@ get_keys([_|AVars], KeysVars) :- % may be non-CLPBN vars.
merge_same_key([], [], _, []).
merge_same_key([K1-V1,K2-V2|Vs], SortedAVars, Ks, UnifiableVars) :-
K1 == K2, !,
(clpbn:get_atts(V1, [evidence(E)])
->
clpbn:put_atts(V2, [evidence(E)])
(clpbn:get_atts(V1, [evidence(E)]) ->
clpbn:put_atts(V2, [evidence(E)])
;
clpbn:get_atts(V2, [evidence(E)])
->
clpbn:get_atts(V2, [evidence(E)]) ->
clpbn:put_atts(V1, [evidence(E)])
;
true
;
true
),
% V1 = V2,
attributes:fast_unify_attributed(V1,V2),
merge_same_key([K1-V1|Vs], SortedAVars, Ks, UnifiableVars).
merge_same_key([K1-V1,K2-V2|Vs], [V1|SortedAVars], Ks, [K1|UnifiableVars]) :-
(in_keys(K1, Ks) ; \+ \+ K1 == K2), !,
(in_keys(K1, Ks) ; \+ \+ K1 == K2), !,
add_to_keys(K1, Ks, NKs),
merge_same_key([K2-V2|Vs], SortedAVars, NKs, UnifiableVars).
merge_same_key([K-V|Vs], [V|SortedAVars], Ks, UnifiableVars) :-
@ -74,9 +74,9 @@ merge_same_key([K-V|Vs], [V|SortedAVars], Ks, UnifiableVars) :-
merge_same_key(Vs, SortedAVars, NKs, UnifiableVars).
in_keys(K1,[K|_]) :- \+ \+ K1 = K, !.
in_keys(K1,[_|Ks]) :-
in_keys(K1,[_|Ks]) :-
in_keys(K1,Ks).
add_to_keys(K1, Ks, Ks) :- ground(K1), !.
add_to_keys(K1, Ks, [K1|Ks]).
@ -102,7 +102,7 @@ add_parents(Parents,V,Id,KeyVarsF,KeyVars0) :-
all_vars([]).
all_vars([P|Parents]) :-
var(P),
var(P),
all_vars(Parents).
@ -113,4 +113,3 @@ transform_parents([P|Parents0],[P|NParents],KeyVarsF,KeyVars0) :-
transform_parents([P|Parents0],[V|NParents],[P-V|KeyVarsF],KeyVars0) :-
transform_parents(Parents0,NParents,KeyVarsF,KeyVars0).

202
packages/CLPBN/clpbn/ve.yap
View File

@ -11,58 +11,61 @@
all tables they connect to;
multiply their size
order by size
*********************************/
:- module(clpbn_ve, [ve/3,
check_if_ve_done/1,
init_ve_solver/4,
run_ve_solver/3,
init_ve_ground_solver/5,
run_ve_ground_solver/3,
call_ve_ground_solver/6]).
:- module(clpbn_ve,
[ve/3,
check_if_ve_done/1,
init_ve_solver/4,
run_ve_solver/3,
init_ve_ground_solver/5,
run_ve_ground_solver/3,
call_ve_ground_solver/6
]).
:- attribute size/1, all_diffs/1.
:- use_module(library(atts)).
:- use_module(library(ordsets),
[ord_union/3,
ord_member/2]).
[ord_union/3,
ord_member/2
]).
:- use_module(library('clpbn/xbif'), [clpbn2xbif/3]).
:- use_module(library('clpbn/xbif'),
[clpbn2xbif/3]).
:- use_module(library('clpbn/graphviz'), [clpbn2gviz/4]).
:- use_module(library('clpbn/graphviz'),
[clpbn2gviz/4]).
:- use_module(library('clpbn/dists'),
[
dist/4,
get_dist_domain_size/2,
get_dist_params/2,
get_dist_domain_size/2,
get_dist_matrix/5]).
[dist/4,
get_dist_domain_size/2,
get_dist_params/2,
get_dist_domain_size/2,
get_dist_matrix/5
]).
:- use_module(library('clpbn/utils'), [
clpbn_not_var_member/2]).
:- use_module(library('clpbn/utils'),
[clpbn_not_var_member/2]).
:- use_module(library('clpbn/display'), [
clpbn_bind_vals/3]).
:- use_module(library('clpbn/display'),
[clpbn_bind_vals/3]).
:- use_module(library('clpbn/connected'),
[
init_influences/3,
influences/4,
factor_influences/4
]).
[init_influences/3,
influences/4,
factor_influences/4
]).
:- use_module(library(clpbn/matrix_cpt_utils)).
:- use_module(library(clpbn/numbers)).
:- use_module(library(lists),
[
member/2,
append/3,
delete/3
]).
[member/2,
append/3,
delete/3
]).
:- use_module(library(maplist)).
@ -71,7 +74,9 @@
:- use_module(library(clpbn/vmap)).
:- use_module(library('clpbn/aggregates'),
[check_for_agg_vars/2]).
[check_for_agg_vars/2]).
:- attribute size/1, all_diffs/1.
%
% uses a bipartite graph where bigraph(Vs, NFs, Fs)
@ -88,23 +93,23 @@ check_if_ve_done(Var) :-
% new PFL like interface...
%
call_ve_ground_solver(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Solutions),
clpbn_bind_vals([QueryVars], Solutions, Output).
call_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
run_ve_ground_solver(QueryKeys, Solutions, VE).
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
run_ve_ground_solver(QueryKeys, Solutions, VE).
simulate_ve_ground_solver(_QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output).
simulate_ve_ground_solver_for_probabilities([QueryKeys], AllKeys, Factors, Evidence, Output).
simulate_ve_ground_solver_for_probabilities(QueryKeys, AllKeys, Factors, Evidence, Solutions) :-
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
simulate_solver(QueryKeys, Solutions, VE).
init_ve_ground_solver(QueryKeys, AllKeys, Factors, Evidence, VE),
simulate_solver(QueryKeys, Solutions, VE).
init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :-
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE).
keys_to_numbers(AllKeys, Factors, Evidence, Hash4, Id4, FactorIds, EvidenceIds),
init_ve(FactorIds, EvidenceIds, Hash4, Id4, VE).
%
@ -112,11 +117,11 @@ init_ve_ground_solver(_QueryKeys, AllKeys, Factors, Evidence, VE) :-
%
ve([[]],_,_) :- !.
ve(LLVs,Vs0,AllDiffs) :-
init_ve_solver(LLVs, Vs0, AllDiffs, State),
% variable elimination proper
run_ve_solver(LLVs, LLPs, State),
% bind Probs back to variables so that they can be output.
clpbn_bind_vals(LLVs,LLPs,AllDiffs).
init_ve_solver(LLVs, Vs0, AllDiffs, State),
% variable elimination proper
run_ve_solver(LLVs, LLPs, State),
% bind Probs back to variables so that they can be output.
clpbn_bind_vals(LLVs,LLPs,AllDiffs).
init_ve(FactorIds, EvidenceIds, Hash, Id, ve(FactorIds, Hash, Id, Ev)) :-
@ -129,7 +134,7 @@ evtotree(K=V,Ev0,Ev) :-
factor_to_graph( f(Nodes, Sizes, _Pars0, Id), Factors0, Factors, Edges0, Edges, I0, I) :-
I is I0+1,
pfl:get_pfl_parameters(Id, Pars0),
init_CPT(Pars0, Sizes, CPT0),
init_CPT(Pars0, Sizes, CPT0),
reorder_CPT(Nodes, CPT0, FIPs, CPT, _),
F = f(I0, FIPs, CPT),
rb_insert(Factors0, I0, F, Factors),
@ -172,7 +177,7 @@ vars_to_bigraph(VMap, bigraph(VInfo, IF, Fs), Evs) :-
id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
% process evidence for variable
clpbn:get_atts(V, [evidence(E), dist(_,Ps)]),
clpbn:get_atts(V, [evidence(E), dist(_,Ps)]),
checklist(noparent_of_interest(VMap), Ps), !,
% I don't need to get a factor here
Evs = [I=E|Evs0],
@ -181,17 +186,17 @@ id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
id_to_factor(VMap, V-I, IF0, IF, Fs0, Fs, Evs0, Evs) :-
% process distribution/factors
(
clpbn:get_atts(V, [evidence(E)])
->
Evs = [I=E|Evs0]
clpbn:get_atts(V, [evidence(E)])
->
Evs = [I=E|Evs0]
;
Evs = Evs0
),
Evs = Evs0
),
clpbn:get_atts(V, [dist(D, Ps)]),
get_dist_params(D, Pars0),
get_dist_domain_size(D, DS),
maplist(parent_to_id(VMap), Ps, Sizes, IPs),
init_CPT(Pars0, [DS|Sizes], CPT0),
init_CPT(Pars0, [DS|Sizes], CPT0),
reorder_CPT([I|IPs], CPT0, FIPs, CPT, _),
rb_insert(Fs0, IF0, f(IF0, FIPs, CPT), Fs),
IF is IF0+1.
@ -239,29 +244,29 @@ collect_factors(SFVs, _Fs, _V, [], SFVs).
% solve each query independently
% use a findall to recover space without needing for GC
run_ve_ground_solver(LQVs, LLPs, ve(FactorIds, Hash, Id, Ev)) :-
rb_new(Fs0),
foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF),
sort(FVs, SFVs),
rb_new(VInfo0),
add_vs(SFVs, Fs, VInfo0, VInfo),
BG = bigraph(VInfo, IF, Fs),
lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _),
findall(LPs, solve(LQIds, FactorIds, BG, Ev, LPs), LLPs).
rb_new(Fs0),
foldl3(factor_to_graph, FactorIds, Fs0, Fs, [], FVs, 0, IF),
sort(FVs, SFVs),
rb_new(VInfo0),
add_vs(SFVs, Fs, VInfo0, VInfo),
BG = bigraph(VInfo, IF, Fs),
lists_of_keys_to_ids(LQVs, LQIds, Hash, _, Id, _),
findall(LPs, solve(LQIds, FactorIds, BG, Ev, LPs), LLPs).
solve([QVs|_], FIds, Bigraph, Evs, LPs) :-
factor_influences(FIds, QVs, Evs, LVs),
do_solve(QVs, LVs, Bigraph, Evs, LPs).
factor_influences(FIds, QVs, Evs, LVs),
do_solve(QVs, LVs, Bigraph, Evs, LPs).
solve([_|LQVs], FIds, Bigraph, Ev, LPs) :-
solve(LQVs, FIds, Bigraph, Ev, LPs).
solve(LQVs, FIds, Bigraph, Ev, LPs).
do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :-
% get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence
rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate
eliminate(IQVs, digraph(EVs, IF, Fs2), Dist),
% get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence
rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate
eliminate(IQVs, digraph(EVs, IF, Fs2), Dist),
% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
%exps(LD,LDE),writeln(LDE),
% move from potentials back to probabilities
@ -269,18 +274,18 @@ do_solve(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Ps) :-
list_from_CPT(MPs, Ps).
simulate_solver(LQVs, Choices, ve(FIds, Hash, Id, BG, Evs)) :-
lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _),
factor_influences(FIds, QVs, Evs, LVs),
do_simulate(QVs, LVs, BG, Evs, Choices).
lists_of_keys_to_ids(LQVs, [QVs], Hash, _, Id, _),
factor_influences(FIds, QVs, Evs, LVs),
do_simulate(QVs, LVs, BG, Evs, Choices).
do_simulate(IQVs, IVs, bigraph(OldVs, IF, _Fs), Ev, Choices) :-
% get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence
rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate
simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices).
% get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence
rb_visit(Ev, EvL),
foldl2(clean_v_ev, EvL, Fs1, Fs2, SVs, EVs),
% eliminate
simulate_eiminate(IQVs, digraph(EVs, IF, Fs2), Choices).
% solve each query independently
% use a findall to recover space without needing for GC
@ -295,9 +300,9 @@ run_ve_solver(_, LLPs, state(LQVs, LVs, _VMap, Bigraph, Ev)) :-
%
solve_ve([IQVs|_], [IVs|_], bigraph(OldVs, IF, _Fs), Ev, Ps) :-
% get only what is relevant to query,
project_to_query_related(IVs, OldVs, SVs, Fs1),
project_to_query_related(IVs, OldVs, SVs, Fs1),
% and also prune using evidence
foldl2(clean_v_ev, Ev, Fs1, Fs2, SVs, EVs),
foldl2(clean_v_ev, Ev, Fs1, Fs2, SVs, EVs),
% eliminate
eliminate(IQVs, digraph(EVs, IF, Fs2), Dist),
% writeln(m:Dist),matrix:matrix_to_list(Dist,LD),writeln(LD),
@ -314,7 +319,7 @@ solve_ve([_|MoreLVs], [_|MoreLVis], Digraph, Ev, Ps) :-
project_to_query_related(IVs0, OldVs, NVs, NFs) :-
sort(IVs0, IVs),
rb_new(Vs0),
foldl(cp_to_vs, IVs, Vs0, AuxVs),
foldl(cp_to_vs, IVs, Vs0, AuxVs),
rb_new(NFs0),
foldl(simplify_graph_node(OldVs, AuxVs), IVs, VFs, NFs0, NFs),
list_to_rbtree(VFs, NVs).
@ -338,31 +343,31 @@ simplify_graph_node(OldVs, NVs, V, V-RemFs, NFs0, NFs) :-
%
% Two cases: first time factor comes up: all its vars must be in subgraph
% second case: second time it comes up, it must be already in graph
%
% args: +Factor F, +current V (int), +rbtree with all Vs,
%
% args: +Factor F, +current V (int), +rbtree with all Vs,
% -Factors in new Graph, +factors in current graph, -rbtree of factors
%
%
check_factor(V, NVs, F, NFs0, NFs, RemFs, NewRemFs) :-
F = f(IF, [V|More], _), !,
(
(
checklist(check_v(NVs), More)
->
rb_insert(NFs0, IF, F, NFs),
NewRemFs = [F|RemFs]
;
;
NFs0 = NFs,
NewRemFs = RemFs
).
).
check_factor(_V, _NVs, F, NFs, NFs, RemFs, NewRemFs) :-
F = f(Id, _, _),
(
(
rb_lookup(Id, F, NFs)
->
NewRemFs = [F|RemFs]
;
;
NewRemFs = RemFs
).
).
check_v(NVs, V) :-
rb_lookup(V, _, NVs).
@ -425,15 +430,15 @@ best_var(QVs, I, _Node, Info, Info) :-
!.
% pick the variable with less factors
best_var(_Qs, I, Node, i(ValSoFar,_,_), i(NewVal,I,Node)) :-
foldl(szfac,Node,1,NewVal),
foldl(szfac,Node,1,NewVal),
%length(Node, NewVal),
NewVal < ValSoFar,
!.
best_var(_, _I, _Node, Info, Info).
szfac(f(_,Vs,_), I0, I) :-
length(Vs,L),
I is I0*L.
length(Vs,L),
I is I0*L.
% delete one factor, need to also touch all variables
del_fac(f(I,FVs,_), Fs0, Fs, Vs0, Vs) :-
@ -472,4 +477,3 @@ multiply([F0|Fs], Vs, T) :-
multiply_factor(f(_,Vs1,T1), f(_,Vs0,T0), f(_,Vs,T)) :-
multiply_CPTs(T1, Vs1, T0, Vs0, T, Vs).

74
packages/CLPBN/clpbn/viterbi.yap
View File

@ -1,11 +1,13 @@
%:- style_check(all).
:- module(viterbi, [viterbi/4]).
:- module(viterbi,
[viterbi/4]).
:- use_module(library(lists),
[nth/3,
member/2]).
[nth/3,
member/2
]).
:- use_module(library(assoc)).
@ -17,8 +19,8 @@
:- ensure_loaded(library('clpbn/hmm')).
:- use_module(library('clpbn/dists'), [
get_dist_params/2]).
:- use_module(library('clpbn/dists'),
[get_dist_params/2]).
:- meta_predicate viterbi(:,:,+,-).
@ -75,21 +77,21 @@ fetch_edges([V|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
clpbn:get_atts(V,[key(Key)]),
abstract_key(Key, AKey, Slice),
(
Slice < 3
Slice < 3
->
EdgesF = [Key0-AKey|EdgesI]
EdgesF = [Key0-AKey|EdgesI]
;
EdgesF = EdgesI
EdgesF = EdgesI
),
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
fetch_edges([Key|Parents], Key0, EdgesF, Edges0, [Slice-AKey|PKeys]) :-
abstract_key(Key, AKey, Slice),
(
Slice < 3
Slice < 3
->
EdgesF = [Key0-AKey|EdgesI]
EdgesF = [Key0-AKey|EdgesI]
;
EdgesF = EdgesI
EdgesF = EdgesI
),
fetch_edges(Parents, Key0, EdgesI, Edges0, PKeys).
fetch_edges([], _, Edges, Edges, []).
@ -122,20 +124,20 @@ compile_keys([], _, []).
% add a random symbol to the end.
compile_emission([],_) --> !, [].
compile_emission(EmissionTerm,IKey) --> [emit(IKey,EmissionTerm)].
compile_propagation([],[],_,_) --> [].
compile_propagation([0-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
[prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
compile_propagation([2-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
[prop_same(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
compile_propagation([3-PKey|Ps], [Prob|Probs], IKey, KeyMap) -->
[prop_next(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
[prop_next(IKey,Parent,Prob)],
{ get_assoc(PKey,KeyMap,nodeinfo(Parent,_,_,_)) },
compile_propagation(Ps, Probs, IKey, KeyMap).
get_id(_:S, Map, SI) :- !,
get_id(S, Map, SI).
@ -148,9 +150,9 @@ get_id(S, Map, SI) :-
compile_trace(Trace, Emissions) :-
user:hmm_domain(Domain),
(atom(Domain) ->
hmm:cvt_vals(Domain, Vals)
hmm:cvt_vals(Domain, Vals)
;
Vals = Domain
Vals = Domain
),
compile_trace(Trace, Vals, Emissions).
@ -192,22 +194,22 @@ run_inst(prop_same(I,P,Prob), _, SP, Current, _, Trace) :-
NP is PI+Prob,
matrix_get(Current, [P], P0),
(NP > P0 ->
matrix_set(Current, [P], NP),
matrix_set(Trace, [SP,P], I)
matrix_set(Current, [P], NP),
matrix_set(Trace, [SP,P], I)
;
true
true
).
run_inst(prop_next(I,P,Prob), _, SP, Current, Next, Trace) :-
matrix_get(Current, [I], PI),
NP is PI+Prob,
matrix_get(Next, [P], P0),
(NP > P0 ->
matrix_set(Next, [P], NP),
SP1 is SP+1,
IN is -I,
matrix_set(Trace, [SP1,P], IN)
matrix_set(Next, [P], NP),
SP1 is SP+1,
IN is -I,
matrix_set(Trace, [SP1,P], IN)
;
true
true
).
backtrace(Dump, EI, Map, L, Trace) :-
@ -219,11 +221,11 @@ backtrace(Dump, EI, Map, L, Trace) :-
trace(0,0,_,_,Trace,Trace) :- !.
trace(L1,Next,Dump,Map,Trace0,Trace) :-
(Next < 0 ->
NL is L1-1,
P is -Next
NL is L1-1,
P is -Next
;
NL = L1,
P = Next
NL = L1,
P = Next
),
once(member(P-AKey,Map)),
AKey=..[N|Args],
@ -231,5 +233,3 @@ trace(L1,Next,Dump,Map,Trace0,Trace) :-
matrix_get(Dump,[NL,P],New),
trace(NL,New,Dump,Map,[Key|Trace0],Trace).

22
packages/CLPBN/clpbn/vmap.yap
View File

@ -1,23 +1,22 @@
:- module(clpbn_vmap,
[
init_vmap/1, % init_vmap(-Vmap)
add_to_vmap/4, % add_to_vmap(+V,-I,+VMap0,VMapF)
get_from_vmap/3, % add_to_vmap(+V,-I,+VMap0)
vars_to_numbers/4, % vars_to_numbers(+Vs,-Is,+VMap0,VMapF)
lvars_to_numbers/4, % lvars_to_numbers(+LVs,-LIs,+VMap0,VMapF)
vmap_to_list/2
]).
[init_vmap/1, % init_vmap(-Vmap)
add_to_vmap/4, % add_to_vmap(+V,-I,+VMap0,VMapF)
get_from_vmap/3, % add_to_vmap(+V,-I,+VMap0)
vars_to_numbers/4, % vars_to_numbers(+Vs,-Is,+VMap0,VMapF)
lvars_to_numbers/4, % lvars_to_numbers(+LVs,-LIs,+VMap0,VMapF)
vmap_to_list/2
]).
:- use_module(library(rbtrees)).
:- use_module(library(maplist)).
%
% vmap: map V->I
% vmap: map V->I
% contiguous Vs to contiguous integers
%
init_vmap(vmap(0,Empty)) :-
rb_new(Empty).
rb_new(Empty).
get_from_vmap(V, I, VMap0) :-
VMap0 = vmap(_I,Map0),
@ -39,6 +38,3 @@ lvars_to_numbers(LVs, LIs, VMap0, VMap) :-
vmap_to_list(vmap(_,Map), L) :-
rb_visit(Map, L).

7
packages/CLPBN/clpbn/xbif.yap
View File

@ -2,10 +2,11 @@
% XMLBIF support for CLP(BN)
%
:- module(xbif, [clpbn2xbif/3]).
:- module(xbif,
[clpbn2xbif/3]).
:- use_module(library('clpbn/dists'), [
get_dist_domain/2]).
:- use_module(library('clpbn/dists'),
[get_dist_domain/2]).
clpbn2xbif(Stream, Name, Network) :-
format(Stream, '<?xml version="1.0" encoding="US-ASCII"?>

10
packages/CLPBN/examples/HMMer/fasta.yap
View File

@ -5,7 +5,10 @@
% support for a single sequence.
%
:- module(fasta, [fa2atoms/2,fa2atoms/3]).
:- module(fasta,
[fa2atoms/2,
fa2atoms/3
]).
fa2atoms(F, L) :-
fa2atoms(F, L, []).
@ -25,8 +28,8 @@ read_chars(10,S) --> !,
read_chars(C,S) -->
[AC],
{
cvt_c(C,AC),
get0(S,MC)
cvt_c(C,AC),
get0(S,MC)
},
read_chars(MC, S).
@ -44,4 +47,3 @@ skip_header(_,S) :-
skip_header(C,S).

6
packages/CLPBN/examples/HMMer/globin.yap
View File

@ -32,9 +32,9 @@ g_f_cpt(-8455,1.0,0.00284964910984409).
%Null state emission CPT.
nule_cpt(
e(595,-1558,85,338,-294,453,-1158,197,249,902,-1085,-142,-21,-313,45,531,201,384,-1998,-644),
0.05,
e(0.0755236292781413,0.0169810785568618,0.0530343870684108,0.0632001549226403,0.0407818746669505,0.0684441906545919,0.0224066674892351,0.0573156092864189,0.0594191552528466,0.093432734688318,0.023569613397956,0.0453130969133667,0.0492774668469685,0.0402483068810561,0.051584158965068,0.0722465198961763,0.0574747424017338,0.0652477473844479,0.0125173406963917,0.0319968103461077)).
e(595,-1558,85,338,-294,453,-1158,197,249,902,-1085,-142,-21,-313,45,531,201,384,-1998,-644),
0.05,
e(0.0755236292781413,0.0169810785568618,0.0530343870684108,0.0632001549226403,0.0407818746669505,0.0684441906545919,0.0224066674892351,0.0573156092864189,0.0594191552528466,0.093432734688318,0.023569613397956,0.0453130969133667,0.0492774668469685,0.0402483068810561,0.051584158965068,0.0722465198961763,0.0574747424017338,0.0652477473844479,0.0125173406963917,0.0319968103461077)).
%Reaching first D.
b_d_cpt(-110,-3765,-110).

19
packages/CLPBN/examples/HMMer/scan.yap
View File

@ -14,7 +14,7 @@ stop(S,W,Info) :-
gen_program(W, Info).
stop(_,_,_) :-
format(user_error,"Bad HMM~n", []).
parse_model(S,Info) :-
get_line(S, Line, Info),
% format('~s~n',[Line]),
@ -45,7 +45,7 @@ match_field(hmmer(_,_,_,Alph,_,_,_,_),_) --> "ALPH", !, % aminos or bases
match_field(_,_) --> "RF", !, scanner_skip.
match_field(_,_) --> "CS", !, scanner_skip.
match_field(hmmer(_,_,_,_,_,_,_,MAP),_) --> "MAP", !,
scanner_skip_blanks,
scanner_skip_blanks,
to_lower(Codes),
{ map_code(Codes,MAP) }.
match_field(_,_) --> "COM", !, scanner_skip.
@ -76,11 +76,11 @@ match_field(_,_) --> "EVD", !,
match_field(Info,S) --> "HMM", !,
scanner_skip,
{
get_line(S,_,Info),
Info = hmmer(_,_,NOfStates,Alph,_,_,model(BD,NBD,Transitions),MAP),
nof_symbols(Alph,N),
scan_model(S,NOfStates,N,BD,NBD,Transitions,MAP,Info),
throw(done(Info))
get_line(S,_,Info),
Info = hmmer(_,_,NOfStates,Alph,_,_,model(BD,NBD,Transitions),MAP),
nof_symbols(Alph,N),
scan_model(S,NOfStates,N,BD,NBD,Transitions,MAP,Info),
throw(done(Info))
}.
scan_model(S,NOfStates,N,BD,NBD,Transitions,MAP,Info) :-
@ -95,7 +95,7 @@ scan_states(NOfStates, N, Stream, MAP, [t(E,I,S)|Transitions], Info) :-
scan_states(NOfStates1, N, Stream, NMAP, Transitions, Info).
scan_state(Stream, E,I,MAP,s(MM,MI,MD,IM,II,DM,DD,BM,ME), N, NMAP, Info) :-
get_line(Stream, ELine, Info),
get_line(Stream, ELine, Info),
get_line(Stream, ILine, Info),
get_line(Stream, SLine, Info),
% format('~s~n~s~n~s~n',[ELine,ILine,SLine]),
@ -265,7 +265,7 @@ gen_model(W, model(BD,NBD,States),PsCPT) :-
format(W, '~n%Reaching first D.~n',[]),
format(W, 'b_d_cpt(~w,~w,~w).~n',[BD,NBD,BDCPT]),
gen_states(W, States,1,PsCPT).
gen_states(_, [],_,_).
gen_states(W, [State|States],StateNo,PsCPT) :-
gen_state(W, State,StateNo,PsCPT),
@ -327,4 +327,3 @@ max_index([_|L],I0,Max0,MaxIndex0,Max,MaxIndex) :-
I is I0+1,
max_index(L,I,Max0,MaxIndex0,Max,MaxIndex).

9
packages/CLPBN/examples/HMMer/score.yap
View File

@ -6,13 +6,12 @@
:- ensure_loaded(library('clpbn/viterbi')).
:- use_module(fasta,
[fa2atoms/3]).
[fa2atoms/3]).
:- use_module(library(lists),
[
nth/3,
append/3
]).
[nth/3,
append/3
]).
:- [plan7].

16
packages/CLPBN/examples/School/README
View File

@ -1,19 +1,15 @@
This is a version of the school database, based on the PRM School example.
There are four main files:
There are the following main files:
school_128.yap: a school with 128 professors, 256 courses and 4096 students.
school_64.yap: medium size school
school_32.yap: small school (CLP(BN))
school_32.yap: school with 32 professors, 64 courses and 256 students
school_64.yap: school with 64 professors, 128 courses and 1024 students
school_128.yap: school with 128 professors, 256 courses and 4096 students
sch32.yap: small school (PFL)
parschema.pfl: the PFL schema
parschema.pfl: the PFL schema
schema.yap: the CLP(BN) schema
tables: CPTs
tables: CPTs
=============================================================================

2
packages/CLPBN/examples/School/parlearn.yap
View File

@ -41,4 +41,4 @@ write_cpts([CPT|CPTs]) :-
matrix_to_list(CPT,L),
format('CPT=~w~n',[L]),
write_cpts(CPTs).

2
packages/CLPBN/examples/School/parschema.pfl
View File

@ -55,7 +55,7 @@ professor_popularity(P,A) :- pop(P,A).
course_difficulty(P,A) :- diff(P,A).
student_intelligence(P,A) :- int(P,A).
course_rating(C,X) :- rat(C,X).
registration_grade(R,A) :-

25
packages/CLPBN/examples/School/sch32.yap
View File

@ -1,25 +0,0 @@
/*
total_professors(32).
total_courses(64).
total_students(256).
*/
:- use_module(library(pfl)).
:- source.
:- style_check(all).
:- yap_flag(unknown,error).
:- yap_flag(write_strings,on).
:- ensure_loaded('parschema.pfl').
:- ensure_loaded(school32_data).
:- set_solver(hve).

68
packages/CLPBN/examples/School/schema.yap
View File

@ -1,68 +0,0 @@
/* Base file for school database. Supposed to be called from school_*.yap */
professor_key(Key) :-
professor(Key).
professor_ability(Key,Abi) :-
abi_table(Key, AbiDist),
{ Abi = ability(Key) with p([h,m,l], AbiDist) }.
professor_popularity(Key, Pop) :-
professor_ability(Key, Abi),
pop_table(Key,PopTable),
{ Pop = popularity(Key) with
p([h,m,l], PopTable,[Abi]) }.
registration_key(Key) :-
registration(Key, _, _).
registration_course(Key, CKey) :-
registration(Key, CKey, _).
registration_student(Key, SKey) :-
registration(Key, _, SKey).
registration_grade(Key, Grade) :-
registration(Key, CKey, SKey),
course_difficulty(CKey, Dif),
student_intelligence(SKey, Int),
grade_table(Int, Dif, Table),
{ Grade = grade(Key) with Table }.
% registration_satisfaction(r0, h) :- {}.
registration_satisfaction(Key, Sat) :-
registration_course(Key, CKey),
course_professor(CKey, PKey),
professor_ability(PKey, Abi),
registration_grade(Key, Grade),
satisfaction_table(Abi, Grade, Table),
{ Sat = satisfaction(Key) with Table }.
course_key(Key) :-
course(Key,_).
course_professor(Key, PKey) :-
course(Key, PKey).
course_rating(CKey, Rat) :-
setof(Sat, RKey^(registration_course(RKey,CKey), registration_satisfaction(RKey,Sat)), Sats),
{ Rat = rating(CKey) with avg([h,m,l],Sats) }.
course_difficulty(Key, Dif) :-
dif_table(Key, Dist),
{ Dif = difficulty(Key) with p([h,m,l], Dist) }.
student_key(Key) :-
student(Key).
student_intelligence(Key, Int) :-
int_table(Key, IDist, Domain),
{ Int = intelligence(Key) with p(Domain, IDist) }.
student_ranking(Key, Rank) :-
setof(Grade, CKey^(registration_student(CKey,Key),
registration_grade(CKey, Grade)), Grades),
{ Rank = ranking(Key) with avg([a,b,c,d],Grades) }.
:- ensure_loaded(tables).

1217
packages/CLPBN/examples/School/school32_data.yap
View File

File diff suppressed because it is too large Load Diff

9
packages/CLPBN/examples/School/school_128.yap
View File

@ -4,9 +4,10 @@ total_professors(128).
total_courses(256).
total_students(4096).
*/
:- use_module(library(pfl)).
:- source.
:- style_check(all).
@ -15,9 +16,7 @@ total_students(4096).
:- yap_flag(write_strings,on).
:- use_module(library(clpbn)).
:- [-schema].
:- ensure_loaded('parschema.pfl').
professor(p0).
professor(p1).
@ -18428,5 +18427,5 @@ registration(r13919,c221,s4095).
registration(r13920,c39,s4095).
:- [evidence_128].
:- [evidence_128].

1221
packages/CLPBN/examples/School/school_32.yap
View File

File diff suppressed because it is too large Load Diff

7
packages/CLPBN/examples/School/school_64.yap
View File

@ -4,9 +4,10 @@ total_professors(64).
total_courses(128).
total_students(1024).
*/
:- use_module(library(pfl)).
:- source.
:- style_check(all).
@ -15,9 +16,7 @@ total_students(1024).
:- yap_flag(write_strings,on).
:- use_module(library(clpbn)).
:- [-schema].
:- ensure_loaded('parschema.pfl').
professor(p0).
professor(p1).

27
packages/CLPBN/examples/School/tables.yap
View File

@ -1,33 +1,26 @@
/* CTPs for school database. */
abi_table(
/* h */ [ 0.50,
/* m */ 0.40,
/* l */ 0.10 ]).
abi_table(_, T) :- abi_table(T).
pop_table(
/* h m l */
/* h */ [ 0.9, 0.2, 0.01,
/* m */ 0.09, 0.6, 0.09,
/* l */ 0.01, 0.2, 0.9 ]).
pop_table(_, T) :- pop_table(T).
diff_table(
/* h */ [ 0.25,
/* m */ 0.50,
/* l */ 0.25 ]).
dif_table(_, T) :- diff_table(T).
int_table(
/* h */ [ 0.5,
/* m */ 0.4,
/* l */ 0.1 ]).
int_table(_,T ,[h,m,l]) :- int_table(T).
grade_table(
/* h h h m h l m h m m m l l h l m l l */
/* a */ [ 0.2, 0.7, 0.85, 0.1, 0.2, 0.5, 0.01, 0.05, 0.1,
@ -35,27 +28,9 @@ grade_table(
/* c */ 0.15, 0.04, 0.02, 0.4, 0.15, 0.12, 0.5, 0.6, 0.4,
/* d */ 0.05, 0.01, 0.01, 0.2, 0.05, 0.03, 0.45, 0.2, 0.1 ]).
grade_table(I, D,
p([a,b,c,d], T, [I,D])) :- grade_table(T).
sat_table(
/* h a h b h c h d m a m b m c m d l a l b l c l d */
/* h */ [ 0.98, 0.9, 0.8 , 0.6, 0.9, 0.4, 0.2, 0.01, 0.5, 0.2, 0.01, 0.01,
/* m */ 0.01, 0.09, 0.15, 0.3, 0.05, 0.4, 0.3, 0.04, 0.35, 0.3, 0.09, 0.01,
/* l */ 0.01, 0.01, 0.05, 0.1, 0.05, 0.2, 0.5, 0.95, 0.15, 0.5, 0.9, 0.98 ]).
satisfaction_table(A, G, p([h,m,l], T, [A,G])) :- sat_table(T).
% The idea is quite simple:
% hs = h -> r = ( 0.9, 0.1, 0)
% hs = m -> r = ( 0.2, 0.6, 0.2)
% hs = l -> r = ( 0, 0.1, 0.9)
%
% add all and divide on the number of elements on the table!
%
rating_prob_table(
[ 0.9, 0.05, 0.01,
0.09, 0.9, 0.09,
0.01, 0.05, 0.9 ]).

24
packages/CLPBN/examples/burglary-alarm.uai
View File

@ -1,28 +1,26 @@
MARKOV
BAYES
5
2 2 2 2 2
5
1 0
1 1
3 2 0 1
2 3 2
2 4 2
3 0 1 2
2 2 3
2 2 4
2
.001 .999
0.001 0.999
2
.002 .998
0.002 0.998
8
.95 .94 .29 .001
.05 .06 .71 .999
0.95 0.05 0.94 0.06 0.29 0.71 0.001 0.999
4
.9 .05
.1 .95
0.9 0.1 0.05 0.95
4
.7 .01
.3 .99
0.7 0.3 0.01 0.99

35
packages/CLPBN/examples/cg.yap
View File

@ -1,35 +0,0 @@
%
% adapted from Hendrik Blockeel's ILP04 paper.
%
:- use_module(library(clpbn)).
cg(X,1,C):-
father(Y,X),
cg(Y,1,C1),cg(Y,2,C2),
parent_cpt(cg(X,1), C1, C2, C).
cg(X,2,C):-
mother(Y,X),
cg(Y,1,C1),cg(Y,2,C2),
parent_cpt(cg(X,2), C1, C2, C).
cg(f,X,C) :-
prior_cpt(cg(f,X),C).
cg(m,X,C) :-
prior_cpt(cg(m,X),C).
prior_cpt(CKEY, C) :-
{ C = CKEY with p([p,w], [0.5,0.5])}.
parent_cpt(CKEY, C1, C2, C) :-
{ C = CKEY with p([p,w], [ 1,0.5,0.5,0.0,
0.0,0.5,0.5, 1],[C1,C2])}.
father(f,s).
mother(m,s).

98
packages/CLPBN/examples/city.pfl
View File

@ -1,3 +1,8 @@
/*
Model from the paper "First-order
probabilistic inference"
*/
:- use_module(library(pfl)).
:- set_solver(hve).
@ -11,14 +16,14 @@
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile people/2.
:- multifile person/2.
:- multifile ev/1.
people(joe,nyc).
people(p2, nyc).
people(p3, nyc).
people(p4, nyc).
people(p5, nyc).
person(joe,nyc).
person(p2, nyc).
person(p3, nyc).
person(p4, nyc).
person(p5, nyc).
ev(descn(p2, fits)).
ev(descn(p3, fits)).
@ -26,85 +31,80 @@ ev(descn(p4, fits)).
ev(descn(p5, fits)).
bayes city_conservativeness(C)::[high,low] ;
cons_table(C) ;
[people(_,C)].
cons_table ;
[person(_,C)].
bayes gender(P)::[male,female] ;
gender_table(P) ;
[people(P,_)].
gender_table ;
[person(P,_)].
bayes hair_color(P)::[dark,bright], city_conservativeness(C) ;
hair_color_table(P) ;
[people(P,C)].
hair_color_table ;
[person(P,C)].
bayes car_color(P)::[dark,bright], hair_color(P) ;
car_color_table(P) ;
[people(P,_)].
car_color_table ;
[person(P,_)].
bayes height(P)::[tall,short], gender(P) ;
height_table(P) ;
[people(P,_)].
height_table ;
[person(P,_)].
bayes shoe_size(P)::[big,small], height(P) ;
shoe_size_table(P) ;
[people(P,_)].
shoe_size_table ;
[person(P,_)].
bayes guilty(P)::[y,n] ;
guilty_table(P) ;
[people(P,_)].
guilty_table ;
[person(P,_)].
bayes descn(P)::[fits,dont_fit], car_color(P),
hair_color(P), height(P), guilty(P) ;
descn_table(P) ;
[people(P,_)].
hair_color(P), height(P), guilty(P) ;
descn_table ;
[person(P,_)].
bayes witness(C), descn(Joe), descn(P2) ;
witness_table ;
[people(_,C), Joe=joe, P2=p2].
witness_table ;
[person(_,C), Joe=joe, P2=p2].
cons_table(amsterdam,
% special case for amsterdam: amsterdam is
% less conservative than other cities (is it?)
/* y */ [ 0.2,
/* n */ 0.8 ]) :- !. % FIXME
cons_table(_,
cons_table(
/* y */ [ 0.8,
/* n */ 0.2 ]).
gender_table(_,
gender_table(
/* male */ [ 0.55,
/* female */ 0.45 ]).
hair_color_table(_,
hair_color_table(
/* high low */
/* dark */ [ 0.05, 0.1,
/* bright */ 0.95, 0.9 ]).
car_color_table(_,
car_color_table(
/* dark bright */
/* dark */ [ 0.9, 0.2,
/* bright */ 0.1, 0.8 ]).
height_table(_,
height_table(
/* male female */
/* tall */ [ 0.6, 0.4,
/* short */ 0.4, 0.6 ]).
shoe_size_table(_,
shoe_size_table(
/* tall short */
/* big */ [ 0.9, 0.1,
/* small */ 0.1, 0.9 ]).
guilty_table(_,
guilty_table(
/* yes */ [ 0.23,
/* no */ 0.77 ]).
descn_table(_,
descn_table(
/* car_color(P), hair_color(P), height(P), guilty(P) */
/* fits */ [ 0.99, 0.5, 0.23, 0.88, 0.41, 0.3, 0.76, 0.87,
/* fits */ 0.44, 0.43, 0.29, 0.72, 0.23, 0.91, 0.95, 0.92,
/* dont_fit */ 0.01, 0.5, 0.77, 0.12, 0.59, 0.7, 0.24, 0.13,
/* dont_fit */ 0.01, 0.5, 0.77, 0.12, 0.59, 0.7, 0.24, 0.13,
/* dont_fit */ 0.56, 0.57, 0.71, 0.28, 0.77, 0.09, 0.05, 0.08 ]).
witness_table(
@ -114,20 +114,20 @@ witness_table(
runall(G, Wrapper) :-
findall(G, Wrapper, L),
execute_all(L).
findall(G, Wrapper, L),
execute_all(L).
execute_all([]).
execute_all(G.L) :-
call(G),
execute_all(L).
call(G),
execute_all(L).
is_joe_guilty(Guilty) :-
witness(nyc, t),
runall(X, ev(X)),
guilty(joe, Guilty).
witness(nyc, t),
runall(X, ev(X)),
guilty(joe, Guilty).
% ?- is_joe_guilty(Guilty).

47
packages/CLPBN/examples/comp_workshops.pfl
View File

@ -1,3 +1,8 @@
/*
Model from the paper "Lifted Probabilistic
Inference with Counting Formulas"
*/
:- use_module(library(pfl)).
:- set_solver(hve).
@ -10,31 +15,31 @@
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile c/2.
:- multifile reg/2.
c(p1,w1).
c(p1,w2).
c(p1,w3).
c(p2,w1).
c(p2,w2).
c(p2,w3).
c(p3,w1).
c(p3,w2).
c(p3,w3).
c(p4,w1).
c(p4,w2).
c(p4,w3).
c(p5,w1).
c(p5,w2).
c(p5,w3).
reg(p1,w1).
reg(p1,w2).
reg(p1,w3).
reg(p2,w1).
reg(p2,w2).
reg(p2,w3).
reg(p3,w1).
reg(p3,w2).
reg(p3,w3).
reg(p4,w1).
reg(p4,w2).
reg(p4,w3).
reg(p5,w1).
reg(p5,w2).
reg(p5,w3).
markov attends(P), hot(W) ;
[0.2, 0.8, 0.8, 0.8] ;
[c(P,W)].
[0.2, 0.8, 0.8, 0.8] ;
[reg(P,W)].
markov attends(P), series ;
[0.501, 0.499, 0.499, 0.499] ;
[c(P,_)].
[0.501, 0.499, 0.499, 0.499] ;
[reg(P,_)].
?- series(X).
% ?- series(X).

17
packages/CLPBN/examples/learning/debug_school.yap
View File

@ -2,16 +2,17 @@
/* We do not consider aggregates yet. */
:- [pos:train].
:- ['../../examples/School/sch32'].
:- use_module(library(clpbn/learning/em)).
%:- clpbn:set_clpbn_flag(em_solver,gibbs).
%:- clpbn:set_clpbn_flag(em_solver,jt).
:- clpbn:set_clpbn_flag(em_solver,ve).
%:- clpbn:set_clpbn_flag(em_solver,bp).
:- [pos:train].
:- ['../../examples/School/parschema.pfl'].
:- set_em_solver(ve).
%:- set_em_solver(hve).
%:- set_em_solver(bdd).
%:- set_em_solver(bp).
%:- set_em_solver(cbp).
debug_school :-
graph(L),

11
packages/CLPBN/examples/learning/prof_params.pfl
View File

@ -4,12 +4,11 @@
:- use_module(library(clpbn/learning/em)).
%:- clpbn:set_clpbn_flag(em_solver,gibbs).
%:- clpbn:set_clpbn_flag(em_solver,jt).
%:- clpbn:set_clpbn_flag(em_solver,hve).
:- clpbn:set_clpbn_flag(em_solver,ve).
%:- clpbn:set_clpbn_flag(em_solver,bp).
%:- clpbn:set_clpbn_flag(em_solver,bdd).
:- set_em_solver(ve).
%:- set_em_solver(hve).
%:- set_em_solver(bdd).
%:- set_em_solver(bp).
%:- set_em_solver(cbp).
professor(p0).
professor(p1).

17
packages/CLPBN/examples/learning/school_params.yap
View File

@ -2,16 +2,17 @@
/* We do not consider aggregates yet. */
:- [pos:train].
:- ['../../examples/School/sch32'].
:- use_module(library(clpbn/learning/em)).
%:- clpbn:set_clpbn_flag(em_solver,gibbs).
%:- clpbn:set_clpbn_flag(em_solver,jt).
:- clpbn:set_clpbn_flag(em_solver,ve).
%:- clpbn:set_clpbn_flag(em_solver,bp).
:- [pos:train].
:- ['../../examples/School/school_32'].
:- set_em_solver(ve).
%:- set_em_solver(hve).
%:- set_em_solver(bdd).
%:- set_em_solver(bp).
%:- set_em_solver(cbp).
timed_main :-
statistics(runtime, _),

11
packages/CLPBN/examples/learning/sprinkler_params.yap
View File

@ -4,12 +4,11 @@
:- use_module(library(clpbn/learning/em)).
%:- set_pfl_flag(em_solver,gibbs).
%:- set_pfl_flag(em_solver,jt).
%:- set_pfl_flag(em_solver,hve).
%:- set_pfl_flag(em_solver,bp).
%:- set_pfl_flag(em_solver,ve).
:- set_pfl_flag(em_solver,bdd).
:- set_em_solver(ve).
%:- set_em_solver(hve).
%:- set_em_solver(bdd).
%:- set_em_solver(bp).
%:- set_em_solver(cbp).
:- dynamic id/1.

38
packages/CLPBN/examples/social_domain1.pfl
View File

@ -1,38 +0,0 @@
:- use_module(library(pfl)).
:- set_solver(hve).
%:- set_solver(ve).
%:- set_solver(jt).
%:- set_solver(bdd).
%:- set_solver(bp).
%:- set_solver(cbp).
%:- set_solver(gibbs).
%:- set_solver(lve).
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile people/1.
people @ 5.
people(X,Y) :-
people(X),
people(Y),
X \== Y.
markov smokes(X) ; [1.0, 4.0552]; [people(X)].
markov cancer(X) ; [1.0, 9.9742]; [people(X)].
markov friends(X,Y) ; [1.0, 99.48432] ; [people(X,Y)].
markov smokes(X), cancer(X) ;
[4.48169, 4.48169, 1.0, 4.48169] ;
[people(X)].
markov friends(X,Y), smokes(X), smokes(Y) ;
[3.004166, 3.004166, 3.004166, 3.004166, 3.004166, 1.0, 1.0, 3.004166] ;
[people(X,Y)].
% ?- friends(p1,p2,X).

38
packages/CLPBN/examples/social_domain2.pfl
View File

@ -1,38 +0,0 @@
:- use_module(library(pfl)).
:- set_solver(hve).
%:- set_solver(ve).
%:- set_solver(jt).
%:- set_solver(bdd).
%:- set_solver(bp).
%:- set_solver(cbp).
%:- set_solver(gibbs).
%:- set_solver(lve).
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile people/1.
people @ 5.
people(X,Y) :-
people(X),
people(Y).
% X \== Y.
markov smokes(X) ; [1.0, 4.0552]; [people(X)].
markov asthma(X) ; [1.0, 9.9742] ; [people(X)].
markov friends(X,Y) ; [1.0, 99.48432] ; [people(X,Y)].
markov asthma(X), smokes(X) ;
[4.48169, 4.48169, 1.0, 4.48169] ;
[people(X)].
markov asthma(X), friends(X,Y), smokes(Y) ;
[3.004166, 3.004166, 3.004166, 3.004166, 3.004166, 1.0, 1.0, 3.004166] ;
[people(X,Y)].
% ?- smokes(p1,t), smokes(p2,t), friends(p1,p2,X).

44
packages/CLPBN/examples/social_network1.pfl Normal file
View File

@ -0,0 +1,44 @@
/*
Model from the paper "Lifted First-Order
Belief Propagation"
*/
:- use_module(library(pfl)).
:- set_solver(hve).
%:- set_solver(ve).
%:- set_solver(jt).
%:- set_solver(bdd).
%:- set_solver(bp).
%:- set_solver(cbp).
%:- set_solver(gibbs).
%:- set_solver(lve).
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile person/1.
person @ 5.
person(X,Y) :-
person(X),
person(Y)
% ,X \== Y
.
markov smokes(X) ; [1.0, 4.0552]; [person(X)].
markov cancer(X) ; [1.0, 9.9742]; [person(X)].
markov friends(X,Y) ; [1.0, 99.48432] ; [person(X,Y)].
markov smokes(X), cancer(X) ;
[4.48169, 4.48169, 1.0, 4.48169] ;
[person(X)].
markov friends(X,Y), smokes(X), smokes(Y) ;
[3.004166, 3.004166, 3.004166, 3.004166, 3.004166, 1.0, 1.0, 3.004166] ;
[person(X,Y)].
% ?- friends(p1,p2,X).

44
packages/CLPBN/examples/social_network2.pfl Normal file
View File

@ -0,0 +1,44 @@
/*
Model from the paper "Lifted Inference Seen
from the Other Side: The Tractable Features"
*/
:- use_module(library(pfl)).
:- set_solver(hve).
%:- set_solver(ve).
%:- set_solver(jt).
%:- set_solver(bdd).
%:- set_solver(bp).
%:- set_solver(cbp).
%:- set_solver(gibbs).
%:- set_solver(lve).
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile person/1.
person @ 5.
person(X,Y) :-
person(X),
person(Y)
% ,X \== Y
.
markov smokes(X) ; [1.0, 4.0552]; [person(X)].
markov asthma(X) ; [1.0, 9.9742] ; [person(X)].
markov friends(X,Y) ; [1.0, 99.48432] ; [person(X,Y)].
markov asthma(X), smokes(X) ;
[4.48169, 4.48169, 1.0, 4.48169] ;
[person(X)].
markov asthma(X), friends(X,Y), smokes(Y) ;
[3.004166, 3.004166, 3.004166, 3.004166, 3.004166, 1.0, 1.0, 3.004166] ;
[person(X,Y)].
% ?- smokes(p1,t), smokes(p2,t), friends(p1,p2,X).

8
packages/CLPBN/examples/sprinkler.pfl
View File

@ -24,16 +24,16 @@ cloudy_table(
0.5 ]).
sprinkler_table(
[ 0.5, 0.9,
0.5, 0.1 ]).
[ 0.1, 0.5,
0.9, 0.5 ]).
rain_table(
[ 0.8, 0.2,
0.2, 0.8 ]).
wet_grass_table(
[ 1.0, 0.1, 0.1, 0.01,
0.0, 0.9, 0.9, 0.99 ]).
[ 0.99, 0.9, 0.9, 0.0,
0.01, 0.1, 0.1, 1.0 ]).
% ?- wet_grass(X).

23
packages/CLPBN/examples/workshop_attrs.pfl
View File

@ -1,3 +1,8 @@
/*
Model from the paper "Lifted Probabilistic
Inference with Counting Formulas"
*/
:- use_module(library(pfl)).
:- set_solver(hve).
@ -11,23 +16,23 @@
%:- set_solver(lkc).
%:- set_solver(lbp).
:- multifile people/1.
:- multifile person/1.
people @ 5.
person @ 5.
markov attends(P), attr1 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr1 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), attr2 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr2 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), attr3 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr3 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), attr4 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr4 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), attr5 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr5 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), attr6 ; [0.7, 0.3, 0.3, 0.3] ; [people(P)].
markov attends(P), attr6 ; [0.7, 0.3, 0.3, 0.3] ; [person(P)].
markov attends(P), series ; [0.501, 0.499, 0.499, 0.499] ; [people(P)].
markov attends(P), series ; [0.501, 0.499, 0.499, 0.499] ; [person(P)].
% ?- series(X).

6
packages/CLPBN/horus/BayesBall.cpp
View File

@ -1,12 +1,6 @@
#include <cstdlib>
#include <cassert>
#include <iostream>
#include <fstream>
#include <sstream>
#include "BayesBall.h"
#include "Util.h"
FactorGraph*

9
packages/CLPBN/horus/BayesBall.h
View File

@ -4,7 +4,6 @@
#include <vector>
#include <queue>
#include <list>
#include <map>
#include "FactorGraph.h"
#include "BayesBallGraph.h"
@ -15,8 +14,8 @@ using namespace std;
struct ScheduleInfo
{
ScheduleInfo (BBNode* n, bool vfp, bool vfc) :
node(n), visitedFromParent(vfp), visitedFromChild(vfc) { }
ScheduleInfo (BBNode* n, bool vfp, bool vfc)
: node(n), visitedFromParent(vfp), visitedFromChild(vfc) { }
BBNode* node;
bool visitedFromParent;
@ -30,7 +29,7 @@ typedef queue<ScheduleInfo, list<ScheduleInfo>> Scheduling;
class BayesBall
{
public:
BayesBall (FactorGraph& fg)
BayesBall (FactorGraph& fg)
: fg_(fg) , dag_(fg.getStructure())
{
dag_.clear();
@ -63,7 +62,7 @@ inline void
BayesBall::scheduleParents (const BBNode* n, Scheduling& sch) const
{
const vector<BBNode*>& ps = n->parents();
for (vector<BBNode*>::const_iterator it = ps.begin();
for (vector<BBNode*>::const_iterator it = ps.begin();
it != ps.end(); ++it) {
sch.push (ScheduleInfo (*it, false, true));
}

7
packages/CLPBN/horus/BayesBallGraph.cpp
View File

@ -2,8 +2,8 @@
#include <cassert>
#include <iostream>
#include <fstream>
#include <sstream>
#include <fstream>
#include "BayesBallGraph.h"
#include "Util.h"
@ -79,9 +79,8 @@ BayesBallGraph::exportToGraphViz (const char* fileName)
{
ofstream out (fileName);
if (!out.is_open()) {
cerr << "error: cannot open file to write at " ;
cerr << "BayesBallGraph::exportToDotFile()" << endl;
abort();
cerr << "Error: couldn't open file '" << fileName << "'." ;
return;
}
out << "digraph {" << endl;
out << "ranksep=1" << endl;

14
packages/CLPBN/horus/BayesBallGraph.h
View File

@ -2,9 +2,7 @@
#define HORUS_BAYESBALLGRAPH_H
#include <vector>
#include <queue>
#include <list>
#include <map>
#include <unordered_map>
#include "Var.h"
#include "Horus.h"
@ -14,7 +12,7 @@ using namespace std;
class BBNode : public Var
{
public:
BBNode (Var* v) : Var (v) , visited_(false),
BBNode (Var* v) : Var (v), visited_(false),
markedOnTop_(false), markedOnBottom_(false) { }
const vector<BBNode*>& childs (void) const { return childs_; }
@ -30,15 +28,15 @@ class BBNode : public Var
void addChild (BBNode* c) { childs_.push_back (c); }
bool isVisited (void) const { return visited_; }
void setAsVisited (void) { visited_ = true; }
bool isMarkedOnTop (void) const { return markedOnTop_; }
void markOnTop (void) { markedOnTop_ = true; }
bool isMarkedOnBottom (void) const { return markedOnBottom_; }
void markOnBottom (void) { markedOnBottom_ = true; }
void clear (void) { visited_ = markedOnTop_ = markedOnBottom_ = false; }
@ -63,7 +61,7 @@ class BayesBallGraph
void addEdge (VarId vid1, VarId vid2);
const BBNode* getNode (VarId vid) const;
BBNode* getNode (VarId vid);
bool empty (void) const { return nodes_.empty(); }

55
packages/CLPBN/horus/BeliefProp.cpp
View File

@ -1,17 +1,19 @@
#include <cassert>
#include <limits>
#include <algorithm>
#include <iostream>
#include "BeliefProp.h"
#include "FactorGraph.h"
#include "Factor.h"
#include "Indexer.h"
#include "Horus.h"
double BeliefProp::accuracy_ = 0.0001;
unsigned BeliefProp::maxIter_ = 1000;
MsgSchedule BeliefProp::schedule_ = MsgSchedule::SEQ_FIXED;
BeliefProp::BeliefProp (const FactorGraph& fg) : GroundSolver (fg)
{
runned_ = false;
@ -50,16 +52,15 @@ BeliefProp::printSolverFlags (void) const
{
stringstream ss;
ss << "belief propagation [" ;
ss << "schedule=" ;
typedef BpOptions::Schedule Sch;
switch (BpOptions::schedule) {
case Sch::SEQ_FIXED: ss << "seq_fixed"; break;
case Sch::SEQ_RANDOM: ss << "seq_random"; break;
case Sch::PARALLEL: ss << "parallel"; break;
case Sch::MAX_RESIDUAL: ss << "max_residual"; break;
ss << "bp_msg_schedule=" ;
switch (schedule_) {
case MsgSchedule::SEQ_FIXED: ss << "seq_fixed"; break;
case MsgSchedule::SEQ_RANDOM: ss << "seq_random"; break;
case MsgSchedule::PARALLEL: ss << "parallel"; break;
case MsgSchedule::MAX_RESIDUAL: ss << "max_residual"; break;
}
ss << ",max_iter=" << Util::toString (BpOptions::maxIter);
ss << ",accuracy=" << Util::toString (BpOptions::accuracy);
ss << ",bp_max_iter=" << Util::toString (maxIter_);
ss << ",bp_accuracy=" << Util::toString (accuracy_);
ss << ",log_domain=" << Util::toString (Globals::logDomain);
ss << "]" ;
cout << ss.str() << endl;
@ -146,7 +147,7 @@ BeliefProp::getFactorJoint (
if (Globals::logDomain) {
Util::exp (jointDist);
}
return jointDist;
return jointDist;
}
@ -156,21 +157,21 @@ BeliefProp::runSolver (void)
{
initializeSolver();
nIters_ = 0;
while (!converged() && nIters_ < BpOptions::maxIter) {
while (!converged() && nIters_ < maxIter_) {
nIters_ ++;
if (Globals::verbosity > 1) {
Util::printHeader (string ("Iteration ") + Util::toString (nIters_));
}
switch (BpOptions::schedule) {
case BpOptions::Schedule::SEQ_RANDOM:
switch (schedule_) {
case MsgSchedule::SEQ_RANDOM:
std::random_shuffle (links_.begin(), links_.end());
// no break
case BpOptions::Schedule::SEQ_FIXED:
case MsgSchedule::SEQ_FIXED:
for (size_t i = 0; i < links_.size(); i++) {
calculateAndUpdateMessage (links_[i]);
}
break;
case BpOptions::Schedule::PARALLEL:
case MsgSchedule::PARALLEL:
for (size_t i = 0; i < links_.size(); i++) {
calculateMessage (links_[i]);
}
@ -178,14 +179,14 @@ BeliefProp::runSolver (void)
updateMessage(links_[i]);
}
break;
case BpOptions::Schedule::MAX_RESIDUAL:
case MsgSchedule::MAX_RESIDUAL:
maxResidualSchedule();
break;
}
}
if (Globals::verbosity > 0) {
if (nIters_ < BpOptions::maxIter) {
cout << "Belief propagation converged in " ;
if (nIters_ < maxIter_) {
cout << "Belief propagation converged in " ;
cout << nIters_ << " iterations" << endl;
} else {
cout << "The maximum number of iterations was hit, terminating..." ;
@ -236,7 +237,7 @@ BeliefProp::maxResidualSchedule (void)
SortedOrder::iterator it = sortedOrder_.begin();
BpLink* link = *it;
if (link->residual() < BpOptions::accuracy) {
if (link->residual() < accuracy_) {
return;
}
updateMessage (link);
@ -410,7 +411,7 @@ BeliefProp::initializeSolver (void)
bool
BeliefProp::converged (void)
{
if (links_.size() == 0) {
if (links_.empty()) {
return true;
}
if (nIters_ == 0) {
@ -426,9 +427,9 @@ BeliefProp::converged (void)
return false;
}
bool converged = true;
if (BpOptions::schedule == BpOptions::Schedule::MAX_RESIDUAL) {
if (schedule_ == MsgSchedule::MAX_RESIDUAL) {
double maxResidual = (*(sortedOrder_.begin()))->residual();
if (maxResidual > BpOptions::accuracy) {
if (maxResidual > accuracy_) {
converged = false;
} else {
converged = true;
@ -439,7 +440,7 @@ BeliefProp::converged (void)
if (Globals::verbosity > 1) {
cout << links_[i]->toString() + " residual = " << residual << endl;
}
if (residual > BpOptions::accuracy) {
if (residual > accuracy_) {
converged = false;
if (Globals::verbosity < 2) {
break;
@ -459,7 +460,7 @@ void
BeliefProp::printLinkInformation (void) const
{
for (size_t i = 0; i < links_.size(); i++) {
BpLink* l = links_[i];
BpLink* l = links_[i];
cout << l->toString() << ":" << endl;
cout << " curr msg = " ;
cout << l->message() << endl;

69
packages/CLPBN/horus/BeliefProp.h
View File

@ -3,21 +3,29 @@
#include <set>
#include <vector>
#include <sstream>
#include "GroundSolver.h"
#include "Factor.h"
#include "FactorGraph.h"
#include "Util.h"
using namespace std;
enum MsgSchedule {
SEQ_FIXED,
SEQ_RANDOM,
PARALLEL,
MAX_RESIDUAL
};
class BpLink
{
public:
BpLink (FacNode* fn, VarNode* vn)
{
{
fac_ = fn;
var_ = vn;
v1_.resize (vn->range(), LogAware::log (1.0 / vn->range()));
@ -43,10 +51,10 @@ class BpLink
void updateResidual (void)
{
residual_ = LogAware::getMaxNorm (v1_,v2_);
residual_ = LogAware::getMaxNorm (v1_, v2_);
}
virtual void updateMessage (void)
virtual void updateMessage (void)
{
swap (currMsg_, nextMsg_);
}
@ -59,7 +67,7 @@ class BpLink
ss << var_->label();
return ss.str();
}
protected:
FacNode* fac_;
VarNode* var_;
@ -68,6 +76,9 @@ class BpLink
Params* currMsg_;
Params* nextMsg_;
double residual_;
private:
DISALLOW_COPY_AND_ASSIGN (BpLink);
};
typedef vector<BpLink*> BpLinks;
@ -76,10 +87,12 @@ typedef vector<BpLink*> BpLinks;
class SPNodeInfo
{
public:
SPNodeInfo (void) { }
void addBpLink (BpLink* link) { links_.push_back (link); }
const BpLinks& getLinks (void) { return links_; }
private:
BpLinks links_;
DISALLOW_COPY_AND_ASSIGN (SPNodeInfo);
};
@ -97,23 +110,21 @@ class BeliefProp : public GroundSolver
virtual Params getPosterioriOf (VarId);
virtual Params getJointDistributionOf (const VarIds&);
protected:
void runSolver (void);
virtual void createLinks (void);
virtual void maxResidualSchedule (void);
virtual void calcFactorToVarMsg (BpLink*);
virtual Params getVarToFactorMsg (const BpLink*) const;
virtual Params getJointByConditioning (const VarIds&) const;
public:
Params getFactorJoint (FacNode* fn, const VarIds&);
static double accuracy (void) { return accuracy_; }
static void setAccuracy (double acc) { accuracy_ = acc; }
static unsigned maxIterations (void) { return maxIter_; }
static void setMaxIterations (unsigned mi) { maxIter_ = mi; }
static MsgSchedule msgSchedule (void) { return schedule_; }
static void setMsgSchedule (MsgSchedule sch) { schedule_ = sch; }
protected:
SPNodeInfo* ninf (const VarNode* var) const
{
@ -164,6 +175,18 @@ class BeliefProp : public GroundSolver
}
};
void runSolver (void);
virtual void createLinks (void);
virtual void maxResidualSchedule (void);
virtual void calcFactorToVarMsg (BpLink*);
virtual Params getVarToFactorMsg (const BpLink*) const;
virtual Params getJointByConditioning (const VarIds&) const;
BpLinks links_;
unsigned nIters_;
vector<SPNodeInfo*> varsI_;
@ -176,12 +199,18 @@ class BeliefProp : public GroundSolver
typedef unordered_map<BpLink*, SortedOrder::iterator> BpLinkMap;
BpLinkMap linkMap_;
static double accuracy_;
static unsigned maxIter_;
static MsgSchedule schedule_;
private:
void initializeSolver (void);
bool converged (void);
virtual void printLinkInformation (void) const;
DISALLOW_COPY_AND_ASSIGN (BeliefProp);
};
#endif // HORUS_BELIEFPROP_H

Some files were not shown because too many files have changed in this diff Show More