diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap index 321cadaaa..79185877d 100644 --- a/packages/CLPBN/clpbn.yap +++ b/packages/CLPBN/clpbn.yap @@ -5,7 +5,6 @@ set_clpbn_flag/2, clpbn_flag/3, clpbn_key/2, - clpbn_language/1, clpbn_init_solver/4, clpbn_run_solver/3, clpbn_finalize_solver/1, @@ -14,6 +13,7 @@ clpbn_init_graph/1, probability/2, conditional_probability/3, + use_parfactors/1, op( 500, xfy, with)]). :- use_module(library(atts)). @@ -118,7 +118,7 @@ [clpbn2gviz/4]). :- use_module(clpbn/ground_factors, - [generate_bn/2]). + [generate_network/4]). :- dynamic solver/1,output/1,use/1,suppress_attribute_display/1, parameter_softening/1, em_solver/1, use_parfactors/1. @@ -147,9 +147,6 @@ clpbn_flag(output,Before,After) :- clpbn_flag(solver,Before,After) :- retract(solver(Before)), assert(solver(After)). -clpbn_flag(language,Before,After) :- - retract(clpbn_language(Before)), - assert(clpbn_language(After)). clpbn_flag(em_solver,Before,After) :- retract(em_solver(Before)), assert(em_solver(After)). @@ -253,10 +250,12 @@ project_attributes(GVars, AVars0) :- ). project_attributes(_, _). -generate_vars(GVars, _, NewAVars) :- +generate_vars(GVars, _, _NewAVars) :- use_parfactors(on), clpbn_flag(solver, Solver), Solver \= fove, !, - generate_bn(GVars, NewAVars). + generate_network(GVars, Keys, Factors, Evidence), + writeln(network(GVars, Keys, Factors, Evidence)), + halt. generate_vars(_GVars, AVars, AVars). clpbn_vars(AVars, DiffVars, AllVars) :- @@ -560,18 +559,5 @@ match_probability([p(V0=C)=Prob|_], C, V, Prob) :- match_probability([_|Probs], C, V, Prob) :- match_probability(Probs, C, V, Prob). -:- dynamic clpbn_language/1. - -pfl_not_clpbn :- - clpbn_language(clpbn), !, - throw(error(pfl('should be called before clpbn'))). -pfl_not_clpbn :- - assert(clpbn_language(pfl)). - -clpbn_not_pfl :- - clpbn_language(pfl), !. -clpbn_not_pfl :- - assert(clpbn_language(clpbn)). - -:- clpbn_not_pfl. +:- use_parfactors(on) -> true ; assert(use_parfactors(off)). diff --git a/packages/CLPBN/clpbn/bp.yap b/packages/CLPBN/clpbn/bp.yap index 5d0ba074b..96ecd6122 100644 --- a/packages/CLPBN/clpbn/bp.yap +++ b/packages/CLPBN/clpbn/bp.yap @@ -8,7 +8,6 @@ :- module(clpbn_bp, [bp/3, check_if_bp_done/1, - set_horus_flag/2, init_bp_solver/4, run_bp_solver/3, finalize_bp_solver/1 @@ -31,12 +30,12 @@ [check_for_agg_vars/2]). +:- use_module(library(clpbn/horus)). + :- use_module(library(atts)). :- use_module(library(lists)). :- use_module(library(charsio)). -:- use_module(horus). - :- attribute id/1. diff --git a/packages/CLPBN/clpbn/dists.yap b/packages/CLPBN/clpbn/dists.yap index e1ab76389..837edf85f 100644 --- a/packages/CLPBN/clpbn/dists.yap +++ b/packages/CLPBN/clpbn/dists.yap @@ -31,13 +31,16 @@ :- use_module(library(lists),[nth0/3,append/3]). +:- use_module(library(clpbn), + [use_parfactors/1]). + :- use_module(library(matrix), [matrix_new/4, matrix_new/3, matrix_to_list/2, matrix_to_logs/1]). -:- use_module(library('clpbn/matrix_cpt_utils'), +:- use_module(library(clpbn/matrix_cpt_utils), [random_CPT/2, uniform_CPT/2]). @@ -226,7 +229,7 @@ get_dist_params(Id, Parms) :- recorded(clpbn_dist_db, db(Id, _, Parms, _, _, _, _), _). get_dist_domain_size(DistId, DSize) :- - clpbn:clpbn_language(pfl), !, + use_parfactors(on), !, pfl:get_pfl_parameters(DistId, Dist), length(Dist, DSize). get_dist_domain_size(avg(D,_), DSize) :- !, @@ -240,7 +243,7 @@ get_dist_domain(Id, Domain) :- recorded(clpbn_dist_db, db(Id, _, _, _, Domain, _, _), _). get_dist_key(Id, Key) :- - clpbn:clpbn_language(pfl), !, + use_parfactors(on), !, pfl:get_first_pvariable(Id, Key). get_dist_key(Id, Key) :- recorded(clpbn_dist_db, db(Id, Key, _, _, _, _, _), _). @@ -273,7 +276,7 @@ get_evidence_from_position(El, Id, Pos) :- dist_to_term(_Id,_Term). empty_dist(Dist, TAB) :- - clpbn:clpbn_language(pfl), !, + use_parfactors(on), !, pfl:get_pfl_factor_sizes(Dist, DSizes), matrix_new(floats, DSizes, TAB). empty_dist(Dist, TAB) :- @@ -283,7 +286,7 @@ empty_dist(Dist, TAB) :- throw(error(domain_error(no_distribution,Dist),empty_dist(Dist,TAB))). dist_new_table(DistId, NewMat) :- - clpbn:clpbn_language(pfl), !, + use_parfactors(on), !, matrix_to_list(NewMat, List), pfl:set_pfl_parameters(DistId, List). dist_new_table(Id, NewMat) :- @@ -314,7 +317,7 @@ randomise_all_dists. randomise_dist(Dist) :- ( - clpbn:clpbn_language(pfl) + use_parfactors(on) -> pfl:get_pfl_factor_sizes(Dist, DSizes) ; @@ -330,7 +333,7 @@ uniformise_all_dists. uniformise_dist(Dist) :- ( - clpbn:clpbn_language(pfl) + use_parfactors(on) -> pfl:get_pfl_factor_sizes(Dist, DSizes) ; diff --git a/packages/CLPBN/clpbn/fove.yap b/packages/CLPBN/clpbn/fove.yap index fa9891b02..ead10249a 100644 --- a/packages/CLPBN/clpbn/fove.yap +++ b/packages/CLPBN/clpbn/fove.yap @@ -8,7 +8,6 @@ :- module(clpbn_fove, [fove/3, check_if_fove_done/1, - set_horus_flag/2, init_fove_solver/4, run_fove_solver/3, finalize_fove_solver/1 @@ -24,7 +23,7 @@ :- use_module(library(pfl), - [factor/5, + [factor/6, skolem/2 ]). @@ -69,7 +68,7 @@ get_parfactors(Factors) :- findall(F, is_factor(F), Factors). is_factor(pf(Id, Ks, Rs, Phi, Tuples)) :- - factor(Id, Ks, Vs, Table, Constraints), + factor(_Type, Id, Ks, Vs, Table, Constraints), get_ranges(Ks,Rs), Table \= avg, gen_table(Table, Phi), diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap index 47d5392f8..a84aa9e0f 100644 --- a/packages/CLPBN/clpbn/ground_factors.yap +++ b/packages/CLPBN/clpbn/ground_factors.yap @@ -8,31 +8,39 @@ :- module(clpbn_ground_factors, [ - generate_bn/2, - ground_parfactors/1]). + generate_network/4]). :- use_module(library(bhash), [ b_hash_new/1, b_hash_lookup/3, b_hash_insert/4]). +:- use_module(library(lists), [ + delete/3, + member/2]). + :- use_module(library(pfl), [ - factor/5, + factor/6, + defined_in_factor/2, skolem/2]). :- use_module(library(clpbn/dists), [ dist/4]). +:- dynamic currently_defined/1, f/3. -% -% generate a CLP(BN) network that can be run in CLP(BN). -% -generate_bn(QueryVars, AllAttVars) :- +generate_network(QueryVars, Keys, Factors, Evidence) :- attributes:all_attvars(AVars), - b_hash_new(H0), check_for_evidence(AVars, EVars), - run_through_factors(QueryVars, H0, H1, AllAttVars, IVars), - run_through_factors(EVars, H1, _HF, IVars, []). + retractall(currently_defined(_)), + retractall(f(_,_,_)), + initialize_evidence(EVars), + findall(K, currently_defined(K), Evidence), + run_through_factors(QueryVars), + run_through_factors(EVars), + findall(K, currently_defined(K), Keys), + findall(f(FType,FKeys,FCPT), f(FType,FKeys,FCPT), Factors), + listing(f). check_for_evidence(V.AVars, V.EVars) :- clpbn:get_atts(V,[evidence(_E)]), !, @@ -41,192 +49,38 @@ check_for_evidence(_V.AVars, EVars) :- check_for_evidence(AVars, EVars). check_for_evidence([], []). -run_through_factors([], H, H) --> []. -run_through_factors(V.Vars, H0, HF) --> - { clpbn:get_atts(V,[key(K)]), - b_hash_lookup(K,V,H0) - }, !, - run_through_factors(Vars, H0, HF). -run_through_factors(V.Vars, H0, HF) --> - % it is a new clpbn variable - [V], - { - % should already have a key - clpbn:get_atts(V,[key(K)]), - % insert it into a table of seen variables - b_hash_insert(H0,K,V,HI), - construct_clpbn_node(K, V, HI, MoreVars, Vars) - }, - run_through_factors(MoreVars, HI, HF). +run_through_factors([]). +run_through_factors([Var|_QueryVars]) :- + clpbn:get_atts(Var,[key(K)]), + find_factors(K), + fail. +run_through_factors([_|QueryVars]) :- + run_through_factors(QueryVars). -% aggregates are special. -construct_clpbn_node(K, V, HI) --> - % and get the corresponding factor - { factor(_Id, [K|Ks], _, avg, Constraints) }, !, - { - skolem(K, Domain), - dist(avg(Domain, Parents), DistId, K, Parents), - clpbn:put_atts(V,[dist(DistId,Parents)]), - % we also need to set the constraints - % this should set all the keys to rights - run(Constraints) - }, - % now let's look up parents and set up the graph - run_bayesian_factor(Ks, HI, Parents, []). -construct_clpbn_node(K, V, HI) --> - { - % and get the corresponding factor - factor(Id, [K|Ks], _, _Phi, Constraints), - factor_to_dist(Id, DistId), - % and the dist constraint - clpbn:put_atts(V,[dist(DistId,Parents)]), - % we also need to set the constraints - % this should set all the keys to rights - run(Constraints) - }, - % now let's look up parents and set up the graph - run_bayesian_factor(Ks, HI, Parents, []). +initialize_evidence([]). +initialize_evidence([V|EVars]) :- + clpbn:get_atts(V, [key(K)]), + assert(currently_defined(K)), + initialize_evidence(EVars). -factor_to_dist(Id, NewId) :- - factor(Id, [K|Ks], _, Phi, _Constraints), - skolem(K, Domain), - ( is_list(Phi) - -> - CPT = Phi - ; - call(user:Phi, CPT) - ), - keys_to_sizes(Ks, Szs), - dist(p(Domain, CPT, Szs), NewId, K, Szs). - -keys_to_sizes([], []). -keys_to_sizes(K.Ks, Sz.Szs) :- - skolem(K, Domain), - length(Domain, Sz), - keys_to_sizes(Ks, Szs). +% +% gets key K, and collects factors that define it +find_factors(K) :- + assert(currently_defined(K)), + defined_in_factor(K, ParFactor), + add_factor(ParFactor, Ks), + member(K1, Ks), + \+ currently_defined(K1), + find_factors(K1). +add_factor(factor(Type, _Id, Ks, _, CPT, Constraints), Ks) :- + F = f(Type, Ks, CPT), + run(Constraints), + \+ f(Type, Ks, CPT), + assert(F). + +run([Goal|Goals]) :- + call(user:Goal), + run(Goals). run([]). -run(Goal.Constraints) :- - user:Goal, !, - run(Constraints). -run_bayesian_factor([], _H, Vs, Vs) --> []. -run_bayesian_factor(K.Ks, H, Vs, Vs0) --> - run_var(K, H, Vs, Vs1), - run_bayesian_factor(Ks, H, Vs1, Vs0). - -% -% this function returns a list of *new* variables -% -% collection of random variables -run_var(avg(Els), H, Vs, Vs0) --> !, - run_vars(Els, H, Vs, Vs0). -% existing random variable -run_var(K, H, V.Vs, Vs) --> - { b_hash_lookup(K,V,H) }, !. -% new random variable -run_var(K, _H, V.Vs, Vs) --> - [V], - { - clpbn:put_atts(V,[key(K)]) - }. - -run_vars([], _H, Vs, Vs) --> []. -run_vars(K.Els, H, Vs, Vs0) --> - run_var(K, H, Vs, VsI), - run_vars(Els, H, VsI, Vs0). - -ground_parfactors(ParFactors) :- - findall(Factor, factor(Factor), SourceFactors), - run_all_parfactors(SourceFactors, ParFactors). - -factor(Factor) :- - user:parfactor(Factor). -factor(Factor) :- - user:bayes(Factor). - -run_all_parfactors([], []). -run_all_parfactors(Source.SourceFactors, Factor.ParFactors) :- - run_parfactors(Source, Factor), - run_all_parfactors(SourceFactors, ParFactors). - -run_parfactors((Formula ; Phi ; ConstraintGenerator), parfactor(Formula, Phi, FV, Domain, NewConstraints)) :- - term_variables(Formula, FreeVars), - FV =.. fv(FreeVars), - evaluate_constraints(FV, ConstraintGenerator, NewConstraints, Domain). - -evaluate_constraints(FreeVars, Constraint.ConstraintGenerators, NC, Domain) :- - functor(FreeVars, fv, NOf), - setof(FreeVars, user:Constraint, Bindings), - run_free_vars(0, NOf, FreeVars, Bindings, Domain, Domain0), - get_list_of_conditions(Domain, 0, N, Conditions), - add_extra_constraints(N, Conditions, Bindings, NC, NC0), - evaluate_constraints(FreeVars, ConstraintGenerators, NC0, Domain0). -evaluate_constraints(_FreeVars, [], []). - -run_free_vars(N, N, _FreeVars, _Bindings) --> !. -run_free_vars(I0, N, FreeVars, Bindings) --> - { I is I0+1, - arg(I, FreeVars, V), - Bindings = B._, - arg(I, B, C), ground(C) - }, !, - { setof(C, check_val(Bindings, I, C), Dom) }, - [domain(I,V,Dom)], - run_free_vars(I, N, FreeVars, Bindings). -run_free_vars(I0, N, FreeVars, Bindings) --> - I is I0+1, - run_free_vars(I, N, FreeVars, Bindings). - -add_extra_constraints(0, [], _Bindings) --> !. -add_extra_constraints(1, _Conditions, _Bindings) --> !. -add_extra_constraints(N, Conditions, Bindings) --> - { extract_unique(Conditions, NewConditions) }, !, - { N1 is N-1 }, - add_extra_constraints(N1, NewConditions, Bindings). -add_extra_constraints(N, [dom(I1,V1,Dom1),dom(I2,V2,Dom2)|Conditions], Bindings) --> - { length(Dom1, Sz), length(Dom2, Sz) }, !, - { N1 is N-2 }, - { generate_map(Bindings, I1, I2, Mapping) }, - [map(V1,V2,Mapping)], - add_extra_constraints(N1, dom(I1,V1,Dom1).Conditions, Bindings). -add_extra_constraints(_N, Conditions, Bindings) --> - [or(Vs,Or)], - { gather_vs(Conditions, Vs, Indices), - generate(Bindings, Indices, Or) }. - -% domain is a singleton constant -extract_unique(domain(_,_,[_]).Conditions, Conditions) :- !. -extract_unique(_.Conditions, NewConditions) :- - extract_unique(Conditions, NewConditions). - -get_list_of_conditions([], N, N, []). -get_list_of_conditions(Dom._, N, N, _Conditions) :- - var(Dom), !. -get_list_of_conditions(Dom.Domain, I0, N, Dom.Conditions) :- - I is I0+1, - get_list_of_conditions(Domain, I, N, Conditions). - -check_val(B._Bindings, I, C) :- - arg(I, B, C). -check_val(_.Bindings, I, C) :- - check_val(Bindings, I, C). - -generate_map(B.Bindings, I1, I2, [[A1|A2]|Mapping]) :- - arg(I1, B, A1), - arg(I2, B, A2), - generate_map(Bindings, I1, I2, Mapping). - -gather_vs([], [], []). -gather_vs(domain(I,V,_).Conditions, V.Vs, I.Indices) :- - gather_vs(Conditions, Vs, Indices). - -generate([], _, []). -generate(B.Bindings, Indices, O.Or) :- - generate_el(B, Indices, O), - generate(Bindings, Indices, Or). - -generate_el(_B, [], []). -generate_el(B, I.Indices, A.O) :- - arg(I, B, A), - generate_el(B, Indices, O). diff --git a/packages/CLPBN/clpbn/horus.yap b/packages/CLPBN/clpbn/horus.yap index 8a8209546..04201e1b4 100644 --- a/packages/CLPBN/clpbn/horus.yap +++ b/packages/CLPBN/clpbn/horus.yap @@ -13,4 +13,13 @@ free_parfactor_graph/1 ]). -:- load_foreign_files(['horus'], [], init_predicates). +patch_things_up :- + assert_static(clpbn_horus:set_horus_flag(_,_)). + +warning :- + format(user_error,"Horus library not installed: cannot use bp, fove~n.",[]). + +:- catch(load_foreign_files(['horus'], [], init_predicates), _, patch_things_up) -> true ; warning. + + + diff --git a/packages/CLPBN/examples/School/school32_data.yap b/packages/CLPBN/examples/School/school32_data.yap index 64c85522d..9614991d8 100644 --- a/packages/CLPBN/examples/School/school32_data.yap +++ b/packages/CLPBN/examples/School/school32_data.yap @@ -412,7 +412,7 @@ registration(r52,c27,s16). registration(r53,c26,s16). registration(r54,c6,s17). registration(r55,c27,s17). -%registration(r56,c0,s17). +registration(r56,c0,s17). registration(r57,c51,s18). registration(r58,c63,s18). registration(r59,c41,s18). @@ -425,7 +425,7 @@ registration(r65,c22,s20). registration(r66,c43,s20). registration(r67,c17,s21). registration(r68,c34,s21). -%registration(r69,c0,s21). +registration(r69,c0,s21). registration(r70,c42,s22). registration(r71,c7,s22). registration(r72,c46,s22). @@ -515,7 +515,7 @@ registration(r155,c57,s46). registration(r156,c25,s46). registration(r157,c46,s46). registration(r158,c15,s46). -%registration(r159,c0,s47). +registration(r159,c0,s47). registration(r160,c33,s47). registration(r161,c30,s47). registration(r162,c55,s47). @@ -544,7 +544,7 @@ registration(r184,c50,s54). registration(r185,c43,s54). registration(r186,c55,s54). registration(r187,c14,s55). -%registration(r188,c0,s55). +registration(r188,c0,s55). registration(r189,c31,s55). registration(r190,c47,s55). registration(r191,c50,s56). @@ -600,7 +600,7 @@ registration(r240,c20,s71). registration(r241,c18,s71). registration(r242,c38,s71). registration(r243,c37,s72). -%registration(r244,c0,s72). +registration(r244,c0,s72). registration(r245,c62,s72). registration(r246,c47,s73). registration(r247,c53,s73). @@ -1140,7 +1140,7 @@ registration(r780,c51,s233). registration(r781,c8,s233). registration(r782,c58,s233). registration(r783,c14,s234). -registration(r784,c0,s234). +%registration(r784,c0,s234). registration(r785,c23,s234). registration(r786,c59,s234). registration(r787,c5,s235). @@ -1161,7 +1161,7 @@ registration(r801,c45,s239). registration(r802,c47,s239). registration(r803,c7,s240). registration(r804,c4,s240). -registration(r805,c0,s240). +%registration(r805,c0,s240). registration(r806,c54,s240). registration(r807,c9,s240). registration(r808,c11,s241). @@ -1169,7 +1169,7 @@ registration(r809,c29,s241). registration(r810,c45,s241). registration(r811,c58,s241). registration(r812,c48,s242). -registration(r813,c0,s242). +%registration(r813,c0,s242). registration(r814,c51,s242). registration(r815,c12,s243). registration(r816,c24,s243). @@ -1212,6 +1212,6 @@ registration(r852,c7,s254). registration(r853,c61,s254). registration(r854,c60,s255). registration(r855,c48,s255). -registration(r856,c0,s255). +%registration(r856,c0,s255). diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap index d4380f43d..1746849df 100644 --- a/packages/CLPBN/pfl.yap +++ b/packages/CLPBN/pfl.yap @@ -4,16 +4,17 @@ % :- module(pfl, [ - factor/5, + factor/6, skolem/2, + defined_in_factor/2, 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 + op(550,yfx,@), op(550,yfx,::), op(1150,fx,bayes), - op(1150,fx,markov), - op(1150,fx,parfactor)]). + op(1150,fx,markov)]). :- use_module(library(lists), [nth0/3, @@ -23,33 +24,66 @@ :- dynamic factor/5, skolem_in/2, skolem/2, preprocess/3, evidence/2, id/1. :- reexport(library(clpbn), - [clpbn_flag/2, - clpbn_flag/2 as pfl_flag, - set_clpbn_flag/2, + [clpbn_flag/2 as pfl_flag, set_clpbn_flag/2 as set_pfl_flag]). -:- set_pfl_flag(use_factors,on). +:- ( % if clp(bn) has done loading, we're top-level + predicate_property(set_pfl_flag(_,_), imported_from(clpbn)) + -> + % we're using factor language + % set appropriate flag + set_pfl_flag(use_factors,on) + ; + % we're within clp(bn), no need to do anything + true + ). -:- pfl_not_clpbn. - -user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :- +user:term_expansion( bayes((Formula ; Phi ; Constraints)), pfl:factor(bayes,Id,FList,FV,Phi,Constraints)) :- !, term_variables(Formula, FreeVars), FV =.. [fv|FreeVars], new_id(Id), process_args(Formula, Id, 0, _, FList, []). -user:term_expansion( markov((Formula ; Phi ; Constraints)), pfl:factor(Id,FList,FV,Phi,Constraints)) :- +user:term_expansion( markov((Formula ; Phi ; Constraints)), pfl:factor(markov,Id,FList,FV,Phi,Constraints)) :- !, term_variables(Formula, FreeVars), FV =.. [fv|FreeVars], new_id(Id), process_args(Formula, Id, 0, _, FList, []). +user:term_expansion( Id@N, L ) :- + atom(Id), number(N), !, + findall(G,generate_entity(0, N, Id, G), L). user:term_expansion( Goal, [] ) :- preprocess(Goal, Sk,Var), !, (ground(Goal) -> true ; throw(error('non ground evidence',Goal))), % prolog_load_context(module, M), assert(pfl:evidence(Sk,Var)). +Id@N :- + generate_entity(0, N, Id, G), + assert_static(user:G), + fail. +_Id@_N. + +defined_in_factor(Key, Factor) :- + skolem_in(Key, Id), + factor(bayes, Id, [Key|FList], FV, Phi, Constraints), !, + Factor = factor(bayes, Id, [Key|FList], FV, Phi, Constraints). +defined_in_factor(Key, Factor) :- + skolem_in(Key, Id), + factor(markov, Id, FList, FV, Phi, Constraints), + member(Key, FList), + Factor = factor(markov, Id, FList, FV, Phi, Constraints). + + +generate_entity(N, N, _, _) :- !. +generate_entity(I0, _N, Id, T) :- + atomic_concat(person_, I0, P), + T =.. [Id, P]. +generate_entity(I0, N, Id, T) :- + I is I0+1, + generate_entity(I, N, Id, T). + id(0). new_id(Id) :- @@ -110,19 +144,19 @@ add_evidence(Sk,Var) :- get_pfl_parameters(Id,Out) :- - factor(Id,_FList,_FV,Phi,_Constraints), - writeln(factor(Id,_FList,_FV,_Phi,_Constraints)), + factor(_Type,Id,_FList,_FV,Phi,_Constraints), + writeln(factor(_Type,Id,_FList,_FV,_Phi,_Constraints)), ( is_list(Phi) -> Out = Phi ; call(user:Phi, Out) ). new_pfl_parameters(Id, NewPhi) :- - retract(factor(Id,FList,FV,_Phi,Constraints)), - assert(factor(Id,FList,FV,NewPhi,Constraints)), + retract(factor(Type.Id,FList,FV,_Phi,Constraints)), + assert(factor(Type,Id,FList,FV,NewPhi,Constraints)), fail. new_pfl_parameters(_Id, _NewPhi). get_pfl_factor_sizes(Id, DSizes) :- - factor(Id, FList, _FV, _Phi, _Constraints), + factor(_Type, Id, FList, _FV, _Phi, _Constraints), get_sizes(FList, DSizes). get_sizes([], []). @@ -133,11 +167,11 @@ get_sizes(Key.FList, Sz.DSizes) :- % only makes sense for bayesian networks get_first_pvariable(Id,Var) :- - factor(Id,Var._FList,_FV,_Phi,_Constraints). + factor(_Type, Id,Var._FList,_FV,_Phi,_Constraints). % only makes sense for bayesian networks get_factor_pvariable(Id,Var) :- - factor(Id,FList,_FV,_Phi,_Constraints), + factor(_Type, Id,FList,_FV,_Phi,_Constraints), member(Var, FList).