pepl.pl -- An implementation of the FAM algorithm.

Pepl is an implemention of the failure adjusted (FAM) algorithm which does parameter estimation (PE) of the probability labels of stochastic logic programs (SLPs).

See documentation fam/1 for details on how to run parameter estimation on SLPs.

Example stochastic programs are in directory slp and example run scripts are in examples.

Licence

This software is distributed under the MIT licence.

Installation and testing ...

Pepl runs on current versions of SWI (7) and Yap (6.3).

... on SWI

pack_install(pepl).
[library(pepl)].
[pack('pepl/examples/main')].
main.

... on Yap

Download latest sources from http://stoics.org.uk/~nicos/sware/pepl or https://github.com/nicos-angelopoulos/pepl

gunzip pepl-*tgz
tar xf pepl-*tar
cd pepl-*
cd examples
yap
[main].
main.

Resolution

In addition to parameter estimation Pepl implements two way of performing resolution over SLPs: stochastic sampling resolution and SLD-based probabilisic inference.

Stochastic sampling resolution

These predicates allow to sample from a loaded stochastic logic program (Slp). The resolution strategy here are that of chosing between probabilistic choices according to their relative values. The main idea is that when sampling many times from a top goal will in the long run sample each derivation path in proportion to the probability of the derivation. The probability of a derivation/refutation, is simply the product of all the probabilities attached to resolution steps during the derivation.

For very deep probabilistic programs, it is sometimes useful to but a minimum value of probability we are interested in. This is a way to shorten the search space without losing significant amounts of probility mass (see second argument of sample/5).

See

SLD-based probabilisic inference

These predicates allow standard SLD exploration of a stochastic query against an SLP. Predicates here allows to explore what is derivable and often attach a probability and ather information to each derivation.

Note that in probabilistic inference we often are more interested in failures than in standard LP. This is because there is a probability mass loss which each failed probabilistic branch.

Probabilistic inference predicates

Predicates index

Package information

author
- Nicos Angelopoulos
version
- 2.3, 2023/5/6, added extensive sampling and inference support
- 2.2, 2022/1/2
- 2.1, 2017/2/25
- 2.0.6, 2014/01/28
See also
- the user guide at pack('pepl/doc/pepl-user_guide.pdf').
- James Cussens. Parameter estimation in stochastic logic programs. Machine Learning, 44(3):245-271, 2001. ftp://ftp.cs.york.ac.uk/pub/aig/Papers/james.cussens/jcslpmlj.pdf
- Nicos Angelopoulos, Notes on the implementation of FAM, 3rd Probabilistic Logic Programming workshop (a ILP 2016 workshop), 03/09/2016, http://ceur-ws.org/Vol-1661/paper-05.pdf
- pepl website http://stoics.org.uk/~nicos/sware/pepl
license
- This software is distributed under the MIT licence
 ssave(+File)
Save the stochastic program currently in memory to a file.
 sls
Listing of the stochastic program currently in memory.
 switch_dbg(Switch)
Switch debugging of fam/1 to either on or off.
 dbg_pepl(+Goal)
Call Goal iff in (pepl) debugging.
 fam(Opts)
Run the failure adjusted maximisation (FAM) parameter estimation algorithm.

For SLP source file jc_ml_S1.slp

0.5:: s(X,p) :- p(X), p(X).
0.5:: s(X,q) :- q(X).
0.5:: p(a).
0.5:: p(b).
0.5:: q(a).
0.5:: q(b).

and data file jc_ml_S1_data.pl

frequencies([s(a,p)-4,s(a,q)-3,s(b,p)-2,s(b,q)-3]).

the call succeeds with the learned PPs

?- fam( [goal(s(_A,_B)),slp(jc_ml_S1),datafile('jc_ml_S1_data.pl'),final_pps(PPs)] ).
PPs = [0.6602,0.3398,0.5858,0.4142,0.5,0.5]

Options

