1:- use_module(library(pita)).    2
    3:- if(current_predicate(use_rendering/1)).    4:- use_rendering(c3).    5:- use_rendering(graphviz).    6:- use_rendering(table,[header(['Multivalued variable index','Rule index','Grounding substitution'])]).    7:- endif.    8
    9:- pita.   10
   11:- begin_lpad.   12
   13% path(X,Y) is true if there is a path between nodes X and Y
   14% edge(a,b) indicates that there is an edge between a and b
   15
   16path(X,X).
   17% there is surely a path between a node and itself
   18
   19path(X,Y):- edge(X,Z), a(X,Z), path(Z,Y).
   20% there is surely a path between X and Y if there is another 
   21% node Z such that
   22% there is an edge between X and Z, the abducible fact
   23% representing that edge is selected, and there is a path 
   24% between Z and Y 
   25
   26abducible a(a,b).
   27% fact a(a,b) is abducible
   28edge(a,b):0.1.
   29% there is an edge between a and b with probability 0.1
   30
   31abducible a(b,e).
   32edge(b,e):0.5.
   33
   34abducible a(a,c).
   35edge(a,c):0.3.
   36
   37abducible a(c,d).
   38edge(c,d):0.4.
   39
   40abducible a(d,e).
   41edge(d,e):0.4.
   42
   43abducible a(a,e).
   44edge(a,e):0.1.
   45
   46:- a(X,Y), a(X,Z), Y \= Z.   47% integrity constraints that prevent that two edges with the same 
   48% source node are selected
   49
   50:- end_lpad.   51
   52% predicate to plot the induced graph
   53graph(digraph([rankdir='LR'|G])):-
   54    findall(edge((A -> B),[label=P]),
   55      clause(edge(A,B,_,_),(get_var_n(_,_,_,_,[P|_],_),_)),
   56      G).

?- abd_prob(path(a,e),Prob,Delta). % Prob is the probability that exists a path between a and e % Delta is the set of abducibles that maximizes the joint % probability of the query and the integrity constraint, i.e, % the probabilistic abductive explanation % ?- abd_prob(path(a,e),Prob,Delta). % Prob = 0.1, % Delta = [[a(a, e)]].

% If we set the probability of edge(a,b) to 0.2, % edge(a,b):0.2. % we get % ?- abd_prob(path(a,e),Prob,Delta). % Prob = 0.1, % Delta = [[a(a, b), a(b, e)], [a(a, e)]].

?- abd_bdd_dot_string(path(a,e),BDD,A,B). % Prints the BDD for query path(a,e) % A solid edge indicates a 1-child, a dashed edge indicates a 0-child % and a dotted edge indicates a negated 0-child. % The two tables contain the associations between the rule groundings % and the multivalued variables (abducibles and probabilistic facts) */