Tutorial


Logic Program with Annotated Disjunction

Definition

A Logic Program with Annotated Disjunction (LPAD) consists of a set of rules of the following form:

h_1 : a_1 ; ... ; h_n : a_n :- b_1, ..., b_m. 

where h_i are atoms, b_i are literals and a_i are real numbers between 0 and 1 such that the sum of all a_i is 1. The set of elements h_i : a_i compose the head of a rule, while the set b_i is the body. Disjunction in the head is represented with a semicolon and atoms in the head are separated from probabilities by a colon. If the head of a rule contains only one element h : 1, we can simpy write this element as h, i.e. the clause takes the form of a normal prolog clause. Therefore

h : 1 :- b_1, ..., b_m.

is equivalent to

h :- b_1, ..., b_m.

If the clause has an empty body, it can be represented like this:

h_1 : a_1 ; ... ; h_n : a_n. 

If the sum of all the a_i is smaller than 1, an extra disjunct null is assumed with probability 1 - sum(a_i). Therefore

h_1 : 0.5 ; h_2 : 0.2 :- b_1, ..., b_m. 

is equivalent to

null : 0.3 ; h_1 : 0.5 ; h_2 : 0.2 :- b_1, ..., b_2.

  • Reference: J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated disjunctionsi. In International Conference on Logic Programming, volume 3131 of LNCS, pages 195-209. Springer, 2004.

Back to Index


Coin

This example shows the basic concepts of Logic Programs with Annotated Disjunctions and how to use the tool cplint on SWISH to perform exact inference or simply inference. Let us suppose that we have one coin that we are not sure if it is biased. Now, if we toss the coin, what is the probability that it will land on head?

Writing the program step by step

In our example we want to write a rule which states that if the coin is fair (not biased) and we toss it, it will land on heads with 50% probability and on tail with 50% probability. We can write such a rule as below:

heads(Coin): 1/2; tails(Coin) : 1/2 :- toss(Coin),\+biased(Coin).

Note that 1/2 + 1/2 = 1.

Now we want to write down a second rule which states that if the coin is biased it will land on heads with 60% probability and on tails with 40% probability.

heads(Coin): 0.6 ; tails(Coin) : 0.4 :- toss(Coin), biased(Coin).

We are not sure if the coin is biased or not, we know that there is a 90% probability that the coin is fair and a 10% probability that the coin is biased. Therefore we can write the following probabilistic fact (an LPAD rule without body).

fair(Coin):0.9 ; biased(Coin):0.1.

Finally we state the fact that we will certainly toss the coin. Note: this fact is ground.

toss(coin): 1.

If the head of a rule contains only one element h:1, we can simpy write this element as h. Therefore we can write the previous fact (a fact can be seen as a rule without body) in this way:

toss(coin).

Choosing the editor

Before starting write our program, we need to choose an editor between “Prolog” or “LPAD”. If we choose the “Prolog” editor we need to add some commands before and after our program (see subsection Full program with Prolog editor). Moreover the syntax of the query is different between these two editors.

In this section we will see both editors (subsections Full program with Prolog editor and Full program with LPAD editor). However in the next examples of the tutorial we will use only the “Prolog” editor.