count(CountMeth=exact)
CountMeth in {exact, store, sample};
times(Tms=1000)
only relevant with CountMeth=sample
termin(TermList)
currently TermList knows about the following terms
interactive
ask user if another iteration should be run
iter(I)
I is the number of iterations
prm_e(E)
parameter difference between iteration, that renders termination due to convergence of all parameters, between two iterations
ll_e(L)
likelihood convergence limit;
goal(Goal)
the top goal, defaults to an all vars version of data;
pregoal(PreGoal)
a goal that called only once, before experiments are run. The intuition is that PreGoal will partially instantiate Goal.
data(Data)
the data to use, overrides datafile/1. Data should be a list of Yield-Times pairs. (All Yields of Goal should be included in Data, even if that means some get Times = 0.)
prior(Prior=none)
the distribution to replace the probability labels with. By default prior is used, so input parameters are used as given in Slp source file. System also knows about uniform and random. Any other distribution should come in Prolog source file named Prior.pl and define Prior/3 predicate. First argument is a list of ranges (Beg-End) for each stochastic predicate in source file. Second argument, is the list of actual probability labels in source file. Finally, third argument should be instantiated to the list of labels according to Prior.
datafile(DataFile=data.pl)
the data file to use, default is data.pl. DataFile should have either a number of atomic formulae or a single formula of the form : frequencies(Data).
complement(Complement=none)
one of : none (with PrbSc = PrbTrue, the default), success (with PrbSc = 1 − PrbF ail), or quotient (with PrbSc = PrbT rue/(PrbT rue + PrbF ail)).
setrand(SetRand=false)
sets random seeds. SetRand = true sets the seeds to some random triplet while the default value false, does not set them. Any other value for SetRand is taken to be of the form rand(S1,S2,S3) as expected by system predicate random of the supported prolog systems.
eps(Eps=0)
the depth Epsilon. Sets the probability limit under which Pepl considers a path as a failed one.
write_iterations(Wrt=all)
indicates which set of parameters to output. Values for Wrt are: all, last and none.
write_ll(Bool==true)
takes a boolean argument, idicating where loglikelihoods should be printed or not.
debug(Dbg=off)
should be set to on or off. If on, various information about intermediate calculations will be printed.
return(RetOpts=[])
a list of return options. The terms RetOpts contain variables. These will be instantiated to the appropriate values signified by the name of each corresponding term. Recognised are, initial pps/1 for the initial parameters, final pps for the final/learned parameters, termin/1 for the terminating reason, ll/1 for the last loglikelyhood calculated, iter/1 for the number of iterations performed, and seeds/1 for the seeds used.
keep_pl(KeepBool==false)
if true, the temporary Prolog file that contains the translated SLP, is not deleted.
exception(Handle=rerun)
identifies the action to be taken if an exception is raised while running Fam. rerun means that the same Fam call is executed repeatedly. Any other value for Handle will cause execution to abort after printing the exception raised.
 sload_pe(Files)
 sload_pe(Files, Options)
Load an SLP to memory. If the source file has an slp extension the extension may be omitted. Pepl looks in the following directories and order for the source file(s). ., and ./slp/ while on SWI it also looks in, pack(’pepl/slp/’).
 pepl_citation(-Atom, -Bibterm)
This predicate succeeds once for each publication related to this library. Atom is the atom representation suitable for printing while Bibterm is a bibtex(Type,Key,Pairs) term of the same publication. Produces all related publications on backtracking.
 pepl_version(-Version, -Date)
Pepl's current Version (Maj:Min:Fix) and publication date (date(Year,Month,Day)).
?- pepl_version(V,D).
V = 2:3:0,
D = date(2021, 5, 6).
version
- 2:3:0 2023/05/06
- 2:2:0 2021/01/01
 sample(Goal)
True iff Goal is a stochastic goal that can be refuted from the stochastic clauses in memory.
?- sload_pe(coin).
?- seed_pe.
?- sample(coin(Flip)).
Flip = head.

sample(Goal) is equivalent to sample(Goal,0,_Path,Succ,Prb) where Succ is not fail and Prb is not 0.

?- seed_pe.
?- sample(coin(Flip),0,Path,Succ,Prb).
Flip = head,
Path = [1],
Prb = 0.5.

The probability with which refutations/branches are sampled are proportional to the probabilities on the clauses. That is, sampling replaces SLD resolution with stochastic resolution.

If you have packs: mlu, b_real and Real.

?- lib(mlu).
?- sload_pe(coin).
?- seed_pe.
?- mlu_sample( sample(coin(Side)), 100, Side, Freqs ),
   mlu_frequency_plot( Freqs, [interface(barplot),outputs([svg]),las=2] ).
