Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(grammars, Daniel@0: [ model_name/2 Daniel@0: , model_module_prep/3 Daniel@0: , build_options/2 Daniel@0: , build_subset_options/2 Daniel@0: , learn/6 Daniel@0: , learn_bpe/6 Daniel@0: , learn_model/7 Daniel@0: , model_sequence_parses/4 Daniel@0: , nnums_ivals/2 Daniel@0: , restart_prism/0 Daniel@0: , best_first/6 Daniel@0: , method_model_dataset_results/4 Daniel@0: , dataset_num_events/2 Daniel@0: ]). Daniel@0: Daniel@0: :- multifile dataset_sequences/2. Daniel@0: Daniel@0: :- use_module(library(memo)). Daniel@0: :- use_module(library(typedef)). Daniel@0: :- use_module(library(lambda)). Daniel@0: :- use_module(library(plml)). Daniel@0: :- use_module(library(prism/prism)). Daniel@0: :- use_module(library(argutils)). Daniel@0: :- use_module(library(snobol)). Daniel@0: Daniel@0: :- type pmodule == ground. Daniel@0: :- type natural == nonneg. Daniel@0: :- type prep == callable. Daniel@0: :- type options == ordset. Daniel@0: :- type model ---> model(atom, list, prep, list(pair(ground,list(number)))). Daniel@0: :- type method ---> vb(ground) ; map(ground). Daniel@0: :- type matlab_method ---> vb ; map. Daniel@0: Daniel@0: % % hmmmn.. maybe module issues here... Daniel@0: % error:has_type(\Checker,Term) :- call(Checker,Term). Daniel@0: error:has_type(ordset,Term) :- is_ordset(Term). Daniel@0: Daniel@0: :- persistent_memo Daniel@0: learn( +method, +pmodule, +prep, +dataset:ground, +options, -scores:list), Daniel@0: learn_model( +method, +pmodule, +prep, +dataset:ground, +options, -scores:list, -model), Daniel@0: dataset_num_events( +dataset:ground, -num_events:nonneg). Daniel@0: Daniel@0: dataset_num_events(Dataset,NumEvents) :- Daniel@0: dataset_sequences(Dataset,Seqs), Daniel@0: maplist(length,Seqs,Lens), Daniel@0: sumlist(Lens,NumEvents). Daniel@0: % aggregate_all(sum(L),(member(S,Seqs),length(S,L)),NumEvents). Daniel@0: Daniel@0: :- initialization memo_attach(memo(learned),[]). Daniel@0: :- setting(timeout, number, 900, 'Time limit for learning in seconds'). Daniel@0: Daniel@0: user:file_search_path(prism,'psm'). Daniel@0: user:matlab_path(grammars,['stats/hmm']). Daniel@0: Daniel@0: partition_options([],[],[],[]). Daniel@0: partition_options([O|OX],[O|MO],IO,LO) :- option_class(O,model), partition_options(OX,MO,IO,LO). Daniel@0: partition_options([O|OX],MO,[O|IO],LO) :- option_class(O,init), partition_options(OX,MO,IO,LO). Daniel@0: partition_options([O|OX],MO,IO,[O|LO]) :- option_class(O,learn), partition_options(OX,MO,IO,LO). Daniel@0: Daniel@0: option_class(switch_mode(_),model). Daniel@0: option_class(prior_weight(_),model). Daniel@0: option_class(gamut(_),model). Daniel@0: option_class(leap_range(_),model). Daniel@0: option_class(log_scale(_),learn). Daniel@0: option_class(O,init) :- \+option_class(O,model), \+option_class(O,learn). Daniel@0: Daniel@0: option_mlopt(gamut(X-Y),gamut:[X,Y]) :- !. Daniel@0: option_mlopt(init(none),perturb:0) :- !. Daniel@0: option_mlopt(init(perturb(U)),perturb:U) :- !. Daniel@0: option_mlopt(F,N:V) :- F=..[N,V]. Daniel@0: Daniel@0: learn(vb(InitMeth),matlab(Function),Prepare,DataSet,Opts,[free_energy(FE)]) :- !, Daniel@0: dataset_sequences(DataSet, D1), Daniel@0: maplist(Prepare,D1,D), Daniel@0: maplist(option_mlopt,[init(InitMeth)|Opts],Opts1), Daniel@0: compileoptions(Opts1,Opts2), Daniel@0: [float(FE)]===feval(@Function,cell(D),Opts2). Daniel@0: Daniel@0: % method dependent options Daniel@0: Daniel@0: learn(Method,Module,Prepare,DataSet,Opts,Scores) :- Daniel@0: member(Method,[vb(_),map(_)]), Daniel@0: % prepare data Daniel@0: dataset_sequences(DataSet, D1), Daniel@0: maplist(Prepare,D1,D), Daniel@0: % method dependent options Daniel@0: method_switch_mode(Method,Mode), Daniel@0: option(log_scale(LS), Opts, on), Daniel@0: % load up prism and initialise Daniel@0: restart_prism, load_prism(prism(Module)), Daniel@0: #init_model([switch_mode(Mode)|Opts]), Daniel@0: #init_switches(Opts), Daniel@0: set_prism_flag(log_scale,LS), Daniel@0: % allow 15 minutes for learning Daniel@0: setting(timeout, TimeLimit), Daniel@0: get_time(Time), Daniel@0: debug(learn,'Calling PRISM with time limit ~w at ~@...', Daniel@0: [TimeLimit, format_time(current_output,'%T',Time)]), Daniel@0: call_with_time_limit(TimeLimit, prism_learn(Method, D, [], Scores)). Daniel@0: Daniel@0: method_switch_mode(vb(_),a). Daniel@0: method_switch_mode(map(_),d). Daniel@0: Daniel@0: learn_model(Method,Module,Prepare,DataSet,Opts,Scores,model(Module,ModelOpts,Prepare,Counts)) :- Daniel@0: % must re-compute to get final state Daniel@0: compute(learn(Method,Module,Prepare,DataSet,Opts,Scores)), Daniel@0: partition_options(Opts,ModelOpts,_,_), Daniel@0: get_prism_state(ps(_,_,Counts1,_,_,_)), Daniel@0: map_filter(unfixed_count,Counts1,Counts). Daniel@0: Daniel@0: unfixed_count(sw(SW,a,set(unfixed,Counts)), SW-Counts). Daniel@0: Daniel@0: model_initial_state(model(Module,MO,_,_),State) :- Daniel@0: restart_prism, Daniel@0: load_prism(prism(Module)), Daniel@0: #init_model([switch_mode(a)|MO]), Daniel@0: get_prism_state(State). Daniel@0: Daniel@0: with_model_data(model(Module,MO,Prepare,Counts),Data,Goal) :- Daniel@0: restart_prism, load_prism(prism(Module)), Daniel@0: #init_model([switch_mode(a)|MO]), Daniel@0: #maplist(SW-C,set_sw_a(SW,C),Counts), Daniel@0: call(Prepare,Data,D), Daniel@0: call(Goal,D). Daniel@0: Daniel@0: learn_bpe(Method,Module,Prepare,DataSet,Opts,BPE) :- Daniel@0: browse(learn(Method,Module,Prepare,DataSet,Opts,Scores)), Daniel@0: catch( bits_per_event(Method,DataSet,Scores,BPE), _, fail). Daniel@0: Daniel@0: bits_per_event(Method,DS,Scores,BPE) :- Daniel@0: dataset_num_events(DS,NumEvents), Daniel@0: score(Method,NumEvents,Scores,BPE). Daniel@0: Daniel@0: score(map(_),NumEvents,Scores,BitsPerEvent) :- Daniel@0: member(log_lik(LL), Scores), Daniel@0: BitsPerEvent is -(LL/NumEvents)/log(2). Daniel@0: Daniel@0: score(vb(_),NumEvents,Scores,BitsPerEvent) :- Daniel@0: member(free_energy(LL), Scores), Daniel@0: BitsPerEvent is -(LL/NumEvents)/log(2). Daniel@0: Daniel@0: score(vb_pm(_),NumEvents,Scores,BitsPerEvent) :- Daniel@0: member(free_energy(LL), Scores), Daniel@0: BitsPerEvent is -(LL/NumEvents)/log(2). Daniel@0: Daniel@0: %% tree_syntax(+Mod:module,+Tree:prism_tree,-Syntax:tree) is det. Daniel@0: % Daniel@0: % Create a parse tree from a PRISM Viterbi tree. Daniel@0: % Works for models gilbert1, gilbert2, gilbert2a, gilbert3 and gilbert2m. Daniel@0: tree_syntax(Mod,[s(_),TT],T2) :- tree_parse_tree(Mod,TT,T2). Daniel@0: Daniel@0: tree_parse_tree(_,msw(i(I),terminal),node(t(I),[])). Daniel@0: tree_parse_tree(Mod,[pp(s,_,_)|Children],Term) :- member(Mod,[gilbert2,gilbert2a,gilbert3,gilbert2m]), !, Daniel@0: member(msw(s,Rule),Children), Daniel@0: map_filter(tree_parse_tree(Mod),Children,CN), Daniel@0: ( Rule=grow -> CN=[Child1,T1], T1=node(s,Tail), Term=node(s,[Child1|Tail]) Daniel@0: ; Rule=last -> CN=[Child], Term=node(s,[Child]) Daniel@0: ). Daniel@0: tree_parse_tree(Mod,[pp(s,_,_)|Children],Term) :- Mod=gilbert1, !, Daniel@0: member(msw(s,Rule),Children), Daniel@0: map_filter(tree_parse_tree(Mod),Children,CN), Daniel@0: ( Rule=grow -> CN=[Child1,T1], T1=node(s,Tail), Term=node(s,[Child1|Tail]) Daniel@0: ; Rule=first -> CN=[], Term=node(s,[]) Daniel@0: ). Daniel@0: tree_parse_tree(Mod,[pp(H,_,_)|Children],Term) :- !, Daniel@0: map_filter(tree_parse_tree(Mod),Children,CN), Daniel@0: member(msw(H,Rule1),Children), Daniel@0: ( Rule1=terminal -> Rule=t; Rule=Rule1), Daniel@0: Term = node(H-Rule,CN). Daniel@0: Daniel@0: :- volatile_memo model_sequence_parses(+ground,+list(ground),+natural,-ground). Daniel@0: Daniel@0: model_sequence_parses(Model,Seq,N,Parses) :- Daniel@0: Model=model(Mod,_,_,_), Daniel@0: with_model_data(Model,Seq,parses(Mod,N,Parses)). Daniel@0: Daniel@0: parses(Mod,N,Parses,Goal) :- Daniel@0: succ(N,M), Daniel@0: findall(P-T,viterbi_tree(M,Goal,P,[],T),ProbsTrees), Daniel@0: append(NProbsTrees,[P0-_],ProbsTrees), Daniel@0: maplist(tree_parse(Mod,P0),NProbsTrees,Parses). Daniel@0: Daniel@0: tree_parse(Mod,P0,P-T,RP-S) :- tree_syntax(Mod,T,S), RP is P/P0. Daniel@0: Daniel@0: Daniel@0: % model declarations Daniel@0: decl_model(markov(nnum,0), p1gram, markovp, with_nnums(s0)). Daniel@0: decl_model(markov(nnum,1), p2gram, markovp, with_nnums(s1)). Daniel@0: decl_model(markov(ival,0), i1gram, markovi, with_ivals(s0)). Daniel@0: decl_model(markov(ival,1), i2gram, markovi, with_ivals(s1)). Daniel@0: decl_model(gilbert(1), gilbert1, gilbert1, with_pre_ivals(s)). Daniel@0: decl_model(gilbert(2), gilbert2, gilbert2, with_ivals(s)). Daniel@0: decl_model(gilbert(3), gilbert3, gilbert3, with_ivals(s)). Daniel@0: decl_model(gilbert(2-a), gilbert2a, gilbert2a, with_ivals(s)). Daniel@0: decl_model(gilbert(2-m), gilbert2m, gilbert2m, with_ivals(s)). Daniel@0: % decl_model(gilbert(4), gilbert1, gilbert1a, with_pre_ivals(s)). Daniel@0: % decl_model(gilbert(5), gilbert2, gilbert2a, with_ivals(s)). Daniel@0: % decl_model(gilbert(6), gilbert3, gilbert3a, with_ivals(s)). Daniel@0: decl_model(hmm(nnum), phmm, phmm, with_nnums(s)). Daniel@0: decl_model(hmm(nnum,NS), Name, phmm, with_nnums(s)) :- atom_concat(phmm,NS,Name). Daniel@0: %decl_model(hmm(ival), ihmm, ihmm, with_ivals(s)). Daniel@0: decl_model(matlab(p1gram), 'ml-p1gram', matlab(p1gram), (=)). Daniel@0: decl_model(matlab(p2gram), 'ml-p2gram', matlab(p2gram), (=)). Daniel@0: decl_model(matlab(phmm), 'ml-phmm', matlab(phmm), (=)). Daniel@0: Daniel@0: model_name(Model,Name) :- decl_model(Model,Name,_,_). Daniel@0: model_module_prep(Model,Module,Prepare) :- decl_model(Model,_,Module,Prepare). Daniel@0: Daniel@0: with_nnums(Head, Seq, Head1) :- Daniel@0: addargs(Head,[Seq],Head1). Daniel@0: Daniel@0: with_ivals(Head, Seq, Head1) :- Daniel@0: nnums_ivals(Seq,Seq1), Daniel@0: addargs(Head,[Seq1],Head1). Daniel@0: Daniel@0: with_pre_ivals(Head, Seq, Head1) :- Daniel@0: nnums_pre_ivals(Seq,Seq1), Daniel@0: addargs(Head,[Seq1],Head1). Daniel@0: Daniel@0: nnums_ivals(NNums,Ivals) :- nnums_post_ivals(NNums,Ivals). Daniel@0: nnums_post_ivals(NNums,Ivals) :- phrase((ivals(NNums),[end]),Ivals,[]). Daniel@0: nnums_pre_ivals(NNums,Ivals) :- phrase(([start],ivals(NNums)),Ivals,[]). Daniel@0: Daniel@0: ivals([X0,X1|Xs]) --> {I1 is X1-X0}, [I1], ivals([X1|Xs]). Daniel@0: ivals([_]) --> []. Daniel@0: Daniel@0: % NB option defaults here must match those in PRISM source files. Daniel@0: model_options(markov(nnum,_)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: optopt(gamut,[40-100]). Daniel@0: Daniel@0: model_options(markov(ival,_)) --> Daniel@0: optopt(prior_shape, [uniform, binomial+uniform, binomial+0.1*uniform]). Daniel@0: Daniel@0: model_options(gilbert(_)) --> Daniel@0: [leap_range((-20)-(20))], Daniel@0: optopt(leap_shape, [uniform, binomial+uniform, binomial+0.1*uniform]), Daniel@0: optopt(pass_shape, [binomial, binomial+uniform, binomial+0.1*uniform]). Daniel@0: Daniel@0: model_options(hmm(nnum)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: anyopt(num_states, [1,2,3,5,7,12,18]), Daniel@0: optopt(trans_self, [1]), Daniel@0: % optopt(gamut,[40-100]). Daniel@0: % anyopt(trans_self, [1]), Daniel@0: anyopt(gamut,[40-100]). Daniel@0: Daniel@0: model_options(hmm(nnum,NS)) --> Daniel@0: [num_states(NS)], Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: optopt(trans_self, [1]), Daniel@0: % optopt(gamut,[40-100]). Daniel@0: % anyopt(trans_self, [1]), Daniel@0: anyopt(gamut,[40-100]). Daniel@0: Daniel@0: model_options(hmm(ival)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: anyopt(num_states, [5,7,12,24]), Daniel@0: [leap_range((-20)-(20))]. Daniel@0: Daniel@0: model_options(matlab(p1gram)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: optopt(gamut,[40-100]). Daniel@0: Daniel@0: model_options(matlab(p2gram)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: optopt(gamut,[40-100]). Daniel@0: Daniel@0: model_options(matlab(phmm)) --> Daniel@0: optopt(prior_shape, [binomial+0.1*uniform, binomial+uniform, uniform]), Daniel@0: anyopt(num_states, [1,2,3,5,7,12,18]), Daniel@0: optopt(gamut,[40-100]). Daniel@0: Daniel@0: model_subset_options(markov(nnum,_)) --> [prior_shape(binomial+0.1*uniform)]. Daniel@0: model_subset_options(markov(ival,_)) --> [prior_shape(binomial+0.1*uniform)]. Daniel@0: model_subset_options(gilbert(_)) --> []. Daniel@0: model_subset_options(hmm(nnum)) --> Daniel@0: [prior_shape(binomial+0.1*uniform)], Daniel@0: anyopt(num_states,[2,5,7,12,18]). Daniel@0: model_subset_options(hmm(ival)) --> Daniel@0: [prior_shape(binomial+0.1*uniform), leap_range((-20)-(20))], Daniel@0: anyopt(num_states,[2,5,7,12]). Daniel@0: Daniel@0: build_options(Model,Opts) :- Daniel@0: build_options(Model,Opts1,[]), Daniel@0: sort(Opts1,Opts). Daniel@0: Daniel@0: build_options(Model) --> Daniel@0: optopt(prior_weight,[0.3,3,10]), % NB have removed 0.1 and 30 Daniel@0: model_options(Model). Daniel@0: Daniel@0: build_subset_options(Model,Opts) :- Daniel@0: build_subset_options(Model,Opts1,[]), Daniel@0: sort(Opts1,Opts). Daniel@0: Daniel@0: build_subset_options(Model) --> Daniel@0: optopt(prior_weight,[0.1,0.3,3,10,30]), Daniel@0: model_subset_options(Model). Daniel@0: Daniel@0: anyopt(Name,Vals) --> {maplist(\X^Y^(Y=..[Name,X]),Vals,Opts)}, any(Opts). Daniel@0: optopt(Name,Vals) --> []; anyopt(Name,Vals). Daniel@0: Daniel@0: best_first(Meth,Mod,Prepare,DS,Opts,learn(Meth,Mod,Prepare,DS,Opts,F)) :- Daniel@0: order_by([asc(F)], learn_bpe(Meth,Mod,Prepare,DS,Opts,F)). Daniel@0: Daniel@0: /* TODO: Daniel@0: Sort out HMM init options. They are all wrong: Daniel@0: init_shape : shape of prior over initial state {uniform} Daniel@0: trans_shape : shape of prior over transition distribution {uniform} Daniel@0: trans_persistence : add self transtion counts {0,1,3} Daniel@0: init_noise : perturbation of initial obs counts {0,0.1} Daniel@0: restarts: {3} Daniel@0: Daniel@0: Daniel@0: Daniel@0: compare p2gram with hmm(1) Daniel@0: */ Daniel@0: Daniel@0: Daniel@0: %% map_filter(+P:pred(A,B),+Xs:list(A),-Ys:list(B)) is det. Daniel@0: % Daniel@0: % map_filter(P,Xs,Ys) is similar to maplist(P,Xs,Ys), except that P is allowed to Daniel@0: % fail and the resulting list Ys contains only those elements Y for which call(P,X,Y). Daniel@0: % P is used as if it was semi-deterministic: only the first solution is accepted. Daniel@0: map_filter(_,[],[]). Daniel@0: map_filter(P,[X|XX],[Y|YY]) :- call(P,X,Y), !, map_filter(P,XX,YY). Daniel@0: map_filter(P,[_|XX],YY) :- map_filter(P,XX,YY). Daniel@0: Daniel@0: user:file_search_path(home,X) :- expand_file_name('~',[X]). Daniel@0: user:file_search_path(prism,home('src/probprog/prism/psm')). Daniel@0: restart_prism :- prism_start('prism.log'). Daniel@0: Daniel@0: retry_on_error(G,M) :- Daniel@0: catch((restart_prism,G,Status=ok), Ex, Status=error(Ex)), Daniel@0: ( Status=ok -> true Daniel@0: ; format('*** terminated with ~w.\n',[Ex]), Daniel@0: shell('say ALERT: THERE WAS AN ERROR!'), Daniel@0: ( succ(N,M) -> retry_on_error(G,N) Daniel@0: ; writeln('failing after too many retries.'), Daniel@0: shell('say ALERT: I AM GIVING UP!'), Daniel@0: shell('say ALERT: I AM GIVING UP!'), Daniel@0: fail Daniel@0: ) Daniel@0: ). Daniel@0: Daniel@0: %% summary_array(+Meth:method,+Models:list(model),+Datasets:list(dataset),-Summary) is det. Daniel@0: summary_array(Meth,Models,Datasets,arr(Summary)) :- Daniel@0: maplist( \Model^RR^maplist(\DS^{arr(R)}^method_model_dataset_results(Meth,Model,DS,R),Datasets,RR), Models,Summary). Daniel@0: Daniel@0: %% method_model_dataset_results(+Method,+Model,+Dataset,Results:list(list(number))) is det. Daniel@0: method_model_dataset_results(Meth,Model,DS,Results) :- bagof( Row, datum(Meth,Model,DS,Row), Results). Daniel@0: Daniel@0: %% datum(+Method:method,+Model:model,+Dataset,-Datum:list(number)) is nondet. Daniel@0: % Daniel@0: % Maps trained models to a numerical tuple consisting of Daniel@0: % the free energy (in bits per event), the prior weight parameter, and one or two Daniel@0: % shape parameters, depending on the model. The shape parameter is 0 for a uniform Daniel@0: % prior, 1 for a binomial prior, and between 0 and 1 for linear interpolation between Daniel@0: % the two. Daniel@0: % Daniel@0: % Grammar models have leap_shape and pass_shape parameters, while the others Daniel@0: % have a single prior_shape parameter. Daniel@0: datum(Meth,gilbert(I),DS,[FE,W,K1,K2]) :- Daniel@0: model_module_prep(gilbert(I),Mod,Prep), Daniel@0: learn_bpe(Meth,Mod,Prep,DS,Opts,FE), Daniel@0: option(prior_weight(W),Opts,1), Daniel@0: option(leap_shape(Sh1),Opts,binomial), Daniel@0: option(pass_shape(Sh2),Opts,uniform), Daniel@0: shape_param(Sh1,K1), Daniel@0: shape_param(Sh2,K2). Daniel@0: Daniel@0: datum(Meth,markov(Rep,Ord),DS,[FE,W,K]) :- Daniel@0: model_module_prep(markov(Rep,Ord),Mod,Prep), Daniel@0: learn_bpe(Meth,Mod,Prep,DS,Opts,FE), Daniel@0: option(prior_weight(W),Opts,1), Daniel@0: option(prior_shape(Sh),Opts,binomial), Daniel@0: shape_param(Sh,K). Daniel@0: Daniel@0: datum(Meth,hmm(Rep),DS,[FE,W,K]) :- Daniel@0: model_module_prep(hmm(Rep),Mod,Prep), Daniel@0: learn_bpe(Meth,Mod,Prep,DS,Opts,FE), Daniel@0: option(prior_weight(W),Opts,1), Daniel@0: option(prior_shape(Sh),Opts,binomial), Daniel@0: shape_param(Sh,K). Daniel@0: Daniel@0: datum(Meth,hmm(Rep,NS),DS,[FE,W,K]) :- Daniel@0: model_module_prep(hmm(Rep),Mod,Prep), Daniel@0: learn_bpe(Meth,Mod,Prep,DS,Opts,FE), Daniel@0: option(num_states(NS),Opts), Daniel@0: option(prior_weight(W),Opts,1), Daniel@0: option(prior_shape(Sh),Opts,binomial), Daniel@0: shape_param(Sh,K). Daniel@0: Daniel@0: datum(Meth,matlab(F),DS,[FE,W,K]) :- Daniel@0: model_module_prep(matlab(F),Mod,Prep), Daniel@0: learn_bpe(Meth,Mod,Prep,DS,Opts,FE), Daniel@0: option(prior_weight(W),Opts,1), Daniel@0: option(prior_shape(Sh),Opts,binomial), Daniel@0: shape_param(Sh,K). Daniel@0: Daniel@0: shape_param(uniform,0). Daniel@0: shape_param(binomial,1). Daniel@0: shape_param(binomial+uniform,0.5). Daniel@0: shape_param(uniform+binomial,0.5). Daniel@0: shape_param(binomial+K*uniform,Lam) :- Lam = 1/(1+K). Daniel@0: