This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/packages/prism/exs/noisy_or/alarm_nor_generic.psm

175 lines
5.8 KiB
Plaintext

%%%%
%%%% Bayesian networks using noisy OR (2) -- alarm_nor_generic.psm
%%%%
%%%% Copyright (C) 2004,2006,2007,2008
%%%% Sato Laboratory, Dept. of Computer Science,
%%%% Tokyo Institute of Technology
%% This example is borrowed from:
%% Poole, D., Probabilistic Horn abduction and Bayesian networks,
%% In Proc. of Artificial Intelligence 64, pp.81-129, 1993.
%%
%% (Fire) (Tampering)
%% / \ /
%% ((Smoke)) (Alarm)
%% |
%% (Leaving) (( )) -- observable node
%% | ( ) -- hidden node
%% ((Report))
%%
%% In this network, we assume that all rvs (random variables) take on
%% {yes,no} and also assume that only two nodes, `Smoke' and `Report', are
%% observable.
%%
%% Furthermore, as did in alarm_nor_basic.psm, we consider that the Alarm
%% variable's CPT given through the noisy-OR rule. That is, we have the
%% following inhibition probabilities:
%%
%% P(Alarm=no | Fire=yes, Tampering=no) = 0.3
%% P(Alarm=no | Fire=no, Tampering=yes) = 0.2
%%
%% The CPT for the Alarm variable is then constructed from these inhibition
%% probabilities and the noisy-OR rule:
%%
%% +------+-----------+--------------------+----------------+
%% | Fire | Tampering | P(Alarm=yes) | P(Alarm=no) |
%% +------+-----------+--------------------+----------------+
%% | yes | yes | 0.94 = 1 - 0.3*0.2 | 0.06 = 0.3*0.2 |
%% | yes | no | 0.7 = 1 - 0.3 | 0.3 |
%% | no | yes | 0.8 = 1 - 0.2 | 0.2 |
%% | no | no | 0 | 1.0 |
%% +------+-----------+--------------------+----------------+
%%
%% While alarm_nor_basic.psm uses network-specific implementation, in this
%% program, we attempt to introduce a more generic routine that can handle
%% noisy OR. To be more concrete:
%%
%% - We specify noisy OR nodes in a declarative form (with noisy_or/3).
%% - We introduce generic probabilistic predicates that make probabilistic
%% choices, following the specifications of noisy OR nodes.
%%
%% The definition of these generic probabilistic predicates are given in
%% noisy_or.psm, and we will include noisy_or.psm into this program.
%%
%%-------------------------------------
%% Quick start (the same as those listed in alarm_nor_basic.psm):
%%
%% ?- prism(alarm_nor_generic).
%%
%% Print the CPT of the Alarm variable constructed from the noisy OR rule:
%% ?- print_dist_al.
%%
%% Print logical formulas that express the probabilistic behavior of
%% the noisy OR rule for Alarm:
%% ?- print_expl_al.
%%
%% Get the probability and the explanation graph:
%% ?- prob(world(yes,no)).
%% ?- probf(world(yes,no)).
%%
%% Get the most likely explanation and its probability:
%% ?- viterbif(world(yes,no)).
%% ?- viterbi(world(yes,no)).
%%
%% Compute conditional hindsight probabilities:
%% ?- chindsight(world(yes,no),world(_,_,_,_,_,_)).
%% ?- chindsight_agg(world(yes,no),world(_,_,query,yes,_,no)).
%%
%% Learn parameters from randomly generated 100 samples
%% ?- alarm_learn(100).
%%-------------------------------------
%% Declarations:
values(_,[yes,no]).
:- include('noisy_or.psm').
% We include generic probabilistic predicates that can handle
% noisy-OR. The following predicates will be available:
%
% - cpt(X,PaVs,V) represents a probabilistic choice where a
% random variable X given instantiations PaVs of parents
% takes a value V. If X is an ordinary node, a random
% switch bn(X,PaVs) will be used. On the other hand, if
% X is a noisy-OR node, switch cause(X,Y) will be used,
% where Y is one of parents of X.
%
% - set_nor_params/0 sets inhibition probabilisties (i.e.
% the parameters of switches cause(X,Y)) according to
% the specifications for noisy-OR nodes with noisy_or/3.
%%------------------------------------
%% Modeling part:
world(Sm,Re):- world(_,_,_,Sm,_,Re).
world(Fi,Ta,Al,Sm,Le,Re) :-
cpt(fi,[],Fi), % P(Fire)
cpt(ta,[],Ta), % P(Tampering)
cpt(sm,[Fi],Sm), % CPT P(Smoke | Fire)
cpt(al,[Fi,Ta],Al), % CPT P(Alarm | Fire,Tampering)
cpt(le,[Al],Le), % CPT P(Leaving | Alarm)
cpt(re,[Le],Re). % CPT P(Report | Leaving)
% declarations for noisy OR nodes:
noisy_or(al,[fi,ta],[[0.7,0.3],[0.8,0.2]]).
%%------------------------------------
%% Utility part:
alarm_learn(N) :-
unfix_sw(_), % Make all parameters changeable
set_params, % Set ordinary parameters
set_nor_params, % Set inhibition parameters
get_samples(N,world(_,_),Gs), % Get N samples
fix_sw(bn(fi,[])), % Preserve the parameter values
learn(Gs). % for {msw(bn(fi,[]),yes), msw(bn(fi,[]),no)}
:- set_params.
:- set_nor_params.
set_params:-
set_sw(bn(fi,[]),[0.1,0.9]),
set_sw(bn(ta,[]),[0.15,0.85]),
set_sw(bn(sm,[yes]),[0.95,0.05]),
set_sw(bn(sm,[no]),[0.05,0.95]),
set_sw(bn(le,[yes]),[0.88,0.12]),
set_sw(bn(le,[no]),[0.01,0.99]),
set_sw(bn(re,[yes]),[0.75,0.25]),
set_sw(bn(re,[no]),[0.10,0.90]).
%% Check routine for Noisy-OR
print_dist_al:-
( member(Fi,[yes,no]),
member(Ta,[yes,no]),
member(Al,[yes,no]),
get_cpt_prob(al,[Fi,Ta],Al,P),
format("P(al=~w | fi=~w, ta=~w):~t~6f~n",[Al,Fi,Ta,P]),
fail
; true
).
print_expl_al:-
( member(Fi,[yes,no]),
member(Ta,[yes,no]),
member(Al,[yes,no]),
get_cpt_probf(al,[Fi,Ta],Al),
fail
; true
).
%% [Note] prob/1 and probf/1 will fail if its argument fails
get_cpt_prob(X,PaVs,V,P):-
( prob(cpt(X,PaVs,V),P)
; P = 0.0
),!.
get_cpt_probf(X,PaVs,V):-
( probf(cpt(X,PaVs,V))
; format("cpt(~w,~w,~w): always false~n",[X,PaVs,V])
),!.