Freqs = [head-53, tail-47].

Produces file: real_plot.svg

which contains the barplot for 53 heads and 47 tails from 100 coin flipping experiments.

Note that sampling is distinct to calling a Goal for finding its refutations and total probabilities. Sampling always takes the most general form of Goal and also returns failure paths. The idea is that if the underlying SLP defines a unique probability space summing up to 1, then each branch is sampled proportionaly and failed branches are integral part of the space.

The above is particularly important if Goal is partially instantiated.

?- seed_pe.
?- sample(coin(tail)).
false.
?- seed_pe.
?- sample(coin(head)).
true.
?- seed_pe.
?- sample(coin(Flip)).
Flip = head.

To demonstrate the inability of SLPs to operate over arbitrary length objects, check:

?- sload_pe(member3).
?- lib(mlu).
?- seed_pe.
?- mlu_sample( sample(member3(X,[a,b,c])), 100, X, Freqs ),
   mlu_frequency_plot( Freqs, [interface(barplot),outputs(png),stem('meb3from3'),las=2] ).
Freqs = [a-31, b-20, c-22, fail-27].

Produces file: meb3from3.png

doc/html/images/meb3from3.png

...and:

?- lib(mlu).
?- sload_pe(member3).
?- seed_pe.
?- mlu_sample( sample(member3(X,[a,b,c,d,e,f,g,h])), 100, X, Freqs ),
   mlu_frequency_plot( Freqs, [interface(barplot),outputs(png),stem('meb3from8'),las=2] ),
   write( freqs(Freqs) ), nl.
freqs([a-34,b-16,c-22,d-5,e-9,f-6,fail-2,g-3,h-3])

Produces file: meb3from8.png

doc/html/images/meb3from8.png

author
- nicos angelopoulos
version
- 0:1 2023/05/04
See also
- sample/5, for full control of sampling stochastic goals
- scall/1, scall/5, scall_sum/2 and scall_sum/5 for finding the probability of refutations and goals.
 sample(+Goal, +Eps, -Path, -Succ, -Prb)
True iff Goal is a stochastic goal that can be sampled from the stachastic clauses in memory.

Eps is the epsilon value below which a derivation is considered a failure (prunes low probability branches). Path is the arithmetic index of the clauses used in the derivation. Succ is bound to false if this was a failure branch and is unbound otherwise. Prb is the probability of the sampled branch.

This predicate implements probabilistic sampling. Instead of SLD resolution we use the probabilistic labels to sample from the tree. There is no backtracing, and probabilistic failures will be returned.

?- sload_pe(coin).
?- seed_pe.
?- sample(coin(Flip),0,Path,Succ,Prb).
Flip = head,
Path = [1],
Prb = 0.5.

The probability with which refutations/branches are sampled are proportional to the probabilities on the clauses. That is, sampling replaces SLD resolution with stochastic resolution.

Note that sampling is distinct to calling a Goal for finding its refutations and total probabilities. Sampling always takes the most general form of Goal and also returns failure paths. The idea is that if the underlying SLP defines a unique probability space summing up to 1, then each branch is sampled proportionaly and failed branches are integral part of the space.

The above is particularly important if Goal is partially instantiated.

?- seed_pe.
?- sample(coin(tail),0,Path,Succ,Prb).
Path = [1],
Succ = fail,
Prb = 0.5.
?- seed_pe.
?- sample(coin(head),0,Path,Succ,Prb).
Path = [1],
Prb = 0.5
?- seed_pe.
?- sample(coin(Flip),0,Path,Succ,Prb).
Flip = head,
Path = [1],
Prb = 0.5.
author
- nicos angelopoulos
version
- 0:1 2023/05/04
See also
- scall/1, scall/2, scall/5, scall_sum/2 and scall_findall/2 for finding the probability of refutations and goals.
 scall_sum(+Goal, -Prb)
Prb is the sum of probabilities for all refutations of Goal- which should be a stochastic goal.
?- sload_pe(coin).
?- seed_pe.
?- scall_sum( coin(Flip), Prb ).
Prb = 1.0.

?-  scall_sum( coin(head), Prb ).
Prb = 0.5.

