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

more small fixes.

Browse Source
This commit is contained in:
Costa Vitor 2012-08-29 16:36:46 -05:00
parent 62ab5b3dcb
commit f4e965c02f
4 changed files with 63 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -148,12 +148,18 @@ generate_tmp_random(sum(Min,Max), N, [V1,V2], V, Key, Softness, I) :-
Upper is Max*N,
generate_list(Lower, Upper, Nbs),
sum_cpt([V1,V2], Nbs, Softness, CPT),
generate_var('AVG'(I,Key), Nbs, CPT, [V1,V2], V).
% write(sum(Nbs, CPT, [V1,V2])),nl, % debugging
{ V = 'AVG'(I,Key) with p(Nbs,CPT,[V1,V2]) }.
generate_tmp_random(max(Domain,CPT), _, [V1,V2], V, Key, I) :-
{ V = 'MAX'(I,Key) with p(Domain,CPT,[V1,V2]) }.
generate_var('MAX'(I,Key), Domain, CPT, [V1,V2], V).
generate_tmp_random(min(Domain,CPT), _, [V1,V2], V, Key, I) :-
{ V = 'MIN'(I,Key) with p(Domain,CPT,[V1,V2]) }.
generate_var('MIN'(I,Key), Domain, CPT, [V1,V2], V).
generate_var(VKey, Domain, CPT, Parents, VKey) :-
clpbn:use_parfactors(on), !,
pfl:add_ground_factor(bayes, Domain, [VKey|Parents], CPT).
generate_var(VKey, Domain, CPT, Parents, V) :-
{ V = VKey with tab(Domain, CPT, Parents) }.
generate_list(M, M, [M]) :- !.
generate_list(I, M, [I|Nbs]) :-

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

@ -43,10 +43,12 @@ generate_network(QueryVars, QueryKeys, Keys, Factors, EList) :-
init_global_search,
attributes:all_attvars(AVars),
b_hash_new(Evidence0),
include_evidence(AVars, Evidence0, Evidence),
b_hash_to_list(Evidence, EList0), list_to_evlist(EList0, EList),
run_through_evidence(EList),
run_through_query(Evidence, QueryVars, QueryKeys),
foldl(include_evidence,AVars, Evidence0, Evidence1),
static_evidence(Evidence1, Evidence),
b_hash_to_list(Evidence, EList0),
maplist(pair_to_evidence,EList0, EList),
maplist(queue_evidence, EList),
foldl(run_through_query(Evidence), QueryVars, [], QueryKeys),
propagate,
collect(Keys, Factors).
@ -58,59 +60,47 @@ init_global_search :-
retractall(currently_defined(_)),
retractall(f(_,_,_)).
list_to_evlist([], []).
list_to_evlist([K-E|EList0], [K=E|EList]) :-
list_to_evlist(EList0, EList).
pair_to_evidence(K-E, K=E).
include_evidence([], Evidence0, Evidence) :-
findall(Sk=Var, pfl:evidence(Sk,Var), Evs),
include_static_evidence(Evs, Evidence0, Evidence).
include_evidence([V|AVars], Evidence0, Evidence) :-
include_evidence(V, Evidence0, Evidence) :-
clpbn:get_atts(V,[key(K),evidence(E)]), !,
(
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; EvidenceI = Evidence0)
(E \= E1 -> throw(clpbn:incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
;
b_hash_insert(Evidence0, K, E, EvidenceI)
),
include_evidence(AVars, EvidenceI, Evidence).
include_evidence([_|AVars], Evidence0, Evidence) :-
include_evidence(AVars, Evidence0, Evidence).
b_hash_insert(Evidence0, K, E, Evidence)
).
include_evidence(_, Evidence, Evidence).
include_static_evidence([], Evidence, Evidence).
include_static_evidence([K=E|AVars], Evidence0, Evidence) :-
static_evidence(Evidence0, Evidence) :-
findall(Sk=Var, pfl:evidence(Sk,Var), Evs),
foldl(include_static_evidence, Evs, Evidence0, Evidence).
include_static_evidence(K=E, Evidence0, Evidence) :-
(
b_hash_lookup(K, E1, Evidence0)
->
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; EvidenceI = Evidence0)
(E \= E1 -> throw(incompatible_evidence(K,E,E1)) ; Evidence = Evidence0)
;
b_hash_insert(Evidence0, K, E, EvidenceI)
),
include_evidence(AVars, EvidenceI, Evidence).
b_hash_insert(Evidence0, K, E, Evidence)
).
run_through_query(_, [], []).
run_through_query(Evidence, [V|QueryVars], QueryKeys) :-
queue_evidence(K=_) :-
queue_in(K).
run_through_query(Evidence, V, QueryKeys, QueryKeys) :-
clpbn:get_atts(V,[key(K)]),
b_hash_lookup(K, _, Evidence), !,
run_through_query(Evidence, QueryVars, QueryKeys).
run_through_query(Evidence, [V|QueryVars], [K|QueryKeys]) :-
b_hash_lookup(K, _, Evidence), !.
run_through_query(_Evidence, V, QueryKeys, [K|QueryKeys]) :-
clpbn:get_atts(V,[key(K)]),
queue_in(K),
run_through_query(Evidence, QueryVars, QueryKeys).
queue_in(K).
collect(Keys, Factors) :-
findall(K, currently_defined(K), Keys),
findall(f(FType,FId,FKeys), f(FType,FId,FKeys), Factors).
run_through_evidence([]).
run_through_evidence([K=_|_]) :-
queue_in(K),
fail.
run_through_evidence([_|Ev]) :-
run_through_evidence(Ev).
ground_all_keys([], _).
ground_all_keys([V|GVars], AllKeys) :-
clpbn:get_atts(V,[key(Key)]),
@ -149,6 +139,8 @@ propagate :-
do_propagate(K).
propagate.
do_propagate(agg(_)) :- !,
propagate.
do_propagate(K) :-
%writeln(-K),
\+ currently_defined(K),
@ -162,6 +154,7 @@ do_propagate(K) :-
throw(error(no_defining_factor(K)))
)
,
writeln(Ks),
member(K1, Ks),
\+ currently_defined(K1),
queue_in(K1),
@ -169,11 +162,19 @@ do_propagate(K) :-
do_propagate(_K) :-
propagate.
add_factor(factor(Type, Id, Ks, _, Phi, Constraints), Ks) :-
( is_list(Phi) -> CPT = Phi ; call(user:Phi, CPT) ),
add_factor(factor(Type, Id, Ks, _, _Phi, Constraints), NKs) :-
( Ks = [K,agg(Els)]
->
NKs=[K|Els]
;
NKs = Ks
),
run(Constraints), !,
\+ f(Type, Id, Ks),
assert(f(Type, Id, Ks)).
\+ f(Type, Id, NKs),
assert(f(Type, Id, NKs)).
fetch_list((A,agg(B)), A, B).
run([Goal|Goals]) :-
call(user:Goal),