Full program with the Prolog editor {#prolog_editor}

The program is almost complete, what we need now is to load the library pita in order to perform exact inference (if we want to perform approximate inference, instead, we need to load mcintyre, see Coin variant. Therefore we import this library with the built-in predicate use_module/1. So we need to write

:- use_module(library(pita)).

Moreover, after :- use_module(library(pita)) we need to write :- pita. in order to initalize the library and the program should be enclosed by :- begin_lpad. and :- end_lpad. (respectively at the begin and at the end of the program). These goals are mandatory to initialize the inference system.

The full LPAD of this example is shown below.

% load the ‘pita’ library to perform inference
:- use_module(library(pita)).
:- pita.
% to be written before the program
:- begin_lpad.
% Rules
heads(Coin): 1/2; tails(Coin) : 1/2 :- toss(Coin),\+biased(Coin).
heads(Coin): 0.6 ; tails(Coin) : 0.4 :- toss(Coin),biased(Coin).
% Facts
fair(Coin): 0.9 ; biased(Coin): 0.1.
toss(coin).
% to be written after the program
:- end_lpad.

How to execute a query

Ok, we have our program, now what?!

Now it’s time to submit some queries!

To query a program you must use the prob/2 predicate with the following syntax

prob(:Atom, -P).

Atom is the query that we want to perform, while P is the variable that will contain the probability that Atom is true (a float between 0 and 1).

For instance, let us ask for the probability that the tossed coin will land on head. We can do it with the following query

prob(heads(coin),P).

To try this example click on the triangle icon next to the query. We will see that the coin will land on heads with 51% probability. In fact P(heads) = P(heads, fair) + P(heads, biased) = P(heads|fair)P(fair) + P(heads|biased)P(biased) = 0.50.9 + 0.60.1 = 0.51.


Complete example: coin.pl


  • Reference: J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated disjunctions. In International Conference on Logic Programming, volume 3131 of LNCS, pages 195-209. Springer, 2004.

Back to Index


Dice

In this section we illustrate an example that models a game with a six-sided dice. The dice is repeatedly thrown until the outcome is six. When the outcome is six, the game stops. We will show how to perform a simple query, how to perform a conditional query and how to execute a query whose results are graphically represented by a histogram.

Writing the program step by step

First of all we want to write a fact which states that at time 0 the die land on one of its faces with a uniform probability distribution (1/6 for each face). We use the predicate on(T,F) which means that the die landed on face F at time T.

on(0,1):1/6;on(0,2):1/6;on(0,3):1/6;
on(0,4):1/6;on(0,5):1/6;on(0,6):1/6.

The following rule states that at time T the die lands on one of its faces with equal probability if at the previous time point it was thrown and it did not land on face 6.

on(X,1):1/6;on(X,2):1/6;on(X,3):1/6;
on(X,4):1/6;on(X,5):1/6;on(X,6):1/6:-
  X1 is X-1,X1>=0,on(X1,_),
  \+ on(X1,6).

Full program with Prolog editor

Below we can see the full LPAD of the example.

% Load 'pita' library to perform inference
:- use_module(library(pita)).
:- pita.
% to be written before the program
:- begin_lpad.
% T = 0
on(0,1):1/6;on(0,2):1/6;on(0,3):1/6;
on(0,4):1/6;on(0,5):1/6;on(0,6):1/6.
% T > 0
on(X,1):1/6;on(X,2):1/6;on(X,3):1/6;
on(X,4):1/6;on(X,5):1/6;on(X,6):1/6:-
  X1 is X-1,X1>=0,on(X1,_),
  \+ on(X1,6).

evidence:-
  on(0,1),
  on(1,1).

% to be written after the program
:- end_lpad.
    

Now we ask for the probability that the die will land on face 1 at time 0.

prob(on(0,1),P).

At this point we ask for the probability that the die will land on face 1 at time 2. If we submit this query, we can note that the probability that the die will land on one of its faces at time T (with T > 0) decreases. This is because it is the probability that the dice will land on one of its faces at time T and that at time T-1 it did not land on face 6.

prob(on(2,1),P).

We can ask conditional queries with the predicate

prob(:Query:atom,:Evidence:atom,-Probability:float).

For example, we can ask for the probability that the die will land on face 1 at time 2 given that it landed on face 1 at time 0.

prob(on(2,1),on(0,1),P).

If the evidence is composed of more than one atom, add a clause of the form

evidence:- e1,...,en.

to the program, where e1,...,en are the evidence atoms, and use the query

?- prob(goal,evidence,P).

as for example in

prob(on(2,1),evidence,P).

How to execute a query with graphical results

cplint on SWISH can show the probabilistic results of a query as histograms. What we have to do is to use the predicate prob_bar/2 instead of prob/2. This feature, however, it is only supported if we are using the “Prolog” editor, it is NOT supported with the “LPAD” editor.

The syntax is the same as prob/2.

prob_bar(:Atom,-P).

Where Atom is the query that we want to ask, while P is the variable that will contain a bar chart with two bars, one for the probability of the atom of being true and one for the probability of the atom of being false (1- the first). It provides a graphical representation of the difference between the two values.

However, before submitting this kind of query, we need to specify that we want to use the renderer c3 by adding the following line before the :- begin_lpad. goal

:- use_rendering(c3).

Therefore our program becomes

% load the 'pita' library to perform inference
:- use_module(library(pita)).
:- pita.
% load the graphical renderer
:- use_rendering(c3).
% to be written before the program
:- begin_lpad.
% Program
on(0,1):1/6;on(0,2):1/6;on(0,3):1/6;
on(0,4):1/6;on(0,5):1/6;on(0,6):1/6.
on(X,1):1/6;on(X,2):1/6;on(X,3):1/6;
on(X,4):1/6;on(X,5):1/6;on(X,6):1/6:-
X1 is X-1,X1>=0,on(X1,_),
\+ on(X1,6).
% to be written after the program
:- end_lpad.

For istance let us consider again the previous query, this time with a graphical result.

prob_bar(on(2,1), P).

Complete example: dice.pl


  • Reference: J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated disjunctionsi. In International Conference on Logic Programming, volume 3131 of LNCS, pages 195-209. Springer, 2004.

Back to Index


Epidemic

In this section we consider a program which models the fact that if somebody has the flu and the climate is cold, there is the possibility that an epidemic or a pandemic arises. We are uncertain about whether the climate is cold but we know for sure that David and Robert have the flu.

Writing the program step by step

The rule that we want to write is the one which states that, if somebody has the flu and the climate is cold, an epidemic arises with 60% probability, a pandemic arises with 30% probability, whereas we have a 10% probability that neither an epidemic nor a pandemic arises. We can write

epidemic : 0.6; pandemic : 0.3; null: 0.1 :- flu(_), cold.

As we said in Section Logic Program with Annotated Disjunction, the null atom can be implicit. Therefore the previous rule, without changing its meaning, can be written

epidemic : 0.6; pandemic : 0.3 :- flu(_), cold.

The following probabilistic fact says that the weather is cold with a 70% probability. Note that the null atom is implicit here as well.

cold : 0.7.

Now we assert that David and Robert have the flu.

flu(david).
flu(robert).

Full program with the Prolog editor

The full program of the example is show below.

% load the ‘pita’ library to perform inference
:- use_module(library(pita)).
:- pita.
% allows to create graphical results
:- if(current_predicate(use_rendering/1)).
:- use_rendering(c3).
:- endif.
% to be written before the program
:- begin_lpad.
epidemic : 0.6; pandemic : 0.3 :- flu(_), cold.
cold : 0.7.
flu(david).
flu(robert).
% to be written after the program
:- end_lpad.

What is the probability that an epidemic arises? To know it we just have to submit the following query.

prob(epidemic, P).

Let us see the histogram of the previous query

prob_bar(epidemic, P).

This example shows that conclusions from different groundings of a rule are combined with a noisy or rule: the probability of an epidemic is obtained by combining with noisy or the conclusions of the two groundings of the rule where the only variable is replaced by David or Robert. So the probability of an epidemic if cold is true is 0.6+0.6-0.6*0.6=84. Since cold is also uncertain, the overall probability is 0.84*0.7=0.588.


Complete example: epidemic.pl


  • Reference: E. Bellodi and F. Riguzzi. Expectation Maximization over binary decision diagrams for probabilistic logic programs. Intelligent Data Analysis, 17(2):343-363, 2013.

Back to Index


Earthquake

This program models the occurrence of an earthquake depending on its possible causes.

Full program with the Prolog editor

The first rule states that if there is rupture of a geological fault only, we have a strong earthquake with 30% probability, a moderate earthquake with 50% probability and 20% probability to have no earthquake. The second rule states that if there is a volcanic eruption only, we have a strong earthquake with 20% probability, a moderate earthquake with 60% probability and no earthquake with 20% probability. We also know for sure that we have a fault rupture and a volcanic eruption at Stromboli and a volcanic eruption at Eyjafjallajokull (can you pronounce it? :-) ).

% load the ‘pita’ library to perform inference
:- use_module(library(pita)).
% allows to create graphical results
:- if(current_predicate(use_rendering/1)).
:- use_rendering(c3).
:- endif.
:- pita.
% to be written before the program
:- begin_lpad.
% Rules
earthquake(X, strong) : 0.3 ; earthquake(X, moderate) : 0.5 :-
fault_rupture(X).
earthquake(X, strong) : 0.2 ; earthquake(X, moderate) : 0.6 :-
volcanic_eruption(X).
% Facts
fault_rupture(stromboli).
volcanic_eruption(stromboli).
volcanic_eruption(eyjafjallajkull).
% to be written after the program
:- end_lpad.

We can ask the probability of a moderate earthquake at Stromboli by submitting the query:

prob(earthquake(stromboli,moderate), P).

Let us see the histogram of the previous query

prob_bar(earthquake(stromboli,moderate), P).

This example shows that conclusions from different rules are combined with a noisy or rule: the probability of a moderate earthquake at Stromboli is obtained by combining with noisy or the grounding of the first rule and the grounding of the second one, where the only variable is replaced by Stromboli. So the probability of an earthquake at Stromboli is 1-(1-0.5)*(1-0.6)=0.8. Note: if you submit the query the result will be 0.7999999999999998, this is due to numerical approximations performed during the computation.


Complete example: earthquake.pl


  • Reference: F. Riguzzi and N. Di Mauro. Applying the information bottleneck to statistical relational learning. Machine Learning, 86(1):89-114, 2012.

Back to Index


Medical symptoms

The program shown below models the effect of flu and hay fever on the sneezing symptom.

Full program with the Prolog editor

The first rule states that if somebody has flu, there is 30% probability that he has strong sneezing, 50% probability that he has moderate sneezing and 20% probability that he has no sneezing. The second rule affirms that if somebody has hay fever, there is 20% probability that he has strong sneezing, 60% probability that she has moderate sneezing and 20% probability that he has no sneezing at all. The next two facts are certain and they states that Bob has the flu and hay fever.

% load the ‘pita’ library to perform inference
:- use_module(library(pita)).
% allows to create graphical results
:- if(current_predicate(use_rendering/1)).
:- use_rendering(c3).
:- endif.
:- pita.
% to be written before the program
:- begin_lpad.
% Rules
strong_sneezing(X) : 0.3 ; moderate_sneezing(X) : 0.5 :- flu(X).
strong_sneezing(X) : 0.2 ; moderate_sneezing(X) : 0.6 :- hay_fever(X).
% Facts
flu(bob).
hay_fever(bob).
% to be written after the program
:- end_lpad.

What is the probability that Bob has strong sneezing?

prob(strong_sneezing(bob), P).

Let us see the histogram

prob_bar(strong_sneezing(bob), P).

Complete example: sneezing.pl


This is again an example of a noisy or combining rule between the conclusions of two different clauses.

Complete example with the LPAD editor: sneezing.cpl


  • Reference: F. Riguzzi and T. Swift. The PITA system: Tabling and answer subsumption for reasoning under uncertainty. Theory and Practice of Logic Programming, 27th International Conference on Logic Programming (ICLP’11) Special Issue, 11(4-5), pages 433-449, 2011.

Back to Index


Coin (approximate inference variant)

The LPAD of this example is the same of the one shown here, the only difference is the inference approach. In this example we will show how to perform an approximate inference with Monte Carlo sampling.

Let us suppose that we have one coin that we are not sure if it is biased. Now, if we toss the coin, what is the probability that it will land on head?

Perfom approximate inference

To perform approximate we just need to load the library mcintyre instead of pita and to initialize it we need to write down the goal :- mc.. Except for query commands the rest is the same as we are performing exact inference.

Full program

Below the full LPAD of the example

% load the library ‘mcintyre’ to perform approximate inference
:- use_module(library(mcintyre)).
% initialize the library ‘mcintyre’
:- mc.
% load the renderer ‘c3’ for graphical results
:- use_rendering(c3).
% to be written before the program
:- begin_lpad.
% Rules
heads(Coin): 1/2; tails(Coin) : 1/2 :- toss(Coin),\+biased(Coin).
heads(Coin): 0.6 ; tails(Coin) : 0.4 :- toss(Coin),biased(Coin).
% Facts
fair(Coin): 0.9 ; biased(Coin): 0.1.
toss(coin).
% to be written after the program
:- end_lpad.

To execute queries we must use the predicates mc_prob/2 for approximate inference and mc_prob_bar/2 for approximate inference with graphical results. For example if we want to ask for the probability that the coin will land on heads

mc_prob(heads(coin),P).

and for graphical results

mc_prob_bar(heads(coin),P).

With MCINTYRE, you can also take a given number of sample with

mc_sample(:Query:atom,+Samples:int,-Successes:int,-Failures:int,-Probability:float).

For example this query

mc_sample(heads(coin),1000,S,F,P).

samples heads(coin) 1000 times and returns in T the number of successes, in F the number of failures and in P the estimated probability (T/1000).

We can obtain a bar chart of the samples with the predicate mc_sample_bar/3 (note: remember to load the renderer c3)

mc_sample_bar(:Query:atom,+Samples:int,-Chart:dict).

In our example

mc_sample_bar(heads(coin),1000,Chart).

Differently from exact inference, in approximate inference the query can be a conjunction of atoms.


Complete example: coinmc.pl


  • Reference: J. Vennekens, S. Verbaeten, and M. Bruynooghe. Logic programs with annotated disjunctions. In International Conference on Logic Programming, volume 3131 of LNCS, pages 195-209. Springer, 2004.

Back to Index


Markov Chain

In this example we want to know what is the likelihood that on an execution of a Markov chain from a start state ‘s’, a final state ‘t’ will be reached? The chains may be infinite so the query may have an infinite number of explanations and if we want exact inference and use PITA, the inference may not terminate. To ensure termination, we have two solutions. We may either fix a bound on the depth of the derivations of PITA by setting the parameters

:- set_pita(depth_bound,true).
:- set_pita(depth,<level of depth (integer)>).

(see exact inference variant of this example). Alternatively, MCINTYRE can be used.

Here we will use the latter approach.

Full program

Below the full program of this example is shown

% load the library ‘mcintyre’ to perform approximate inference
:- use_module(library(mcintyre)).
% load the renderer ‘c3’ for graphical results
:- use_rendering(c3).
% initialize the library 'mcintyre'
:- mc.
% to be written before the program
:- begin_lpad.
reach(S, I, T) :-
trans(S, I, U),
reach(U, next(I), T).
reach(S, _, S).
trans(s0,S,s0):0.5; trans(s0,S,s1):0.3; trans(s0,S,s2):0.2.
trans(s1,S,s1):0.4; trans(s1,S,s3):0.1; trans(s1,S,s4):0.5.
trans(s4,_,s3).
% to be written after the program
:- end_lpad.

We ask for the probability that starting at state ‘s0’ at instance 0, state ‘s3’ is reachable

mc_prob(reach(s0,0,s3),P).

if we want to see the probability histogram

mc_prob_bar(reach(s0,0,s3),P).

Then if we want to sample reach(s0,0,s3) 1000 times, we can do it with

mc_sample(reach(s0,0,s3),1000,S,F,P).

If we want to see the bar graph of the sampling

mc_sample_bar(reach(s0,0,s3),1000,Chart).

We can also sample arguments of queries with the predicate mc_sample_arg/4

mc_sample_arg(:Query:atom,+Samples:int,?Arg:var,-Values:list).

The predicate samples Query a number of Samples times. Arg should be a variable in Query. The predicate returns in Values a list of couples L-N where L is the list of values of Arg for which Query succeeds in world sampled at random and N is the number of samples. If L is the empty list, it means that for that sample the query failed. If L is a list with a single element, it means that for that sample the query is determinate. If, in all couples L-N, L is a list with a single element, it means that the clauses in the program are mutually exclusive, i.e., that in every sample, only one clause for each subgoal has the body true.

So for example we may sample the argument S of reach(s0,0,S) with

mc_sample_arg(reach(s0,0,S),50,S,Values).

If we want to see the bar graph of this sampling we use the predicate mc_sample_arg_bar/4

mc_sample_arg_bar(:Query:atom,+Samples:int,?Arg:var,-Chart:dict).

For example

mc_sample_arg_bar(reach(s0,0,S),50,S,Chart).

Moreover, we can sample arguments of queries with the predicate mc_sample_arg_first/4

mc_sample_arg_first(:Query:atom,+Samples:int,?Arg:var,-Values:list)

that returns in Values a list of couples V-N where V is the value of Arg returned as the first answer by Query in a world sampled at random and N is the number of samples returning that value. V is failure if the query fails. mc_sample_arg_first/4 differs from mc_sample_arg/4 because the first just computes the first answer of the query for each sampled world.

So for example we may sample 50 times the first answer for S in reach(s0,0,S) with

mc_sample_arg_first(reach(s0,0,S),50,S,Values).

Complete example: markov_chain.pl


  • Reference: Gorlin, Andrey, C. R. Ramakrishnan, and Scott A. Smolka. Model checking with probabilistic tabled logic programming. Theory and Practice of Logic Programming 12.4-5 (2012).

Back to Index


Probabilistic Computation Tree Logic

In this example we want to perform model checking of the Synchronous Leader Election Protocol expressed in Probabilistic Computation Tree Logic (PCTL).

This example shows the computation of expectations and the possibility of mixing LPADs and Prolog for drawing diagrams.

Given a synchronous ring of N processes the Synchronous Leader Election Protocol is used to elect a leader (a uniquely designated processor) by sending messages around the ring.

The protocol proceeds in rounds and is parametrised by a constant K. Each round begins by all processors (independently) choosing a random number (uniformly) from {1,…,K} as an id. The processors then pass their ids around the ring. If there is a unique id, then the processor with the maximum unique id is elected the leader, and otherwise the processors begin a new round.

With this program you can

  • check that the probability of eventually electing a leader is 1
  • compute the probability of electing a leader within a certain number of rounds
  • compute the expected number of rounds to elect a leader
  • graph the probability of electing a leader within L rounds as a function of L
  • graph the expected number of rounds to elect a leader as a function of the number of processes or of K

Full program

The full program of this example is

:- use_module(library(mcintyre)).

:- if(current_predicate(use_rendering/1)).
:- use_rendering(c3).
:- endif.
:- dynamic kr/1,num/1.
:- mc.

:- begin_lpad.

% State Formulae 
models(_S, tt,_Hist,_Limit,_Time).
models(S, prop(P),_Hist,_Limit,_Time) :-
    proposition(P, S).
models(S, and(F1, F2),Hist,Limit,Time) :-
    models(S, F1,Hist,Limit,Time), models(S, F2,Hist,Limit,Time).
models(S, or(F1, _F2),Hist,Limit,Time) :-
    models(S, F1,Hist,Limit,Time).
models(S, or(F1, F2),Hist,Limit,Time) :-
    \+ models(S, F1,Hist,Limit,Time),
    models(S, F2,Hist,Limit,Time).
models(S, not(F), Hist,Limit,Time) :-
    \+ models(S, F,Hist,Limit,Time).
models(S, prob_until(comp(Op, P), F1, F2),Hist,Limit,Time) :-
    mc_sample(pmodels(S, until(F1, F2),Hist,Limit,Time),20, Q),
    comp(Q, Op, P).
models(S, prob_next(comp(Op, P), F),Hist,Limit,Time) :-
    mc_sample(pmodels(S, next(F),Hist,Limit,Time),20, Q),
    comp(Q, Op, P).

comp(Q,>,P):-
  Q>P.

comp(Q,>=,P):-
  Q>=P.

comp(Q,<,P):-
  Q<P.

comp(Q,=<,P):-
  Q=<P.


% Path Formulae
pmodels(S,F):-
  pmodels(S,F,[],nolimit,0,_Time).

pmodels(S,F,Hist,Limit,Time):-
  pmodels(S,F,Hist,Limit,Time,_Time).

pmodels(S, until(_F1, F2),Hist,Limit,Time,Time) :-
    models(S, F2,Hist,Limit,Time),!.
    
pmodels(S, until(F1, F2),Hist0,Limit,Time0,Time) :-
    within_limit(Time0,Limit),
    models(S, F1,Hist0,Limit,Time0),
    ctrans(S, _, T, Hist0, Hist),!,
    Time1 is Time0+1,
    pmodels(T, until(F1,F2),Hist,Limit,Time1,Time).

pmodels(S, next(F), Hist,Limit,Time0,Time) :-
    within_limit(Time0,Limit),
    ctrans(S, _, T, Hist, _),!,
    Time is Time0+1,
    models(T, F,Hist,Limit,Time).

within_limit(_Time,nolimit):-!.

within_limit(Time,Limit):-
  Time<Limit.

bounded_eventually(Prop,Rounds):-
  num(N),
  B is Rounds*(N+1),
  eventually(Prop,B,_T).

eventually(Prop):-
  eventually(Prop,_T).

eventually(Prop,Rounds):-
  eventually(Prop,nolimit,T),
  num(N),
  Rounds is T/(N+1).

eventually(Prop,Limit,T) :-
    init(S),
    pctlspec(Prop, F),
    pmodels(S, F,[],Limit,0,T).


pctlspec(X, until(tt, prop(X))).
proposition(P, S) :- final(P, S).

final(elect, [_|L]) :-
    num(N),
    gen_elected_state(N, L).

gen_elected_state(J, L) :-
    (J==0
    ->    L=[]
    ;     L = [state(3,_,_,_)|Rest],
          J1 is J-1,
          gen_elected_state(J1,Rest)
    ).
    

% transitions
% module counter
% [read] c<N-1 -> (c'=c+1);
% reading
trans(counter, counter(C), read, counter(D),_S,H,H) :-
  num(N),
  C < N-1,
  D is C+1.

% [read] c=N-1 -> (c'=c);
% finished reading
trans(counter, counter(C), read, counter(C),_S,H,H) :-
  num(N),
  C =:= N-1.

% [done] u1 | u2 | u3 | u4 -> (c'=c);
% done
trans(counter, counter(C), done, counter(C),S,H,H) :-
  get_processid(P), 
  nonlocal(process(P,_), uniqueid, 1,S).
   

% [retry] !(u1 | u2 | u3 | u4) -> (c'=1);
% pick again reset counter 
trans(counter, counter(_C), retry, counter(1),S,H,H) :-
        findall(P,get_processid(P),PL),
    maplist(nl(S),PL).

% [loop] s1=3 -> (c'=c);
% loop (when finished to avoid deadlocks)
trans(counter, counter(C), loop, counter(C),S,H,H) :-
  nonlocal(process(1,_), state, 3,S).

% module process
% local state
% s1=0 make random choice
% s1=1 reading
% s1=2 deciding
% s1=3 finished

% [pick] s1=0 -> 1/K : (s1'=1) & (p1'=0) & (v1'=0) & (u1'=true) + ...;
% pick value
trans(process(_N,_Next), state(0,_,_,_), pick, state(1,1,R,R),_S,H,[pick(R)|H]) :-
  pick(H,R).

%read 
% [read] s1=1 &  u1 & !p1=v2 & c<N-1 -> (u1'=true) & (v1'=v2);
trans(process(_N,Next), state(1,1,_,P), read, state(1,1,V,P),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C < CN - 1,
  nonlocal(process(Next,_), value, V,S),
  P \== V.

% [read] s1=1 &  u1 &  p1=v2 & c<N-1 -> (u1'=false) & (v1'=v2) & (p1'=0);
trans(process(_N,Next), state(1,1,_,P), read, state(1,0,V,0),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C < CN - 1,
  nonlocal(process(Next,_), value, V,S),
  P == V.

% [read] s1=1 & !u1 &  c<N-1 -> (u1'=false) & (v1'=v2);
trans(process(_N,Next), state(1,0,_,P), read, state(1,0,V,P),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C < CN - 1,
  nonlocal(process(Next,_), value, V,S).
 
% read and move to decide 
% [read] s1=1 &  u1 & !p1=v2 & c=N-1 -> (s1'=2) & (u1'=true) & (v1'=0) & (p1'=0);
trans(process(_N,Next), state(1,1,_,P), read, state(2,1,0,0),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C =:= CN - 1,
  nonlocal(process(Next,_), value, V,S),
  P \== V.

% [read] s1=1 &  u1 &  p1=v2 & c=N-1 -> (u1'=false) & (v1'=0) & (p1'=0);
trans(process(_N,Next), state(1,1,_,P), read, state(2,0,0,0),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C =:= CN - 1,
  nonlocal(process(Next,_), value, V,S),
  P == V.

% [read] s1=1 & !u1 &  c=N-1 -> (s1'=2) & (u1'=false) & (v1'=0);
trans(process(_N,_Next), state(1,0,_,P), read, state(2,0,0,P),S,H,H) :-
  nonlocal(counter, counter, C,S),
  num(CN),
  C =:= CN - 1.

% done
% [done] s1=2 -> (s1'=3) & (u1'=false) & (v1'=0) & (p1'=0);
trans(process(_N,_Next), state(2,_,_,_), done, state(3,0,0,0),_S,H,H).

% retry
% [retry] s1=2 -> (s1'=0) & (u1'=false) & (v1'=0) & (p1'=0);
trans(process(_N,_Next), state(2,_,_,_), retry, state(0,0,0,0),_S,H,H).

% loop (when finished to avoid deadlocks)
% [loop] s1=3 -> (s1'=3);
trans(process(_N,_Next), state(3,U,V,P), loop, state(3,U,V,P),_S,H,H).

pick(H,V):-
  kr(K),
  K1 is K-1,
  PH is 1/K,
  findall(I,between(0,K1,I),L),
  foldl(pick_value(H,PH),L,(1,_),(_,V)).

pick_value(_H,_PH,_I,(P0,V0),(P0,V0)):-
  nonvar(V0).

pick_value(H,PH,I,(P0,V0),(P1,V1)):-
  var(V0),
  PF is PH/P0,
  (pick_fact(H,V0,PF)->
    P1=PF,
    V1=I
  ;
    P1 is P0*(1-PF),
    V1=V0
  ).

pick_fact(_,_,P):P.

%pick(H,0):0.5; pick(H,1):0.5.

ctrans(S, A, T, Hi, Ho) :-
    config(P),
    find_matching_trans(P,S,S,[],A,T,Hi,Ho).

find_matching_trans([], [], _CS, _PA, A, [], H,H) :- nonvar(A).
find_matching_trans([P|Ps], [S|Ss], CS, PA, A, [T|Ts],Hi,Ho) :-
    pick_trans(P, S, CS, PA, A, T, Hi,H1),
    find_matching_trans(Ps, Ss, CS, PA, A, Ts,H1,Ho).
find_matching_trans([P|Ps], [S|Ss], CS, PA, A, [S|Ts], Hi,Ho) :-
    % skip current process; but then all transitions enabled in the current
    % process will be prohibited for selection in later processes.
    enabled_trans(P,L),
    (nonvar(A) -> \+ member(A,L); true),
    append(L, PA, PA1),
    find_matching_trans(Ps, Ss, CS, PA1, A, Ts, Hi, Ho).

pick_trans(P, S, CS, PA, A, T, H0,H) :-
    etrans(P, S, PA, A, T,CS, H0,H).

etrans(P, S, PA, A, T, CS,H0,H) :-
    trans(P, S, A, T,CS,H0,H),
    A \= epsilon,
    \+ member(A, PA).

enabled_trans(P, L) :-
    setof(A, enabled_trans_in_process(P,A), L).

enabled_trans_in_process(P,A) :-
    clause(trans(P,_,A,_,_,_,_),_),
    A \= epsilon.

nonlocal(Proc, Var, Val,CS) :-
    getpid(Proc, Var, Pid, Idx),
    nth1(Pid, CS, State),
    arg(Idx, State, Val).
%   writeln(nonlocal_read(Proc, State, Var, Val)).

getpid(Proc, Var, Pid, Idx) :-
    config(Config),
    nth1(Pid, Config, Proc),
    nonlocal_access(Proc, Var, Idx).

get_processid(P):-
  num(N),
  between(1,N,P).

config([counter| L]) :-
    findall(P,get_processid(P),PL),
    maplist(neighbor,PL,L).

neighbor(I,process(I,J)) :-
    num(N),
    (I<N
  ->
      J is I+1
    ;   J = 1
    ).

%config([counter, process(1,2), process(2,3), process(3,4), process(4,1)]).

init(S) :-
    config(P),
    maplist(init_state,P,S).

init_state(counter, counter(1)).
init_state(process(_,_), state(0,0,0,0)).

nonlocal_access(counter, counter, 1).
nonlocal_access(process(_,_), state, 1).
nonlocal_access(process(_,_), uniqueid, 2).
nonlocal_access(process(_,_), value, 3).

nl(S,P):-
  nonlocal(process(P, _), uniqueid, 0,S).

num(4).
kr(4).


:- end_lpad.

graph_prob(G):-
  retract(num(N)),
  retract(kr(K)),
  assert(num(4)),
  assert(kr(2)),
  findall(L-P,
    (between(1,6,L),mc_sample(bounded_eventually(elect,L),100,P)),LV),
  G=c3{data:_{x:x, rows:[x-'Probability of leader elected within L rounds (N=4, K=2)'|LV]},%legend:_{show: false},
    axis:_{x:_{min:1,max:6,label:'L',padding:_{bottom:0.0,top:0.0}},
           y:_{label:'Probability',padding:_{bottom:0.0,top:0.0}}}},
  retract(num(4)),
  retract(kr(2)),
  assert(num(N)),
  assert(kr(K)).

graph_exp_rounds_n(G):-
  retract(num(NI)),
  retract(kr(KI)),
  assert(kr(3)),
  findall(N-E,
    (between(3,8,N),
     assert(num(N)),
     mc_expectation(eventually(elect,T),100,T,E),
     retract(num(N))),
    LV),
  G=c3{data:_{x:x, rows:[x-'Expected rounds to elect a leader (K=3)'|LV]},%legend:_{show: false},
    axis:_{x:_{min:3,max:8,label:'N',padding:_{bottom:0.0,top:0.0}},
           y:_{label:'Expected rounds',padding:_{bottom:0.0,top:0.0}}}},
  retract(kr(3)),
  assert(num(NI)),
  assert(kr(KI)).

graph_exp_rounds_k(G):-
  retract(num(NI)),
  retract(kr(KI)),
  assert(num(3)),
  findall(K-E,
    (between(3,8,K),
     assert(kr(K)),
     mc_expectation(eventually(elect,T),500,T,E),
     retract(kr(K))),
    LV),
  G=c3{data:_{x:x, rows:[x-'Expected rounds to elect a leader (N=3)'|LV]},%legend:_{show: false},
    axis:_{x:_{min:3,max:8,label:'K',padding:_{bottom:0.0,top:0.0}},
           y:_{label:'Expected rounds',padding:_{bottom:0.0,top:0.0}}}},
  retract(num(3)),
  assert(num(NI)),
  assert(kr(KI)).

We first consider the problem of computing expectations. We would like to compute the expected number of rounds to elect a leader.

We can compute expectations with

mc_expectation(:Query:atom,+N:int,?Arg:var,-Exp:float).

that computes the expected value of Arg in Query by sampling. It takes N samples of Query and sums up the value of Arg for each sample. The overall sum is divided by N to give Exp.

An example of use of the above predicate is

mc_expectation(eventually(elect,T),1000,T,E).

that returns in E the expected value of rounds necessary to elect a leader computed by taking 1000 samples.

We can mix LPADs and Prolog for drawing a graph of the expected number of rounds to elect a leader as a funtion of the number of processes when K=3. We use the Prolog code below, that is included in the program above outside :-begin/end_lpad:

graph_exp_rounds_n(G):-
  retract(num(NI)),
  retract(kr(KI)),
  assert(kr(3)),
  findall(N-E,
    (between(3,8,N),
     assert(num(N)),
     mc_expectation(eventually(elect,T),100,T,E),
     retract(num(N))),
    LV),
  G=c3{data:_{x:x, rows:[x-'Expected rounds to elect a leader (K=3)'|LV]},%legend:_{show: false},
    axis:_{x:_{min:3,max:8,label:'N',padding:_{bottom:0.0,top:0.0}},
           y:_{label:'Expected rounds',padding:_{bottom:0.0,top:0.0}}}},
  retract(kr(3)),
  assert(num(NI)),
  assert(kr(KI)).

Note that num/1 and kr/1 are declared as dynamic at the beginning of the program, so their definition can be changed. num/1 stores the number of processes N and kr/1 the value of K. graph_exp_rounds_n/1 returns a dict that is rendered as a c3 graph. The predicates performs a findall/3 where it first asserts an increasing value for N, from 3 to 8, and then computes the expected value of the rounds necessary to elect a leader. The resulting data is then inserted in a c3 dict. Calling graph_exp_rounds_n(G) you get a graph of the expected number of rounds to elect a leader as a funtion of the number of processes when K=3.

graph_exp_rounds_n(G).

Complete example: pctl_slep.pl



Back to Index


Random arithmetic functions

In this example we want to show how to perform conditional inference in an approximate way using sampling. In particular, we will show how to use rejection sampling and Metropolis-Hastings.

This example generatively defines a random arithmetic function. The problem is to predict the value returned by the function given one or two couples of input-output, i.e., to compute a conditional probability. This program is translated from the example http://forestdb.org/models/arithmetic.html in the Church functional probabilistic programming language. Sampling is necessary as queries have an infinite number of explanations.

Full program

The full program of this example is

:- use_module(library(mcintyre)).

:- if(current_predicate(use_rendering/1)).
:- use_rendering(c3).
:- endif.

:- mc.

:- begin_lpad.

eval(X,Y):-
  random_fn(X,0,F),
  Y is F.

op(+):0.5;op(-):0.5.

random_fn(X,L,F):-
  comb(L),
  random_fn(X,l(L),F1),
  random_fn(X,r(L),F2),
  op(Op),
  F=..[Op,F1,F2].

random_fn(X,L,F):-
  \+ comb(L),
  base_random_fn(X,L,F).

comb(_):0.3.

base_random_fn(X,L,X):-
  identity(L).

base_random_fn(_X,L,C):-
  \+ identity(L),
  random_const(L,C).

identity(_):0.5.

random_const(L,0):0.1;random_const(L,1):0.1;random_const(L,2):0.1;
random_const(L,3):0.1;random_const(L,4):0.1;random_const(L,5):0.1;
random_const(L,6):0.1;random_const(L,7):0.1;random_const(L,8):0.1;
random_const(L,9):0.1.

:- end_lpad.

We know that the random function return 3 for input 1 and we want to compute the probability that it returns 4 for input 2. We thus need to ask a conditional query and sampling is necessary as queries have an infinite number of explanations.

The simplest approach is to use rejection sampling: you first query the evidence and, if the query is successful, query the goal in the same sample, otherwise the sample is discarded.

This can be done with

mc_rejection_sample(:Query:atom,:Evidence:atom,+Samples:int,
  -Successes:int,-Failures:int,-Probability:float).

that takes Samples samples of Query given that Evidence is true.

An example of use of the above predicate is

mc_rejection_sample(eval(2,4),eval(1,3),1000,T,F,P).

that perform rejection sampling of eval(2,4) given that eval(1,3) is true.

Differently from exact inference, in approximate inference the evidence can be a conjunction of atoms, so if you also know that eval(0,2) is true, you can use

mc_rejection_sample(eval(2,4),(eval(0,2),eval(1,3)),1000,T,F,P).

and, as you can see, the query with more evidence is now almost certainly true.

In Metropolis-Hastings MCMC, a Markov chain is produced using the algorithm of [Nampally, Ramakrishnan, 2014]: after a sample, a number of sampled probabilistic choices are deleted and the others are retained for the next sample. The sample is accepted with a probability of min{1,N0/N1} where N0 is the number of choices sampled in the previous sample and N1 is the number of choices sampled in the current sample. Metropolis-Hastings is usually much faster than rejection sampling because less samples are discarded.

To use Metropolis-Hastings, the following predicate is available

mc_mh_sample(:Query:atom,:Evidence:atom,+Samples:int,+Lag:int,
  -Successes:int,-Failures:int,-Probability:float).

where Lag is the number of sampled choices to forget before taking a new sample. For example

mc_mh_sample(eval(2,4),eval(1,3),10000,1,T,F,P).

takes 10000 accepted samples and returns in T the number of samples where eval(2,4) is true, in F the number of samples where eval(2,4) is false and in P the estimated probability (T/10000).

You can also compute conditional expectations with

mc_mh_expectation(:Query:atom,:Evidence:atom,+N:int,+Lag:int,?Arg:var,-Exp:float).

as in

mc_mh_expectation(eval(2,Y),eval(1,3),1000,1,Y,E).

that computes the expectation of argument Y of eval(2,Y) given that eval(1,3) is true by taking 1000 samples using Metropolis-Hastings MCMC.


Complete example: arithm.pl



Back to Index


Machines

In this section we will see how to learn the parameters given a background knowledge and an initial program. We take into account the Machines dataset (see reference).

Note: the learning algorithms are available only if you use the Prolog editor.

Writing the program step by step

To execute a learning algorithm the input source must be divided in five parts:

  • preamble,
  • background knowledge, i.e., knowledge valid for all interpretations,
  • initial LPAD program for you which you want to learn the parameters (optional),
  • language bias information,
  • example interpretations.

Here we will define a program step by step and then execute the algorithm EMBLEM which learns the parameters of a given initial LPAD program.

For more information of how to perform learning see the manual (PDF version).

Preamble

In order to perform either EMBLEM or SLIPCOVER you need to load the library slipcover with the command

:- use_module(library(slipcover)).

After that you have to initialize slipcover with the command

:- sc.

At this point you can start setting parameters for SLIPCOVER with the predicate set_sc/2. For the complete list of the available parameters and their meanings see the manual. In our example we will set the following parameters

:- set_sc(depth_bound,false).
:- set_sc(neg_ex,given).
:- set_sc(megaex_bottom,15).
:- set_sc(max_iter,10).
:- set_sc(max_iter_structure,50).
:- set_sc(verbosity,1).

Background knowledge

We have defined the preamble, now we can specify the background knowledge with a fact of the form

bg(<list of terms representing clauses>).

Alternatively, we can specify a set of clauses by including them in a section between the goals :- begin_bg. and :- end_bg.. We will use the latter approach.

:- begin_bg.
component(C):-
  replaceable(C).
component(C):-
  not_replaceable(C).
replaceable(gear).
replaceable(wheel).
replaceable(chain).
not_replaceable(engine).
not_replaceable(control_unit).
not_worn(C):-
  component(C),
  \+ worn(C).
one_worn:-
  worn(_).
none_worn:-
  \+ one_worn.
:- end_bg.

Initial program

At this point we can define an initial program for which you want to learn the parameters. We can do it with a fact of the form

in(<list of terms representing clauses>).

Alternatively, you can specify an input program in a section between :- begin_in. and :- end_in.. We will use the latter method. Therefore in our example

:- begin_in.
class(sendback):0.5 :-
  worn(A),
  not_replaceable(A).

class(fix):0.6 :-
  worn(A),
  replaceable(A).

class(ok):0.5 :-
  not_worn(_A).
:- end_in.

Language Bias

The language bias part contains the declarations of the input and output predicates.

The typical input for EMBLEM will be a set of interpretations, i.e. sets of grounds facts. Among the predicates for the input facts the use has to indicate which are the output predicates. Output predicates are declared as

output(<predicate>/<arity>).

In our example

output(class/1).

Input predicates are those whose atoms you are not interested in predicting.

You can declare closed world input predicates with

input_cw(<predicate>/<arity>).

For these predicates, the only true atoms are those in the interpretations and those derivable from them using the background knowledge, the clauses in the input/hypothesized program are not used to derive atoms for these predicates. Moreover, clauses of the background knowledge that define closed world input predicates and that call an output predicate in the body will not be used for deriving examples. In our example

input_cw(replaceable/1).
input_cw(not_replaceable/1).
input_cw(worn/1).
input_cw(not_worn/1).
input_cw(none_worn/0).

Besides closed world input predicate we can declare open world input predicates with

input(<predicate>/<arity>).

In our example we do not have open world input predicates.

Example interpretations

The last part of the file contains the data. You can specify data with two modalities: models and keys.

In the models type, you specify an example model (or interpretation) as a list of Prolog facts initiated by begin(model(<name>)). and terminated by end(model(<name>))..

Alternatively, with the keys modality, you can directly write the facts and the first argument will be interpreted as a model identifier.

The two modalities, models and keys, can be mixed in the same source.

If we use the model modality for the example/interpretation 1

begin(model(1)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(gear).
worn(engine).
end(model(1)).

If we use this modality the system asserts a int(<name>). for each model enclosed in begin(model(<name>)). and end(model(<name>))..

Instead, if we use the key modality, our example will be (note the first argument of each fact)

class(1,sendback).
neg(1,class(fix)).
neg(1,class(ok)).
worn(1,gear).
worn(1,engine).

If we use this modality, facts for int/1 are not asserted for interpretations, but can be explicitily added by the user.

Fold division

After we defined the examples/interpretations we must indicate how the examples are divided in folds with facts of the form:

fold(<fold_name>,<list of model identifiers>)

as for example

fold(train1,[1,2,3]).
fold(train2,[4,5,6,7,8,9,10]).

We can also define intensionally the folds as in

fold(all,F) :- findall(I,int(I),F).

Full dataset

The complete Machines input file is

% PREAMBLE %
:- use_module(library(slipcover)).
% use the renderer 'lpad'. It not mandatory to use it, but it prints the learned clauses in a more readable way
:- use_rendering(lpad).
:- sc.
:- set_sc(depth_bound,false).
:- set_sc(neg_ex,given).
:- set_sc(megaex_bottom,15).
:- set_sc(max_iter,10).
:- set_sc(max_iter_structure,50).
:- set_sc(verbosity,1).

% BACKGROUND KNOWLEDGE %
:- begin_bg.
component(C):-
  replaceable(C).
component(C):-
  not_replaceable(C).
replaceable(gear).
replaceable(wheel).
replaceable(chain).
not_replaceable(engine).
not_replaceable(control_unit).
not_worn(C):-
  component(C),
  \+ worn(C).
one_worn:-
  worn(_).
none_worn:-
  \+ one_worn.
:- end_bg.
% INITIAL PROGRAM %
:- begin_in.
class(sendback):0.5 :-
  worn(A),
  not_replaceable(A).

class(fix):0.6 :-
  worn(A),
  replaceable(A).

class(ok):0.5 :-
  not_worn(_A).
:- end_in. 

% LANGUAGE BIAS %
% output predicates
output(class/1).
% input closed world predicates
input_cw(replaceable/1).
input_cw(not_replaceable/1).
input_cw(worn/1).
input_cw(not_worn/1).
input_cw(none_worn/0).

% EXAMPLES (interpretations) %
begin(model(1)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(gear).
worn(engine).
end(model(1)).

begin(model(2)).
class(ok).
neg(class(sendback)).
neg(class(fix)).
end(model(2)).

begin(model(3)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(gear).
end(model(3)).

begin(model(4)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(engine).
end(model(4)).

begin(model(5)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(gear).
worn(chain).
end(model(5)).

begin(model(6)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(wheel).
end(model(6)).

begin(model(7)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(wheel).
worn(control_unit).
end(model(7)).

begin(model(8)).
class(ok).
neg(class(sendback)).
neg(class(fix)).
end(model(8)).

begin(model(9)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(wheel).
worn(chain).
end(model(9)).

begin(model(10)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(engine).
worn(chain).
end(model(10)).

begin(model(11)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(engine).
worn(control_unit).
end(model(11)).

begin(model(12)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(chain).
worn(wheel).
worn(gear).
end(model(12)).

begin(model(13)).
class(sendback).
neg(class(fix)).
neg(class(ok)).
worn(chain).
worn(wheel).
worn(gear).
worn(engine).
end(model(13)).

begin(model(14)).
class(ok).
neg(class(sendback)).
neg(class(fix)).
end(model(14)).

begin(model(15)).
class(fix).
neg(class(sendback)).
neg(class(ok)).
worn(wheel).
worn(gear).
end(model(15)).

fold(all, F) :- findall(I,int(I),F).

Performing parameter learning

To execute the parameter learning algorithm EMBLEM, we need to ask a query of the form

induce_par(<list of folds>,P).

where <list of folds> is a list of the folds for training and P will contain the input program with updated parameters.

In our example we want to learn the parameters by using the fold which contains all the examples (all). Therefore

induce_par([all],P).

Complete example: mach.pl



For more information about how to perform learning and EMBLEM see the manual (or PDF version) and the references in the About page:


Back to Index


Registration

In this tutorial section we will show how to perform structure learning. We take into account the Registration dataset (see reference).

Note: the learning algorithms are available only if you use the Prolog editor.

Writing the program step by step

To execute a learning algorithm the input source must be divided in five parts:

  • preamble,
  • background knowledge, i.e., knowledge valid for all interpretations,
  • Initial LPAD (optional),
  • language bias information,
  • example interpretations.

Here we will define a program step by step and then execute the algorithm SLIPCOVER [2] which learns the structure and the parameters given a background knowledge.

For more information of how to perform learning see the manual (PDF version).

Preamble

We load the library slipcover, initialize it and then set some parameters.

:-use_module(library(slipcover)).
:-sc.

:- set_sc(depth_bound,false).
:- set_sc(neg_ex,given).
:- set_sc(megaex_bottom,7).
:- set_sc(verbosity,1).

Backgroud knowledge

Now we write the background knowledge enclosed by :- begin_bg. and :- end_bg..

:- begin_bg.
company_info(jvt,commercial).
company_info(scuf,university).
company_info(ucro,university).
course(cso,2,introductory).
course(erm,3,introductory).
course(so2,4,introductory).
course(srw,3,advanced).

job(J):- participant(J, _, _, _).
company(C):- participant(_, C, _, _).

party_yes :- party(yes).
party_no :- party(no).

company_type(T):- company(C), company_info(C, T).

not_company_type(commercial):- \+ company_type(commercial).

not_company_type(university):- \+ company_type(university).

course_len(C, L):-
    course(C, L, _).
    
course_type(C, T):-
    course(C, _, T).

:- end_bg.

Initial program

You can define an inital LPAD program enclosed by :- begin_in. and :- end_in..

:- begin_in.
party(yes):0.5:-
  company_type(commercial).

party(no):0.5:-
  subscription(A),
  course_len(A,4),
  \+ company_type(commercial).
:- end_in.

This LPAD is not used for structure learning. It can be used however for testing the program on the data, see the Bongard example.

Language Bias

As in the previous example we define the set of output and input predicates

% output predicates
output(party/1).
% input closed world predicates
input_cw(job/1).
input_cw(not_company_type/1).
input_cw(company_type/1).
input_cw(subscription/1).
input_cw(course_len/2).
input_cw(course_type/2).
input_cw(company/1).
input_cw(company_info/2).
input_cw(participant/4).
input_cw(course/3).

We want to learn new clauses (the structure) for the program, in order to do that we need to add mode declarations in the style of Progol.

To specify the atoms that can appear in the head of clauses you must use facts of the form

modeh(<recall>,<predicate>(<arg1>,...)).

To specify the atoms that can appear in the body of clauses you must use facts of the form

modeb(<recall>,<predicate>(<arg1>,...)).

where <recall> can be an integer or *. <recall> indicates how many atoms for the predicate specification are retained in the bottom clause during a saturation step. * stands for all those that are found.

We refer to the manual for further details.

In our example we use the following mode declarations

modeh(*,party(yes)).
modeh(*,party(no)).

modeb(*,job(-#job)).
modeb(*,company_type(-#ctype)).
modeb(*,not_company_type(-#ctype)).
modeb(*,subscription(-sub)).
modeb(*,course_len(+sub,-#cl)).
modeb(*,course_type(+sub,-#ct)).

SLIPCOVER also requires facts for the determination/2 predicate Aleph-style that indicate which predicates can appear in the body of clauses. For our program we have

determination(party/1,job/1).
determination(party/1,not_company_type/1).
determination(party/1,company_type/1).
determination(party/1,subscription/1).
determination(party/1,course_len/2).
determination(party/1,course_type/2).

For example the first determination/2 fact states that the predicate job/1 can appear in the body of hypothesised clauses having party/1 in the head.

Example interpretations

Now we define the example models (or interpretations, i.e. a set of ground facts) and divide them in folds. You can specify data with two modalities: models and keys.

In the models type, you specify an example model (or interpretation) as a list of Prolog facts initiated by begin(model(<name>)). and terminated by end(model(<name>))..

Alternatively, with the keys modality, you can directly write the facts and the first argument will be interpreted as a model identifier.

The two modalities, models and keys, can be mixed in the same source.

In this example and for the rest of the section we will use the former modality.

begin(model(adams)).
participant(researcher,scuf,no,23).
subscription(erm).
subscription(so2).
subscription(srw).
end(model(adams)).

We can add background knowledge that is not probabilistic directly to the file writing the clauses taking into account the model argument. In our example

party(M,P):-
  participant(M,_, _, P, _).

Here M is the model and participant/4 is defined in the interpretations. You can also define intensionally the negative examples with

neg(party(M,yes)):- party(M,no).
neg(party(M,no)):- party(M,yes).

Now we split the example models into fold. In this example we have only one fold which contains all the models.

fold(all,F) :- findall(I,int(I),F).

Full program

Below there is the complete program

% PREAMBLE %
:- use_module(library(slipcover)).
% use the renderer 'lpad'. It not mandatory to use it, but it prints the learned clauses in a more readable way
:- use_rendering(lpad).
:- sc.
:- set_sc(depth_bound,false).
:- set_sc(neg_ex,given).
:- set_sc(megaex_bottom,7).
:- set_sc(verbosity,1).

% BACKGROUND KNOWLEDGE %
:- begin_bg.
company_info(jvt,commercial).
company_info(scuf,university).
company_info(ucro,university).
course(cso,2,introductory).
course(erm,3,introductory).
course(so2,4,introductory).
course(srw,3,advanced).

job(J):- participant(J, _, _, _).
company(C):- participant(_, C, _, _).

party_yes :- party(yes).
party_no :- party(no).

company_type(T):- company(C), company_info(C, T).
not_company_type(commercial):- \+ company_type(commercial).
not_company_type(university):- \+ company_type(university).

course_len(C, L):- course(C, L, _).
course_type(C, T):- course(C, _, T).
:- end_bg.
%%%%%%%%%%%%%%%%%%%
% INITIAL PROGRAM %
%%%%%%%%%%%%%%%%%%%
:- begin_in.
party(yes):0.5:-
  company_type(commercial).

party(no):0.5:-
  subscription(A),
  course_len(A,4),
  \+ company_type(commercial).
:- end_in.

% LANGUAGE BIAS %
% output predicates
output(party/1).
% input closed world predicates
input_cw(job/1).
input_cw(not_company_type/1).
input_cw(company_type/1).
input_cw(subscription/1).
input_cw(course_len/2).
input_cw(course_type/2).
input_cw(company/1).
input_cw(company_info/2).
input_cw(participant/4).
input_cw(course/3).

determination(party/1,job/1).
determination(party/1,not_company_type/1).
determination(party/1,company_type/1).
determination(party/1,subscription/1).
determination(party/1,course_len/2).
determination(party/1,course_type/2).

modeh(*,party(yes)).
modeh(*,party(no)).

modeb(*,job(-#job)).
modeb(*,company_type(-#ctype)).
modeb(*,not_company_type(-#ctype)).
modeb(*,subscription(-sub)).
modeb(*,course_len(+sub,-#cl)).
modeb(*,course_type(+sub,-#ct)).

% EXAMPLES (interpretations) %
neg(party(M,yes)):- party(M,no).
neg(party(M,no)):- party(M,yes).

party(M,P):-
  participant(M,_, _, P, _).

begin(model(adams)).
participant(researcher,scuf,no,23).
subscription(erm).
subscription(so2).
subscription(srw).
end(model(adams)).

begin(model(blake)).
participant(president,jvt,yes,5).
subscription(cso).
subscription(erm).
end(model(blake)).

begin(model(king)).
participant(manager,ucro,no,78).
subscription(cso).
subscription(erm).
subscription(so2).
subscription(srw).
end(model(king)).

begin(model(miller)).
participant(manager,jvt,yes,14).
subscription(so2).
end(model(miller)).

begin(model(scott)).
participant(researcher,scuf,yes,94).
subscription(erm).
subscription(srw).
end(model(scott)).

begin(model(turner)).
participant(researcher,ucro,no,81).
subscription(so2).
subscription(srw).
end(model(turner)).
% fold division
fold(all,F) :- findall(I,int(I),F).

Execute parameter learning

In this example we provided an initial program, therefore we can perform parameter learning (we use all the example for training)

induce_par([all], P).

Execute structure learning

To execute the structure learning algorithm SLIPCOVER (which learns also the parameters of the learned program), we need to execute a query with the form

induce(<list of folds>,P).

where <list of folds> is a list of the folds for training and P will contain the learned program.

In our example we want to learn the structure (and the parameters) by using the fold which contains all the examples (all). Therefore

induce([all],P).

Complete example: registration.pl


  • Reference: L. De Raedt, H. Blockeel, L. Dehaspe, and W. Van Laer. Three companions for data mining in first order logic. In S. Dzeroski and N. Lavrac, editors, Relational Data Mining, pages 105-139. Springer-Verlag, 2001.

For more information about how to perform learning and SLIPCOVER see the manual (or PDF version) and the references in the About page.


Back to Index


Bongard

In this tutorial section we will see how to execute a test on a program. We take into account the Bongard dataset (see reference).

How to test a program

A program can also be tested on a test set with a query of the form

?- test(<program>,<list_of_folds>,LL,AUCROC,ROC,AUCPR,PR).

where <program> is a list of terms representing clauses and <list_of_folds> is a list of folds. This returns the log likelihood of the test examples in LL, the Area Under the ROC curve in AUCROC, a dictionary containing the list of points (in the form of Prolog pairs x-y) of the ROC curve in ROC, the Area Under the PR curve in AUCPR, a dictionary containing the list of points of the PR curve in PR.

Let us suppose now that we have two disjunt folds of examples named train and test. We will now see how to test a (learned) program.

How to test the initial program

we can test the input program on the fold test with a query of the form

?- in(P), test(P,[test],LL,AUCROC,ROC,AUCPR,PR).

How to test a program after parameter learning

Suppose we want to perform parameter learning on the initial program by using the train fold and then test the resulting program by using the test fold. Then we have just to run the query

?- induce_par([train],P), test(P,[test],LL,AUCROC,ROC,AUCPR,PR).

How to test the learned program

Suppose we want to learn new clauses (i.e. we perform structure learning) by using the train fold and then test the resulting program by using the test fold. Then we have just to run the query

?- induce([train],P), test(P,[test],LL,AUCROC,ROC,AUCPR,PR).

Adding renderers

It is possible to see the curves AUCROC, ROC and PR as graphs by including the renderer c3 before :- sc.. Morover we include the renderer lpad to have the output program pretty printed. Therefore we add the following commands in the preamble before :- sc..

:- use_rendering(c3).
:- use_rendering(lpad).

Dynamic folds

We can intensionally create the fold containing all the example with

fold(all,F):- findall(I,int(I),F).

We can dinamically create the folds train and test with the following command

:- fold(all,F),
   sample(4,F,FTr,FTe),
   assert(fold(train,FTr)),
   assert(fold(test,FTe)).

This last command should however be inserted after the input interpretations. As can be seen, it uses sample(N,List,Sampled,Rest) exported from the library slipcover that samples N elements from List and returns the sampled elements in Sampled and the rest in Rest. If List has N elements or less, Sampled is equal to List and Rest is empty.

Full dataset

Below the complete Bongard dataset is reported.

% PREAMBLE %
:-use_module(library(slipcover)).
:- use_rendering(c3).
:- use_rendering(lpad).
:-sc.
:- set_sc(megaex_bottom,20).
:- set_sc(max_iter,3).
:- set_sc(max_iter_structure,10).
:- set_sc(maxdepth_var,4).
:- set_sc(verbosity,1).

% BACKGROUND KNOWLEDGE %
bg([]).

% INITIAL PROGRAM %
in([
(
 pos:0.5 :-
    circle(A),
    in(B,A)
),
( 
 pos:0.5 :-
    circle(A),
    triangle(B)
)]).

% LANGUAGE BIAS %
% output predicates
output(pos/0).
% input closed world predicates
input_cw(triangle/1).
input_cw(square/1).
input_cw(circle/1).
input_cw(in/2).
input_cw(config/2).
% mode declarations
modeh(*,pos).
modeb(*,triangle(-obj)).
modeb(*,square(-obj)).
modeb(*,circle(-obj)).
modeb(*,in(+obj,-obj)).
modeb(*,in(-obj,+obj)).
modeb(*,config(+obj,-#dir)).

determination(pos/0,triangle/1).
determination(pos/0,square/1).
determination(pos/0,circle/1).
determination(pos/0,in/2).
determination(pos/0,config/2).

% EXAMPLES (interpretations) %
begin(model(1)).
pos.
triangle(o5).
config(o5,up).
square(o4).
in(o4,o5).
circle(o3).
triangle(o2).
config(o2,up).
in(o2,o3).
triangle(o1).
config(o1,up).
end(model(1)).

begin(model(2)).
neg(pos).
circle(o4).
circle(o3).
in(o3,o4).
square(o2).
circle(o1).
in(o1,o2).
end(model(2)).

begin(model(3)).
neg(pos).
square(o3).
square(o2).
in(o2,o3).
square(o1).
end(model(3)).

begin(model(4)).
pos.
triangle(o5).
config(o5,down).
triangle(o4).
config(o4,up).
in(o4,o5).
circle(o3).
square(o2).
in(o2,o3).
triangle(o1).
config(o1,up).
end(model(4)).

begin(model(5)).
pos.
circle(o4).
triangle(o3).
config(o3,up).
in(o3,o4).
triangle(o2).
config(o2,down).
square(o1).
in(o1,o2).
end(model(5)).

begin(model(6)).
neg(pos).
triangle(o5).
config(o5,down).
square(o4).
in(o4,o5).
circle(o3).
circle(o2).
in(o2,o3).
triangle(o1).
config(o1,down).
end(model(6)).

begin(model(7)).
neg(pos).
triangle(o3).
config(o3,down).
circle(o2).
in(o2,o3).
triangle(o1).
config(o1,down).
end(model(7)).

begin(model(8)).
neg(pos).
triangle(o4).
config(o4,down).
circle(o3).
in(o3,o4).
triangle(o2).
config(o2,up).
circle(o1).
in(o1,o2).
end(model(8)).

begin(model(9)).
pos.
triangle(o2).
config(o2,down).
triangle(o1).
config(o1,down).
in(o1,o2).
end(model(9)).

begin(model(10)).
pos.
triangle(o6).
config(o6,up).
triangle(o5).
config(o5,up).
in(o5,o6).
square(o4).
triangle(o3).
config(o3,up).
in(o3,o4).
square(o2).
triangle(o1).
config(o1,up).
in(o1,o2).
end(model(10)).
% fold division
fold(all,F):- findall(I,int(I),F).

:- fold(all,F),
   sample(4,F,FTr,FTe),
   assert(fold(train,FTr)),
   assert(fold(test,FTe)).

Execute parameter learning and test

If we want to learn the parameters of the initial program and then test the resulting program, we can use the following query

induce_par([train],P), test(P,[test],LL,AUCROC,ROC,AUCPR,PR).

Execute structure learning and test

If we want to learn a program and then test it, we can use the following query

induce([train],P), test(P,[test],LL,AUCROC,ROC,AUCPR,PR).

Complete example: bongard.pl


  • Reference: L. De Raedt and W. Van Laer. Inductive constraint logic. In Klaus P. Jantke, Takeshi Shinohara, and Thomas Zeugmann, editors, Proceedings of the Sixth International Workshop on Algorithmic Learning Theory, volume 997 of Lecture Notes in Artificial Intelligence, pages 80-94. SpringerVerlag, 1995.

For more information about how to perform learning see the manual (or PDF version).


Back to Index