2008-02-12 22:28:18 +00:00
|
|
|
%
|
|
|
|
% Utilities for learning
|
|
|
|
%
|
|
|
|
|
2008-10-22 00:44:02 +01:00
|
|
|
:- module(clpbn_learn_utils, [run_all/1,
|
|
|
|
clpbn_vars/2,
|
|
|
|
normalise_counts/2,
|
2008-10-31 15:11:27 +00:00
|
|
|
compute_likelihood/3,
|
|
|
|
soften_sample/2,
|
|
|
|
soften_sample/3]).
|
|
|
|
|
|
|
|
:- use_module(library(clpbn),
|
|
|
|
[clpbn_flag/2]).
|
2008-10-22 00:44:02 +01:00
|
|
|
|
2008-11-18 11:29:59 +00:00
|
|
|
:- use_module(library('clpbn/table'),
|
|
|
|
[clpbn_reset_tables/0]).
|
|
|
|
|
2008-10-22 00:44:02 +01:00
|
|
|
:- use_module(library(matrix),
|
|
|
|
[matrix_agg_lines/3,
|
|
|
|
matrix_op_to_lines/4,
|
2008-10-31 15:11:27 +00:00
|
|
|
matrix_agg_cols/3,
|
|
|
|
matrix_op_to_cols/4,
|
2008-10-22 00:44:02 +01:00
|
|
|
matrix_to_logs/2,
|
|
|
|
matrix_op/4,
|
2008-10-24 10:36:37 +01:00
|
|
|
matrix_sum/2,
|
2008-10-31 15:11:27 +00:00
|
|
|
matrix_to_list/2,
|
|
|
|
matrix_op_to_all/4]).
|
2008-10-22 00:44:02 +01:00
|
|
|
|
|
|
|
:- meta_predicate run_all(:).
|
2008-02-12 22:28:18 +00:00
|
|
|
|
|
|
|
run_all([]).
|
|
|
|
run_all([G|Gs]) :-
|
2008-10-22 00:44:02 +01:00
|
|
|
call(G),
|
2008-02-12 22:28:18 +00:00
|
|
|
run_all(Gs).
|
2008-10-22 00:44:02 +01:00
|
|
|
run_all(M:Gs) :-
|
2008-11-18 11:29:59 +00:00
|
|
|
clpbn_reset_tables,
|
2008-10-22 00:44:02 +01:00
|
|
|
run_all(Gs,M).
|
|
|
|
|
|
|
|
run_all([],_).
|
|
|
|
run_all([G|Gs],M) :-
|
2008-11-13 09:03:53 +00:00
|
|
|
( call(M:G) -> true ; writeln(bad:M:G), break),
|
2008-10-22 00:44:02 +01:00
|
|
|
run_all(Gs,M).
|
2008-02-12 22:28:18 +00:00
|
|
|
|
|
|
|
clpbn_vars(Vs,BVars) :-
|
|
|
|
get_clpbn_vars(Vs,CVs),
|
|
|
|
keysort(CVs,KVs),
|
|
|
|
merge_vars(KVs,BVars).
|
|
|
|
|
|
|
|
get_clpbn_vars([],[]).
|
|
|
|
get_clpbn_vars([V|GVars],[K-V|CLPBNGVars]) :-
|
|
|
|
clpbn:get_atts(V, [key(K)]), !,
|
|
|
|
get_clpbn_vars(GVars,CLPBNGVars).
|
|
|
|
get_clpbn_vars([_|GVars],CLPBNGVars) :-
|
|
|
|
get_clpbn_vars(GVars,CLPBNGVars).
|
|
|
|
|
|
|
|
merge_vars([],[]).
|
|
|
|
merge_vars([K-V|KVs],[V|BVars]) :-
|
|
|
|
get_var_has_same_key(KVs,K,V,KVs0),
|
|
|
|
merge_vars(KVs0,BVars).
|
|
|
|
|
|
|
|
get_var_has_same_key([K-V|KVs],K,V,KVs0) :- !,
|
|
|
|
get_var_has_same_key(KVs,K,V,KVs0).
|
|
|
|
get_var_has_same_key(KVs,_,_,KVs).
|
|
|
|
|
2008-10-31 15:11:27 +00:00
|
|
|
soften_sample(T0,T) :-
|
|
|
|
clpbn_flag(parameter_softening, Soften),
|
|
|
|
soften_sample(Soften, T0, T).
|
|
|
|
|
|
|
|
soften_sample(no,T,T).
|
|
|
|
soften_sample(m_estimate(M), T0, T) :-
|
2008-11-26 09:56:55 +00:00
|
|
|
matrix_agg_cols(T0,+,Cols),
|
2008-10-31 15:11:27 +00:00
|
|
|
matrix_op_to_all(Cols, *, M, R),
|
2008-11-26 09:56:55 +00:00
|
|
|
matrix_op_to_cols(T0,R,+,T).
|
2008-10-31 15:11:27 +00:00
|
|
|
soften_sample(auto_m, T0,T) :-
|
2008-11-26 09:56:55 +00:00
|
|
|
matrix_agg_cols(T0,+,Cols),
|
2008-10-31 15:11:27 +00:00
|
|
|
matrix_sum(Cols,TotM),
|
|
|
|
M is sqrt(TotM),
|
|
|
|
matrix_op_to_all(Cols, *, M, R),
|
2008-11-26 09:56:55 +00:00
|
|
|
matrix_op_to_cols(T0,R,+,T).
|
2008-10-31 15:11:27 +00:00
|
|
|
soften_sample(laplace,T0,T) :-
|
|
|
|
matrix_op_to_all(T0, +, 1, T).
|
|
|
|
|
|
|
|
|
2008-10-22 00:44:02 +01:00
|
|
|
normalise_counts(MAT,NMAT) :-
|
|
|
|
matrix_agg_lines(MAT, +, Sum),
|
|
|
|
matrix_op_to_lines(MAT, Sum, /, NMAT).
|
|
|
|
|
|
|
|
compute_likelihood(Table0, NewTable, DeltaLik) :-
|
|
|
|
matrix_to_logs(NewTable, Logs),
|
2008-10-24 10:36:37 +01:00
|
|
|
matrix_to_list(Table0,L1),
|
|
|
|
matrix_to_list(Logs,L2),
|
|
|
|
sum_prods(L1,L2,0,DeltaLik).
|
2008-02-12 22:28:18 +00:00
|
|
|
|
2008-10-24 10:36:37 +01:00
|
|
|
sum_prods([],[],DeltaLik,DeltaLik).
|
|
|
|
sum_prods([0.0|L1],[_|L2],DeltaLik0,DeltaLik) :- !,
|
|
|
|
sum_prods(L1,L2,DeltaLik0,DeltaLik).
|
|
|
|
sum_prods([Count|L1],[Log|L2],DeltaLik0,DeltaLik) :- !,
|
|
|
|
DeltaLik1 is DeltaLik0+Count*Log,
|
|
|
|
sum_prods(L1,L2,DeltaLik1,DeltaLik).
|
2008-02-12 22:28:18 +00:00
|
|
|
|