1:- module(pha,
2 [ run_belief/1
3 , observe//1
4 , unobserve//0
5 , joint//1, joint//2
6 , prob//2
7 , explanation//1
8 , explanations//1
9 , explain//1
10 , load/1
11 , goals//0
12 , edit//0
13 , load//1
14 , unobserve_all//0
15 ]). 16
17:- meta_predicate run_belief(//).
95:- use_module(library(dcg_core)). 96:- use_module(library(dcg_pair)). 97:- use_module(library(dcg_macros)). 98:- use_module(library(typedef)). 99:- use_module(library(listutils), [cons/3]). 100:- use_module(library(math), [add/3]). 101:- use_module(pha_load, [load/1, edit//0]). 102:- use_module(pha_sched, [nil_belief/1, cons_belief/3, explanation/2, prob/2]). 103:- use_module(library/frozen,[]). % should also work using library/lazy
104
105:- type stream(A) ---> [A|stream(A)].
106:- type interval(A) ---> range(A,A).
107:- type improving(A) ---> stream(interval(A)).
108:- type tol(A) ---> abs(A); rel(A).
109
116
117help --> {print_help}.
118print_help :-
119 maplist(command_help,
120 [ help - "Print this help."
121 , load(G) - "Load PHA program ~w"/[G]
122 , observe(G) - "Add goal ~w to stack of observations"/[G]
123 , unobserve - "Remove most recently observed goal"
124 , unobserve_all - "Remove all observed goals"
125 , goals - "Print all goals on observation stack"
126 , prob(G,P) - "Estimate probability ~w of goal ~w given current observations"/[P,G]
127 , joint(P) - "Estimate joint probability ~w of current observations"/[P]
128 , joint(Tol,P ) - "Estimate joint probability ~w of current observations to within tolerance ~w"/[P,Tol]
129 , explanations(Eps) - "Print explanations of current observations up to missing prob ~w"/[Eps]
130 , explanation(E) - "Find an explanation ~w of current goal stack, more on backtracking"/[E]
131 , explain(G) - "Print an explanation of goal ~w, more on backtracking"/[G]
132 ]).
133
134command_help(Cmd-Text) :-
135 ( numbervars(Cmd-Text, 0, _),
136 (Text = F/A -> format(string(T),F,A); T=Text),
137 format(' ~p ~t~20|- ~s\n', [Cmd,T]),
138 fail
139 ; true
140 ).
145run_belief(Cmd) :- nil_belief(E1), call_dcg(Cmd,[true-E1],_).
149load(F) --> {load(F)}, unobserve_all.
153observe(G) --> get([_-E1|_]), {cons_belief(G,E1,E2)}, cons(G-E2).
157unobserve --> \+get([_]), [_].
161unobserve_all --> unobserve -> unobserve_all; [].
165goals --> get(ES), {maplist(print_goal,ES)}.
166print_goal(G-_) :- writeln(G).
172prob(A|B,P) --> !, iso((observe(B),prob(A,P))).
173prob(A,P) --> !, iso((prob_series(PP), observe(A),
174 prob_series(PA))),
175 { default_tolerance(Tol),
176 lazy:map(pha:cprob,PA,PP,V),
177 approx(Tol,V,P)
178 }.
179
180cprob(range(P1,P2),range(_,Q2),range(R1,R2)) :- R1 is P1/Q2, R2 is P2/Q2.
181prob_series(P) --> get([_-E|_]), {prob(E,P)}.
187joint(R) --> {default_tolerance(Tol)}, joint(Tol,R).
188joint(Tol,R) --> prob_series(P), {approx(Tol,P,R)}.
193explanations(Eps) --> get([_-E|_]), {print_explanations(Eps,E)}.
198explanation(Ex) --> get([_-E|_]), {explanation(E,Ex)}.
203explain(G) --> iso((observe(G), explanation(E), {print_explanation(E)})).
204
206
207print_explanations(Eps,E) :-
208 accumex(Eps,E,(0-1)-Exps,(Tot-Rem)-[]),
209 nl, maplist(print_explanation,Exps), nl,
210 show('Total found probability',Tot),
211 show(' Unexplored probability',Rem).
212
213print_explanation(P:ex(G,AS)) :- nl,
214 show(' Solution',G),
215 show(' Explanation',AS),
216 show(' Probability',P).
217
218accumex(_,Es) --> {lazy:empty(Es)}, !, \< \> set(nothing).
219accumex(Th,Es1) -->
220 {lazy:head(Es1, refinement(P:Ex,Rem))},
221 (add(P) <\> set(Rem)) <\> [P:Ex], ({Rem=just(R), R>Th} -> {lazy:tail(Es1, Es2)}, accumex(Th,Es2); []).
229approx(Tol,Rs,R) :-
230 lazy:head(Rs, R1),
231 ( within_tolerance(Tol,R1) -> R=R1
232 ; lazy:tail(Rs,RT), approx(Tol,RT,R)
233 ).
234
235user:portray(F) :- float(F), format('~g',[F]).
236user:portray(range(Min,Max)) :-
237 Middle is (Min+Max)/2,
238 Diff is (Max-Min)/2,
239 format('~g ±~g',[Middle,Diff]).
240
241default_tolerance(rel(0.001)).
242
243within_tolerance(abs(Thresh),range(Min,Max)) :- Thresh>=Max-Min.
244within_tolerance(rel(Thresh),range(Min,Max)) :- Thresh*(Max+Min)>=2*(Max-Min).
245
246show(Label,Value) :- float(Value), !, format('~w: ~5f\n',[Label,Value]).
247show(Label,Value) :- format('~w: ~w\n',[Label,Value])
Probabilistic Horn Abduction with random variables
This is a more or less complete reimplementation of David Poole's probabilistic Horn abudction.
The mechanism for declaring and using random variables has been changed. Instead of using disjoint declarations in the PHA program file, you should use rv declarations, which look like this:
Where RVTerm is an arbitrary term idenitfying the random variable, possibly using variables to stand for parameters of the random variable, and Value1, Value2 etc are arbitrary terms which can only contain variables that are in RVTerm. You can also compute the distribution for an RV using an ordinary Prolog clause, eg
Then, to query an random variable, use
RVTerm must be a ground term unifying with one of the random variables, and Value can be non-ground. This makes is much harder to go wrong with variables and use of functors in assumable hypotheses.
Types
In the following,
rv(A)
andhead
are not formally defined. Syntactically, they are abitrary terms. A term of typerv(A)
denotes the name of random variable as found in the first argument of an rv/2 declartion and whose values are of typeA
. Then, anassumption
is an assertion about the value of a random variable, soA
head
is any term that is found in the head position in the rule database. The typegoal
is a supertype ofassumption
andhead
and can be defined syntactically by the following predicate:A program in the object language consists of a sequence of statements, where
Usage
To load a model, use
load(FileSpec)
, where Spec is a file specification using the SWI Prolog's file search path mechanism. An extension of 'pha' is assumed.To get an interactive shell to work with a model, you can use run_belief/1 with dcgshell as the command: this gives you a stateful top-level, where the state is managed by a DCG and the commands are interpreted as DCG goals. The DCG goal load//1 is available for loading models in the belief DCG.
At this point, you can now declare observations in the form of PHA goals which are known to be true. The system computes the possible explanations for these observations and their probabilities. Observations are cumulative. For example:
*/