?- scall_sum( coin(tail), Prb ).
Prb = 0.5.

A more complex example:

?- sload_pe(doubles).

?- scall_sum( doubles(head), Prb ).
Prb = 0.25.

?- scall_sum( doubles(tail), Prb ).
Prb = 0.25.

?- scall_sum( doubles(Side), Prb ).
Prb = 0.5.
author
- nicos angelopoulos
version
- 0:1 2023/05/05
 scall_findall(+Goal, -Pairs)
Findall Instantiation-Prb pairs for derivations of stochastic Goal.

It also returns failed path probabilities. Instantiation is either the reserved token 'fail', or a term within Goal. If Goal is a single, variable, argument term, then the value of the variable is preserved. If Goal is of the form Left-Right, then Left is preserved and Right is expected to be the callable Goal, otherwise the whole of Goal is preserved.

The order in Pair are according to standard SLD resolution. The only special feature is that probabilistic failures are returned. There is no uniqueness on Instantion values.

?- sload_pe(doubles).
?- scall_findall( doubles(X), Pairs ).
Freqs = [head-0.25, fail-0.25, fail-0.25, tail-0.25].
?- sload_pe(member3).
?- scall_findall( X-member3(X,[a,b,c]), Pairs ).
Pairs = [a-1/3, b-0.2222222222222222, c-0.14814814814814814, fail-0.09876543209876543, fail-0.19753086419753085].
 scall(Goal)
Succeeds for all instantiations for which stochastic Goal has a successful derivation.

This uses standard SLD resolution so the order is as per Prolog. Failure paths are ignored here.

?- sload_pe(coin).
?- scall(coin(Flip)).
Flip = head ;
Flip = tail.

?- sload_pe(doubles).
?- scall(doubles(X)).
X = head ;
X = tail.

Compare to

?- scall_findall( doubles(X), Pairs ).
Pairs = [head-0.25, fail-0.25, fail-0.25, tail-0.25].
author
- nicos angelopoulos
version
- 0:2 2023/05/05, this used to be sampling based
See also
- scall/6 for full control
- scall_findall/2, scall_sum/2.
 scall(+Goal, -Prb)
Succees for derivation of stochastic Goal having branch probabilitiy Prb.

Succeeds for all instantiations for which stochastic Goal has a successful derivation, with Prb being the product of all probabilitic labels seen on the way.

This uses standard SLD resolution so the order is as per Prolog. Failure paths are ignored here.

?- sload_pe(coin).
?- scall( coin(Flip), Prb ).
Flip = head,
Prb = 0.5 ;
Flip = tail,
Prb = 0.5.

?- scall( coin(head), Prb ).
Prb = 0.5 ;
false.

?- scall( coin(tail), Prb ).
Prb = 0.5.

Also,

?- scall( doubles(X), Prb ).
X = head,
Prb = 0.25 ;
X = tail,
Prb = 0.25.

Compare to

?- scall_findall( doubles(X), Pairs ).
Pairs = [head-0.25, fail-0.25, fail-0.25, tail-0.25].
author
- nicos angelopoulos
version
- 0:1 2023/05/04
 scall(+Goal, +Eps, -Path, -Succ, +Prb)
Implements SLD-based probabilistic inference.

This predicate is for people interested in the iternals of pepl. Use at your own peril.

The predicate arguments are as follows.

?- sload_pe(coin).
?- seed_pe.
?- scall(coin(Flip), 0, sample, Path, Succ, Prb ).
Flip = head,
Path = [1],
Prb = 0.5.

... or to backtrack overall paths

?- scall(coin(Flip), 0, all, Path, Succ, Prb ).
Flip = head,
Path = [1],
Prb = 0.5 ;
Flip = tail,
Path = [2],
Prb = 0.5.
 seed_pe
Set random seed to a standard location.

A convenience predicate for running the examples from a common starting point for the random seed.

Specifically it unfolds to

?- set_random(seed(101)).
?- sload_pe(coin).
?- seed_pe.
?- sample(coin(Flip)).
Flip = head.

?- set_random(seed(101)).
?- sample(coin(Flip)).
Flip = head.

?- sample(coin(Flip)).
Flip = tail.
author
- nicos angelopoulos
version
- 0.1 2023/05/05