1/*
    2Viral Marketing
    3*/

?- prob(has(2),do(has(3)),P). ?- prob(has(2),has(3),P). */

    9:- use_module(library(mcintyre)).   10
   11:- if(current_predicate(use_rendering/1)).   12:- use_rendering(graphviz).   13:- endif.   14graph(digraph([rankdir="LR"|G])):-
   15    findall(edge(A -> B,[]),
   16      clause(trusts(A,B),_),
   17      G).
   18
   19:- mc.   20
   21:- begin_lpad.   22
   23:- mcaction has/1.
   24
   25has(_):0.1.
   26
   27has(P) :0.4 :- trusts(P, Q), has(Q).
   28
   29trusts(2,1).
   30trusts(3,1).
   31trusts(3,2).
   32trusts(4,1).
   33trusts(4,3).
   34:-end_lpad.