yap-6.3/packages/CLPBN/examples/city.pfl

/*
 Model from the paper "First-order
 probabilistic inference"
*/

:- use_module(library(pfl)).

%:- set_solver(ve).
%:- set_solver(hve).
%:- set_solver(jt).
%:- set_solver(bdd).
%:- set_solver(bp).
%:- set_solver(cbp).
%:- set_solver(gibbs).
%:- set_solver(lve).
%:- set_solver(lkc).
%:- set_solver(lbp).

:- multifile person/2.
:- multifile ev/1.

person(joe,nyc).
person(p2, nyc).
person(p3, nyc).
person(p4, nyc).
person(p5, nyc).

ev(descn(p2, fits)).
ev(descn(p3, fits)).
ev(descn(p4, fits)).
ev(descn(p5, fits)).

bayes city_conservativeness(C)::[high,low] ;
	cons_table ;
	[person(_,C)].

bayes gender(P)::[male,female] ;
	gender_table ;
	[person(P,_)].

bayes hair_color(P)::[dark,bright], city_conservativeness(C) ;
	hair_color_table ;
	[person(P,C)].

bayes car_color(P)::[dark,bright], hair_color(P) ;
	car_color_table ;
	[person(P,_)].

bayes height(P)::[tall,short], gender(P) ;
	height_table ;
	[person(P,_)].

bayes shoe_size(P)::[big,small], height(P) ;
	shoe_size_table ;
	[person(P,_)].

bayes guilty(P)::[y,n] ;
	guilty_table ;
	[person(P,_)].

bayes descn(P)::[fits,dont_fit], car_color(P),
		hair_color(P), height(P), guilty(P) ;
	descn_table ;
	[person(P,_)].

bayes witness(C), descn(Joe), descn(P2) ;
	witness_table ;
	[person(_,C), Joe=joe, P2=p2].


cons_table(
/* y        */ [ 0.8,
/* n        */   0.2 ]).

gender_table(
/* male     */ [ 0.55,
/* female   */   0.45 ]).

hair_color_table(
/*               high  low  */
/* dark     */ [ 0.05, 0.1,
/* bright   */   0.95, 0.9 ]).

car_color_table(
/*               dark bright */
/* dark     */ [ 0.9, 0.2,
/* bright   */   0.1, 0.8 ]).

height_table(
/*               male female */
/* tall     */ [ 0.6, 0.4,
/* short    */   0.4, 0.6 ]).

shoe_size_table(
/*               tall short */
/* big      */ [ 0.9, 0.1,
/* small    */   0.1, 0.9 ]).

guilty_table(
/* yes      */ [ 0.23,
/* no       */   0.77 ]).

descn_table(
/*               car_color(P), hair_color(P), height(P), guilty(P) */
/* fits     */ [ 0.99, 0.5,  0.23, 0.88, 0.41, 0.3,  0.76, 0.87,
/* fits     */   0.44, 0.43, 0.29, 0.72, 0.23, 0.91, 0.95, 0.92,
/* dont_fit */   0.01, 0.5,  0.77, 0.12, 0.59, 0.7,  0.24, 0.13,
/* dont_fit */   0.56, 0.57, 0.71, 0.28, 0.77, 0.09, 0.05, 0.08 ]).

witness_table(
/*               descn(Joe), descn(P2) */
/* t        */ [ 0.2, 0.45, 0.24, 0.34,
/* f        */   0.8, 0.55, 0.76, 0.66 ]).


runall(G, Wrapper) :-
	findall(G, Wrapper, L),
	execute_all(L).


execute_all([]).
execute_all(G.L) :-
	call(G),
	execute_all(L).


is_joe_guilty(Guilty) :-
	witness(nyc, t),
	runall(X, ev(X)),
	guilty(joe, Guilty).


% ?- is_joe_guilty(Guilty).