Use the same convetion for module import and export
This commit is contained in:
parent
2738c0fb56
commit
409a230826
@ -1,21 +1,21 @@
|
||||
|
||||
:- module(clpbn,
|
||||
[{}/1,
|
||||
clpbn_flag/2,
|
||||
set_clpbn_flag/2,
|
||||
clpbn_flag/3,
|
||||
clpbn_key/2,
|
||||
clpbn_init_graph/1,
|
||||
clpbn_init_solver/4,
|
||||
clpbn_run_solver/3,
|
||||
clpbn_finalize_solver/1,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3,
|
||||
probability/2,
|
||||
conditional_probability/3,
|
||||
use_parfactors/1,
|
||||
op(500, xfy, with)
|
||||
]).
|
||||
[{}/1,
|
||||
clpbn_flag/2,
|
||||
set_clpbn_flag/2,
|
||||
clpbn_flag/3,
|
||||
clpbn_key/2,
|
||||
clpbn_init_graph/1,
|
||||
clpbn_init_solver/4,
|
||||
clpbn_run_solver/3,
|
||||
clpbn_finalize_solver/1,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3,
|
||||
probability/2,
|
||||
conditional_probability/3,
|
||||
use_parfactors/1,
|
||||
op(500, xfy, with)
|
||||
]).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
|
||||
@ -30,92 +30,91 @@
|
||||
:- 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
|
||||
]).
|
||||
[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
|
||||
]).
|
||||
[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
|
||||
]).
|
||||
[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
|
||||
]).
|
||||
[gibbs/3,
|
||||
check_if_gibbs_done/1,
|
||||
init_gibbs_solver/4,
|
||||
run_gibbs_solver/3
|
||||
]).
|
||||
|
||||
%% :- use_module('clpbn/bnt',
|
||||
%% [do_bnt/3,
|
||||
%% check_if_bnt_done/1
|
||||
%% ]).
|
||||
%% [do_bnt/3,
|
||||
%% check_if_bnt_done/1
|
||||
%% ]).
|
||||
|
||||
:- use_module('clpbn/pgrammar',
|
||||
[init_pcg_solver/4,
|
||||
run_pcg_solver/3,
|
||||
pcg_init_graph/0
|
||||
]).
|
||||
[init_pcg_solver/4,
|
||||
run_pcg_solver/3,
|
||||
pcg_init_graph/0
|
||||
]).
|
||||
|
||||
:- 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,
|
||||
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,
|
||||
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
|
||||
]).
|
||||
[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/dists',
|
||||
[dist/4,
|
||||
get_dist/4,
|
||||
get_evidence_position/3,
|
||||
get_evidence_from_position/3,
|
||||
additive_dists/6
|
||||
]).
|
||||
[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
|
||||
]).
|
||||
[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]).
|
||||
[generate_network/5]).
|
||||
|
||||
:- use_module('clpbn/utils',
|
||||
[sort_vars_by_key/3]).
|
||||
[sort_vars_by_key/3]).
|
||||
|
||||
:- use_module('clpbn/graphs',
|
||||
[clpbn2graph/1]).
|
||||
[clpbn2graph/1]).
|
||||
|
||||
:- use_module('clpbn/graphviz',
|
||||
[clpbn2gviz/4]).
|
||||
|
||||
[clpbn2gviz/4]).
|
||||
|
||||
%
|
||||
% avoid the overhead of using goal_expansion/2.
|
||||
|
@ -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)).
|
||||
|
||||
@ -369,7 +372,7 @@ 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) :-
|
||||
|
@ -18,32 +18,32 @@ 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)).
|
||||
@ -1064,4 +1064,3 @@ build_cnf(CNF, IVs, Indics, AllParms, AllParmValues, Val) :-
|
||||
set_to_ones(Extra),
|
||||
ddnnf_is(F, Val).
|
||||
|
||||
|
||||
|
@ -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).
|
||||
|
||||
@ -421,5 +427,5 @@ 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).
|
||||
|
||||
|
||||
|
||||
|
@ -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),
|
||||
|
@ -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
|
||||
%
|
||||
@ -143,4 +147,3 @@ get_sizes([V|Deps], [Sz|Sizes]) :-
|
||||
get_dist_domain_size(Id,Sz),
|
||||
get_sizes(Deps, Sizes).
|
||||
|
||||
|
||||
|
@ -1,14 +1,14 @@
|
||||
:- 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)).
|
||||
|
||||
|
@ -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(+, -).
|
||||
@ -322,11 +326,11 @@ randomise_all_dists.
|
||||
|
||||
randomise_dist(Dist) :-
|
||||
(
|
||||
use_parfactors(on)
|
||||
use_parfactors(on)
|
||||
->
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
;
|
||||
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
|
||||
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
|
||||
),
|
||||
random_CPT(DSizes, NewCPT),
|
||||
dist_new_table(Dist, NewCPT).
|
||||
@ -338,11 +342,11 @@ uniformise_all_dists.
|
||||
|
||||
uniformise_dist(Dist) :-
|
||||
(
|
||||
use_parfactors(on)
|
||||
use_parfactors(on)
|
||||
->
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
pfl:get_pfl_factor_sizes(Dist, DSizes)
|
||||
;
|
||||
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
|
||||
recorded(clpbn_dist_psizes, db(Dist,DSizes), _)
|
||||
),
|
||||
uniform_CPT(DSizes, NewCPT),
|
||||
dist_new_table(Dist, NewCPT).
|
||||
@ -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).
|
||||
|
||||
|
@ -4,29 +4,27 @@
|
||||
%
|
||||
|
||||
:- 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(:).
|
||||
|
||||
|
@ -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.
|
||||
|
||||
@ -542,5 +545,3 @@ divide_list([C|Add], Sum, [P|Dist]) :-
|
||||
P is C/Sum,
|
||||
divide_list(Add, Sum, Dist).
|
||||
|
||||
|
||||
|
||||
|
@ -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).
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -1,4 +1,6 @@
|
||||
:- module(clpbn_gviz, [clpbn2gviz/4]).
|
||||
|
||||
:- module(clpbn_gviz,
|
||||
[clpbn2gviz/4]).
|
||||
|
||||
clpbn2gviz(Stream, Name, Network, Output) :-
|
||||
format(Stream, 'digraph ~w {
|
||||
|
@ -1,34 +1,34 @@
|
||||
|
||||
:- module(pfl_ground_factors,
|
||||
[generate_network/5,
|
||||
f/3
|
||||
]).
|
||||
[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
|
||||
]).
|
||||
[b_hash_new/1,
|
||||
b_hash_lookup/3,
|
||||
b_hash_insert/4,
|
||||
b_hash_to_list/2
|
||||
]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[member/2]).
|
||||
[member/2]).
|
||||
|
||||
:- use_module(library(maplist)).
|
||||
|
||||
:- use_module(library(atts)).
|
||||
|
||||
:- use_module(library(pfl),
|
||||
[factor/6,
|
||||
defined_in_factor/2,
|
||||
skolem/2
|
||||
]).
|
||||
[factor/6,
|
||||
defined_in_factor/2,
|
||||
skolem/2
|
||||
]).
|
||||
|
||||
:- use_module(library(clpbn/aggregates),
|
||||
[avg_factors/5]).
|
||||
[avg_factors/5]).
|
||||
|
||||
:- use_module(library(clpbn/dists),
|
||||
[dist/4]).
|
||||
[dist/4]).
|
||||
|
||||
:- dynamic currently_defined/1, queue/1, f/4.
|
||||
|
||||
|
@ -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)).
|
||||
|
||||
@ -79,5 +80,3 @@ cvt_vals([A|B],[A|B]).
|
||||
find_probs(Logs,Nth,Log) :-
|
||||
arg(Nth,Logs,Log).
|
||||
|
||||
|
||||
|
||||
|
@ -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([[]],_,_) :- !.
|
||||
@ -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],
|
||||
|
@ -1,51 +1,53 @@
|
||||
:- 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),
|
||||
|
@ -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
|
||||
@ -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.
|
||||
|
||||
|
||||
|
@ -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,'::').
|
||||
|
||||
|
@ -8,28 +8,29 @@
|
||||
*/
|
||||
|
||||
:- 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(:.?),
|
||||
@ -43,14 +44,13 @@
|
||||
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.
|
||||
|
||||
@ -364,4 +364,3 @@ clpbn_is_tabled(M:Clause, _) :- !,
|
||||
clpbn_is_tabled(Head, M) :-
|
||||
clpbn_table(Head, M, _).
|
||||
|
||||
|
||||
|
@ -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).
|
||||
|
||||
|
||||
|
@ -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.
|
||||
@ -113,4 +115,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).
|
||||
|
||||
|
||||
|
@ -14,55 +14,58 @@
|
||||
|
||||
*********************************/
|
||||
|
||||
:- 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
|
||||
]).
|
||||
|
||||
:- 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,7 @@
|
||||
:- 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.
|
||||
|
||||
@ -474,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).
|
||||
|
||||
|
||||
|
@ -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(:,:,+,-).
|
||||
|
||||
@ -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).
|
||||
|
||||
|
||||
|
||||
|
@ -1,13 +1,12 @@
|
||||
|
||||
:- 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)).
|
||||
@ -39,6 +38,3 @@ lvars_to_numbers(LVs, LIs, VMap0, VMap) :-
|
||||
vmap_to_list(vmap(_,Map), L) :-
|
||||
rb_visit(Map, L).
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -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"?>
|
||||
|
@ -5,67 +5,67 @@
|
||||
:- module(clpbn_em, [em/5]).
|
||||
|
||||
:- reexport(library(clpbn),
|
||||
[clpbn_flag/2,
|
||||
clpbn_flag/3
|
||||
]).
|
||||
[clpbn_flag/2,
|
||||
clpbn_flag/3
|
||||
]).
|
||||
|
||||
:- use_module(library(clpbn),
|
||||
[clpbn_init_graph/1,
|
||||
clpbn_init_solver/4,
|
||||
clpbn_run_solver/3,
|
||||
clpbn_finalize_solver/1,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3,
|
||||
conditional_probability/3,
|
||||
clpbn_flag/2
|
||||
]).
|
||||
[clpbn_init_graph/1,
|
||||
clpbn_init_solver/4,
|
||||
clpbn_run_solver/3,
|
||||
clpbn_finalize_solver/1,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3,
|
||||
conditional_probability/3,
|
||||
clpbn_flag/2
|
||||
]).
|
||||
|
||||
:- use_module(library('clpbn/dists'),
|
||||
[get_dist_domain_size/2,
|
||||
empty_dist/2,
|
||||
dist_new_table/2,
|
||||
get_dist_key/2,
|
||||
randomise_all_dists/0,
|
||||
uniformise_all_dists/0
|
||||
]).
|
||||
[get_dist_domain_size/2,
|
||||
empty_dist/2,
|
||||
dist_new_table/2,
|
||||
get_dist_key/2,
|
||||
randomise_all_dists/0,
|
||||
uniformise_all_dists/0
|
||||
]).
|
||||
|
||||
:- use_module(library('clpbn/ground_factors'),
|
||||
[generate_network/5,
|
||||
f/3
|
||||
]).
|
||||
[generate_network/5,
|
||||
f/3
|
||||
]).
|
||||
|
||||
:- use_module(library('clpbn/utils'),
|
||||
[check_for_hidden_vars/3,
|
||||
sort_vars_by_key/3
|
||||
]).
|
||||
[check_for_hidden_vars/3,
|
||||
sort_vars_by_key/3
|
||||
]).
|
||||
|
||||
:- use_module(library('clpbn/learning/learn_utils'),
|
||||
[run_all/1,
|
||||
clpbn_vars/2,
|
||||
normalise_counts/2,
|
||||
compute_likelihood/3,
|
||||
soften_sample/2
|
||||
]).
|
||||
[run_all/1,
|
||||
clpbn_vars/2,
|
||||
normalise_counts/2,
|
||||
compute_likelihood/3,
|
||||
soften_sample/2
|
||||
]).
|
||||
|
||||
:- use_module(library(bhash),
|
||||
[b_hash_new/1,
|
||||
b_hash_lookup/3,
|
||||
b_hash_insert/4
|
||||
]).
|
||||
[b_hash_new/1,
|
||||
b_hash_lookup/3,
|
||||
b_hash_insert/4
|
||||
]).
|
||||
|
||||
:- use_module(library(matrix),
|
||||
[matrix_add/3,
|
||||
matrix_to_list/2
|
||||
]).
|
||||
[matrix_add/3,
|
||||
matrix_to_list/2
|
||||
]).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[member/2]).
|
||||
[member/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(maplist)).
|
||||
|
||||
|
@ -4,34 +4,34 @@
|
||||
%
|
||||
|
||||
:- module(pfl,
|
||||
[op(550,yfx,@),
|
||||
op(550,yfx,::),
|
||||
op(1150,fx,bayes),
|
||||
op(1150,fx,markov),
|
||||
factor/6,
|
||||
skolem/2,
|
||||
defined_in_factor/2,
|
||||
get_pfl_cpt/5, % given id and keys, return new keys and cpt
|
||||
get_pfl_parameters/2, % given id return par factor parameter
|
||||
new_pfl_parameters/2, % given id set new parameters
|
||||
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
|
||||
get_factor_pvariable/2, % given id get any pvar
|
||||
add_ground_factor/5 %add a new bayesian variable (for now)
|
||||
]).
|
||||
[op(550,yfx,@),
|
||||
op(550,yfx,::),
|
||||
op(1150,fx,bayes),
|
||||
op(1150,fx,markov),
|
||||
factor/6,
|
||||
skolem/2,
|
||||
defined_in_factor/2,
|
||||
get_pfl_cpt/5, % given id and keys, return new keys and cpt
|
||||
get_pfl_parameters/2, % given id return par factor parameter
|
||||
new_pfl_parameters/2, % given id set new parameters
|
||||
get_first_pvariable/2, % given id get firt pvar (useful in bayesian)
|
||||
get_factor_pvariable/2, % given id get any pvar
|
||||
add_ground_factor/5 %add a new bayesian variable (for now)
|
||||
]).
|
||||
|
||||
:- reexport(library(clpbn),
|
||||
[clpbn_flag/2 as pfl_flag,
|
||||
set_clpbn_flag/2 as set_pfl_flag,
|
||||
conditional_probability/3,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3
|
||||
]).
|
||||
[clpbn_flag/2 as pfl_flag,
|
||||
set_clpbn_flag/2 as set_pfl_flag,
|
||||
conditional_probability/3,
|
||||
pfl_init_solver/5,
|
||||
pfl_run_solver/3
|
||||
]).
|
||||
|
||||
:- reexport(library(clpbn/horus),
|
||||
[set_solver/1]).
|
||||
[set_solver/1]).
|
||||
|
||||
:- reexport(library(clpbn/aggregates),
|
||||
[avg_factors/5]).
|
||||
[avg_factors/5]).
|
||||
|
||||
:- ( % if clp(bn) has done loading, we're top-level
|
||||
predicate_property(set_pfl_flag(_,_), imported_from(clpbn))
|
||||
@ -47,10 +47,10 @@
|
||||
:- use_module(library(atts)).
|
||||
|
||||
:- use_module(library(lists),
|
||||
[nth0/3,
|
||||
append/3,
|
||||
member/2
|
||||
]).
|
||||
[nth0/3,
|
||||
append/3,
|
||||
member/2
|
||||
]).
|
||||
|
||||
:- dynamic factor/6, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1.
|
||||
|
||||
|
Reference in New Issue
Block a user