diff --git a/evidence.pl b/evidence.pl index 511c822250bfd05d23ba2e2cee5c196183933364..2c2a22ece3017efd2f64bde52a3e5083eaf01824 100644 --- a/evidence.pl +++ b/evidence.pl @@ -1,13 +1,13 @@ /* a quickly hacked computation of dempster combination rule */ -:- module(evidence, [global_bba/3, beliefs/3]). +:- module(evidence, [global_bba/4, beliefs/3]). :- set_prolog_flag(prefer_rationals, true). -%! basic_bbas(+B, +Bis, -BBAs) is det +%! basic_bbas(+B, +Bis, -BBAs, +Opts) is det % % Compute the basic belief assignments of subsets of B in collection % Bis. @@ -17,44 +17,64 @@ % We use the is/2 predicate instead of the more practical #=/2 from % the clp(fd) module because it does not work whith rationals. We plan % to investigate the use of clp(q). -basic_bbas(B, Bis, BBAs) :- +basic_bbas(B, Bis, BBAs, Opts) :- length(B, CardB), - basic_bba2(B, CardB, Bis, BBAs) + basic_bba2(B, CardB, Bis, BBAs, Opts) . %! basic_bba2(+B, +CardB, +Bis, -BBAs) is det % % Utility predicade for basic_bbas/3. -basic_bba2(_, _, [], []). -basic_bba2(B, CardB, [Bi|Bis], [[(Bi, BBABi), (B, BBAB)]|BBAs]) :- +basic_bba2(_, _, [], [], _). +basic_bba2(B, CardB, [Bi|Bis], [[(Bi, BBABi), (B, BBAB)]|BBAs], Opts) :- length(Bi, CardBi), BBABi is CardBi / CardB, BBAB is 1 - BBABi, - basic_bba2(B, CardB, Bis, BBAs) + trace_bba(Bi, Bi, BBABi, Opts, 1), + trace_bba(Bi, B, BBAB, Opts, 1), + basic_bba2(B, CardB, Bis, BBAs, Opts) . +%! trace_bba(+RefSet, +Set, +Value, +Options, +TraceLevel) is det +trace_bba(RefSet, Set, Value, Options, TraceLevel) :- + trace('mu_{~w}(~w) = ~w~n', [RefSet, Set, Value], Options, TraceLevel) + . +trace_bba(_, _, _, _, _). + +trace(Fmt, Args, Options, TraceLevel) :- + memberchk(trace(N), Options), + N #>= TraceLevel, + !, + atom(Fmt), + is_list(Args), + format(Fmt, Args) + . +trace(_, _, _, _). + -%! combinator(+M1, +M2, -M12) is det +%! combinator(+M1, +M2, -M12, +Options) is det % % combines two belief assigments (Dempster rule). % each member of the lists is a tuple (Set, Mass). -combine([], _, []). -combine([Mass1|Masses1], Masses2, RMasses) :- - combine1(Mass1, Masses2, RMasses1), - combine(Masses1, Masses2, RMasses2), +combine([], _, [], _). +combine([Mass1|Masses1], Masses2, RMasses, Opts) :- + combine1(Mass1, Masses2, RMasses1, Opts), + combine(Masses1, Masses2, RMasses2, Opts), append(RMasses1, RMasses2, RMasses) . -combine1(_, [], []). -combine1((Set1, Mass1), [(Set2, _)|L], Result) :- +combine1(_, [], [], _). +combine1((Set1, Mass1), [(Set2, _)|L], Result, Opts) :- ord_intersect(Set1, Set2, []), % empty intersection case - combine1((Set1, Mass1), L, Result) + trace('~w inter ~w = emptyset~n', [Set1, Set2], Opts, 2), + combine1((Set1, Mass1), L, Result, Opts) . -combine1((Set1, Mass1), [(Set2, Mass2)|L], [(RSet, RMass)|Result]) :- +combine1((Set1, Mass1), [(Set2, Mass2)|L], [(RSet, RMass)|Result], Opts) :- ord_intersect(Set1, Set2, RSet), RSet \= [], % nonempty intersection case RMass is Mass1 * Mass2, - combine1((Set1, Mass1), L, Result) + trace('~w inter ~w = ~w : ~w~n', [Set1, Set2, RSet, RMass], Opts, 2), + combine1((Set1, Mass1), L, Result, Opts) . %! normalize(+BBA, -NormBBA) is det @@ -127,20 +147,24 @@ mult(F, [(S1,N1)|L1], [(S1,N2)|L2]) :- -%! global_bba(+B, +Bis, -GBBA) +%! global_bba(+B, +Bis, -GBBA, +Nonorm) % % -global_bba(B, Bis, GBBA) :- - basic_bbas(B, Bis, [B1|BasicBBAs]), - global_bba2(B1, BasicBBAs, GBBA) +global_bba(B, Bis, GBBA, Opts) :- + basic_bbas(B, Bis, [B1|BasicBBAs], Opts), + global_bba2(B1, BasicBBAs, GBBA, Opts) . -global_bba2(B, [], B). -global_bba2(B, [BBa|BBas], GBBA) :- - combine(B, BBa, B1), +global_bba2(B, [], B, _). +global_bba2(B, [BBa|BBas], GBBA, Opts) :- + trace('---- combining ~w & ~w -----------------------------~n', [B, BBa], Opts, 2), + combine(B, BBa, B1, Opts), merge_unique(B1, B2), - normalize(B2, B3), - global_bba2(B3, BBas, GBBA) + ( memberchk(nonorm(true), Opts) + -> B2 = B3 + ; normalize(B2, B3) + ), + global_bba2(B3, BBas, GBBA, Opts) . %! beliefs(+Bis, +GBBA, -Bel) @@ -189,7 +213,7 @@ bi([ test01(GBBA, Bels) :- b(B), bi(Bis), - global_bba(B, Bis, GBBA), + global_bba(B, Bis, GBBA,[nonorm(false),trace(0)]), beliefs(Bis, GBBA, Bels), print_beliefs(Bels) . diff --git a/formula_io.pl b/formula_io.pl index 501657ebf87bc10e71f090c78cb5bbb5b8c87db7..ab246cf586c373670c7ff278efa6a10fd52c7c7b 100644 --- a/formula_io.pl +++ b/formula_io.pl @@ -3,9 +3,13 @@ */ :- module(formula_io, [ load_sof/2, - write_clauses/2 + write_clauses/2, + load_raw_collection/3 ]). +:- use_module(library(apply)). +:- use_module(library(ordsets)). + :-use_module(asp). :-use_module(utils). @@ -58,7 +62,39 @@ write_conjunct(R,Stream) :- nl(Stream) . +%! load_raw_collection(+Filename, -B, -Bis) is det +% +% Load a set B and a collection Bis of subsets of B. +load_raw_collection(FileName, B, Bis) :- + exists_file(FileName), + !, + open(FileName, read, Stream), + ldraw(Stream, B, Bis) + . +load_raw_collection(FileName, _, _) :- + error('~w: not found~n',[FileName]) + . + +ldraw(Stream, B, Bis) :- + read_wff_loop(Stream, Terms), + member(b(Br), Terms), + is_list(Br), + maplist(atom, Br), + list_to_ord_set(Br, B), + member(collec(Bisr), Terms), + is_list(Bisr), + maplist(is_list, Bisr), + check_bis(B, Bisr, Bis) + . +check_bis(_, [], []). +check_bis(B, [Bir|Bisr], [Bi|Bis]) :- + list_to_ord_set(Bir, Bi), + % strict inclusion + ord_subset(Bi, B), + \+ ord_seteq(Bi, B), + check_bis(B, Bisr, Bis) + . diff --git a/utils.pl b/utils.pl index c5d1701453210e59ed6170e99c90ee7b87f4cb17..8bdfa1cdafeabd553bb5802758eb972d8d341742 100644 --- a/utils.pl +++ b/utils.pl @@ -38,14 +38,16 @@ */ :-module(utils,[ - error/2, - error/1, - chars_codes/2, - integer_enum/3, - integer_enuml/3 - ]). + error/2, + error/1, + error_syn/3, + chars_codes/2, + integer_enum/3, + integer_enuml/3 + ]). :-use_module(library(clpfd)). +:-use_module(library(optparse)). %% error(+Msg) @@ -70,6 +72,21 @@ error(Fmt, Args) :- throw(wbel_exception(A)) . +%% error_syn(+Fmt, +Args, +OptSpec) +% +% Formats a message, writes it ont the user_error stream, +% print a syntex helper, then throws a plrsf_exception with the +% same formatted message as argument. + +error_syn(Fmt, Args, OptSpec) :- + format(user_error,Fmt,Args), + format(atom(A),Fmt,Args), + opt_help(OptSpec, Help), + format(user_error, '~w~n', [Help]), + throw(wbel_exception(A)) + . + + %% char_codes (?Chars, Codes) % % From lists of chars to lists of codes. diff --git a/wbel.pl b/wbel.pl index e5db011adba0810c36079e7cbc7a90e13982c3ae..548b59a5b22aaa4fa64361ee399b8ef88ecdda5c 100644 --- a/wbel.pl +++ b/wbel.pl @@ -6,6 +6,7 @@ */ :- use_module(library(clpfd)). :- use_module(library(ordsets)). +:- use_module(library(optparse)). :- use_module(utils). :- use_module(formula_io). @@ -14,7 +15,22 @@ :- use_module(logic). :- use_module(evidence). - +optspec([ + [opt(raw), type(boolean), default(false), shortflags([r]), longflags([raw]), + help(['raw mode : the only input file contains the description of', + 'a collection of subsets of some set. The whole set is described by', + 'a b/1 fact, the argument being the list of elements. The collection', + 'of subsets is described by a collec/1 fact, the argument being ', + 'a list of subsets, each subset beaing in turn a list of elements.'])], + [opt(inclusion), type(boolean), default(false), shortflags([i]), + longflags(['inclusion-max']), + help(['print maximal subsets according wrt set inclusion. This option', + 'is not compatible with --raw'])], + [opt(nonorm), type(boolean), default(false), shortflags([n]), longflags(['no-norm']), + help(['avoid normalization step.'])], + [opt(trace), type(integer), default(0), shortflags([t]), longflags([trace]), + help(['trace the computation.'])] +]). %! go % @@ -25,35 +41,57 @@ go :- -> current_prolog_flag(argv, [_|Args]) ; current_prolog_flag(argv, Args) ), - ( ['-i', BFile, MuFile] = Args - -> OptInc=true - ; ( [BFile, MuFile] = Args - -> OptInc=false - ; error("wrong number of arguments.") + optspec(Spec), + catch(opt_parse(Spec, Args, Opts, PosArgs), Err, error_syn('~w~n', [Err], Spec)), + ( memberchk(raw(true), Opts) + -> ( memberchk(inclusion(true), Opts) + -> error("incompatible options -r and -i") + ; raw_evidence_computation(Opts, PosArgs) ) - ), + ; full_evidence_computation(Opts, PosArgs) + ) + . + +full_evidence_computation(Opts, PosArgs) :- + [BFile, MuFile] = PosArgs, nb_setval(clasppath, '/home/wurbel/local/anaconda3/envs/potassco/bin/clingo'), init_form_atom, init_subform_atom, % temporary file for ASP prog generation. tmp_file(wbel, TmpFile), % Loading B and Mu - [BFile, MuFile] = Args, load_sof(BFile, B), load_sof(MuFile, Mu), generate(B, Mu, TmpFile, Assoc), run([TmpFile], ['--heuristic=Domain', '--enum-mode=domRec'], ASPResults), collect_results(ASPResults, WinclResults), - ( OptInc == true + ( memberchk(inclusion(true), Opts) -> print_wincl(WinclResults, Assoc) ; true ), nb_getval(form_atom, N), generate_b(N, BSelects, f_), - global_bba(BSelects, WinclResults, GBBA), + global_bba(BSelects, WinclResults, GBBA, Opts), beliefs(WinclResults, GBBA, Beliefs), print_beliefs(Beliefs, Assoc) . +full_evidence_computation(_, PosArgs) :- + [_, _] \= PosArgs, + error("Bad number of positional args") + . + +raw_evidence_computation(Opts, PosArgs) :- + [SetFile] = PosArgs, + load_raw_collection(SetFile, B, Bis), + global_bba(B, Bis, GBBA, Opts), + beliefs(Bis, GBBA, Beliefs), + print_raw_beliefs(Beliefs) + . +raw_evidence_computation(_, PosArgs) :- + [_] \= PosArgs, + error("Bad number of positional args") + . + test_wbel(Beliefs) :- % Args = ['tests/exijar-B.form', 'tests/exijar-mu.form'], @@ -90,6 +128,14 @@ test_wbel(Beliefs) :- print_beliefs(Beliefs, Assoc) . +%! print_raw_beliefs(+Bels) is det + +print_raw_beliefs([]). +print_raw_beliefs([(Bi, Bel)|Bels]) :- + format('Bel(~w)=~w~n', [Bi, Bel]), + print_raw_beliefs(Bels) + . + %! print_beliefs(+Bels,+Assoc) is semidet print_beliefs([], _).