4
packages/CLPBN/examples/School/parschema.yap
View File

@ -29,9 +29,9 @@ bayes grade(C,S)::[a,b,c,d], int(S), diff(C) ; grade_table ; [registration(_,C,S
bayes satisfaction(C,S)::[h,m,l], abi(P), grade(C,S) ; sat_table ; [reg_satisfaction(C,S,P)].
bayes rat(C) :: [h,m,l], avg(Sats) ; avg ; [course_rat(C, Sats)].
bayes rat(C) :: [h,m,l], agg(Sats) ; avg ; [course_rat(C, Sats)].
bayes rank(S) :: [a,b,c,d], avg(Grades) ; avg ; [student_ranking(S,Grades)].
bayes rank(S) :: [a,b,c,d], agg(Grades) ; avg ; [student_ranking(S,Grades)].
grade(Key, Grade) :-

9
packages/CLPBN/pfl.yap
View File

@ -11,6 +11,7 @@
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/4, %add a new bayesian variable (for now)
op(550,yfx,@),
op(550,yfx,::),
op(1150,fx,bayes),
@ -69,6 +70,12 @@ Id@N :-
fail.
_Id@_N.
add_ground_factor(bayes, Domain, Vars, CPT) :-
Vars = [K|_],
( skolem(K,_Domain) -> true ; assert(skolem(K, Domain)) ),
new_id(Id),
assert(factor(bayes, Id, Vars, [], CPT, true)).
defined_in_factor(Key, Factor) :-
skolem_in(Key, Id),
factor(bayes, Id, [Key|FList], FV, Phi, Constraints), !,
@ -95,6 +102,8 @@ new_id(Id) :-
Id is Id0+1,
assert(id(Id)).
process_args(V, _Id, _I0, _I ) --> { var(V) }, !,
{ throw(error(instantiation_error,pfl:process_args)) }.
process_args((Arg1,Arg2), Id, I0, I ) --> !,
process_args(Arg1, Id, I0, I1),
process_args(Arg2, Id, I1, I).