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([], _).