I have a problem in Prolog for my final project. I try to reason about train system disruption pattern using bayesian network and prolog. I have bayesian network looks like following figure :
Bayesian Network Picture
I read on books Prolog Programming for Articial Intellegent 3rd addtion by Ivan Bratko, and I found how to represent Bayesian Network in Prolog.
You can see the Prolog code as follow :
%here is the rule for reasoning in bayesian network from the book :
prob([X|Xs],Cond,P) :- !,
prob(X, Cond, Px),
prob(Xs, [X|Cond], PRest),
P is Px * PRest.
prob([],_,1):- !.
prob(X, Cond, 1) :-
member(X, Cond),!.
prob(X, Cond, 0) :-
member(\+ X, Cond), !.
prob(\+ X, Cond, P) :- !,
prob(X, Cond, P0),
P is 1-P0.
%Use Bayes rule if condition involves a descendant of X
prob(X, Cond0, P):-
delete(Y, Cond0, Cond),
predecessor(X,Y),!, %Y is a descendant of X
prob(X, Cond, Px),
prob(Y, [X|Cond], PyGivenX),
prob(Y, Cond, Py),
P is Px * PyGivenX / Py. %Assuming Py > 0
%Cases when condition does not involves a descendant
prob(X, Cond, P) :-
p(X, P),!. % X a root cause - its probability given
prob(X, Cond, P) :- !,
findall((CONDi, Pi), p(X,CONDi,Pi), CPlist), %Condition on parents
sum_probs(CPlist, Cond, P).
sum_probs([],_,0).
sum_probs([(COND1,P1) | CondsProbs], COND, P) :-
prob(COND1, COND, PC1),
sum_probs(CondsProbs, COND, PRest),
P is P1 * PC1 + PRest.
predecessor(X, \+ Y) :- !, %Negated variable Y
predecessor(X,Y).
predecessor(X,Y) :-
parent(X,Y).
predecessor(X,Z) :-
parent(X,Y),
predecessor(Y,Z).
member(X, [X|_]).
member(X, [_|L]) :-
member(X,L).
delete(X, [X|L], L).
delete(X, [Y|L], [Y|L2]) :-
delete(X, L, L2).
Here also some the implementation of the bayesian network information in prolog (I only add some of them because it was too long):
p(static_inverter, [overhead_line], 0.005050505).
p(static_inverter, [\+ overhead_line], 0.000213767).
p(ac, [static_inverter], 0.5).
p(ac, [\+ static_inverter], 0.029749692).
p(door, [compressor], 0.026315789).
p(door, [\+ compressor], 0.006821).
p(horn, [compressor], 0.026315789).
p(horn, [\+ compressor], 0.000206697).
p(brake, [compressor], 0.026315789).
p(brake, [\+ compressor], 0.004340637).
p(switch, [signal, service_table], 0.5).
p(switch, [\+ signal, service_table], 0.346153846).
p(switch, [signal, \+ service_table], 0.054098361).
p(switch, [\+ signal, \+ service_table], 0.041364933).
p(overhead_line, [fire, fallen_tree], 0.5).
p(overhead_line, [fire, \+ fallen_tree], 0.005882353).
p(overhead_line, [\+ fire, fallen_tree], 0.304878049).
p(overhead_line, [\+ fire, \+ fallen_tree], 0.038850284).
p(pantograph, [overhead_line, fallen_tree], 0.038461538).
p(pantograph, [overhead_line, \+ fallen_tree], 0.002702703).
p(pantograph, [\+ overhead_line, fallen_tree], 0.017241379).
p(pantograph, [\+ overhead_line, \+ fallen_tree], 0.00440955).
for the full code you may see on here
unfortunately I have a problem when I try to reason some probabilities like :
?- prob(series, [horn], P).
?- prob(series, [brake], P).
?- prob(pantograph, [overhead_line], P).
It was said the error is something like this :
ERROR: Arithmetic: evaluation error: `zero_divisor'
ERROR: In:
ERROR: [27] _43124 is 0.045454539961694*0/0
ERROR: [25] prob([compressor],[\+brake,traction|...],_43166) at d:/kuliah/tugas/semester 8/for ta/[2] ta program/reasoningtraindisruptionwithprolog/rules.pl:2
ERROR: [24] sum_probs([(...,0.026315789),...],[\+brake,traction|...],_43216) at d:/kuliah/tugas/semester 8/for ta/[2] ta program/reasoningtraindisruptionwithprolog/rules.pl:37
ERROR: [22] prob([horn,door|...],[\+brake,traction|...],_43278) at d:/kuliah/tugas/semester 8/for ta/[2] ta program/reasoningtraindisruptionwithprolog/rules.pl:2
ERROR: [21] prob([\+brake,horn|...],[traction,wiper|...],_43334) at d:/kuliah/tugas/semester 8/for ta/[2] ta program/reasoningtraindisruptionwithprolog/rules.pl:3
ERROR: [20] prob([traction,...|...],[wiper,speedometer|...],_43390) at d:/kuliah/tugas/semester 8/for ta/[2] ta program/reasoningtraindisruptionwithprolog/rules.pl:3
Any one can help me to fix this error? Thanks in advance.
After introducing the safety test,
...
prob(Y, Cond, Py),
Py > 0,
P is Px * PyGivenX / Py. %Assuming Py > 0
and corrected a typo and several singleton warnings in your github code, I have these results:
?- prob(series, [horn], P).
false.
?- prob(series, [brake], P).
P = 0.086661842800551.
?- prob(pantograph, [overhead_line], P).
false.
So you can now try to understand why the code yields false instead of P = 0.0...
I realize why the intrpreter derive answer with zero_divisor error, it because when I query with :
?- prob(series, [horn], P).
?- prob(series, [brake], P).
?- prob(pantograph, [overhead_line], P)
All of them processed with rule :
prob(X, Cond0, P):-
delete(Y, Cond0, Cond),
predecessor(X,Y),!, %Y is a descendant of X
prob(X, Cond, Px),
prob(Y, [X|Cond], PyGivenX),
prob(Y, Cond, Py),
P is Px * PyGivenX / Py. %Assuming Py > 0
Whereas they should be processed with rule underneath :
prob(X, Cond, P) :-
p(X, P),!. % X a root cause - its probability given
prob(X, Cond, P) :- !,
findall((CONDi, Pi), p(X,CONDi,Pi), CPlist), %Condition on parents
sum_probs(CPlist, Cond, P).
Because the query not involves descendant of X
Any idea to distinguish both rules? Because I still use both rules recursively later?
I already try adding condition parent(X, Cond0) in prob(X, Cond0, P), but when I query with condition involves a descendant of X, the answer is wrong
Related
I tried this vanilla interpreter:
solve(true) :- !, true.
solve(X is E) :- !, X is E.
solve((A,B)) :- !, solve(A), solve(B).
solve(H) :- clause(H,B), solve(B).
Can we use it to meta-interpret some code? I tried this code,
requires SWI-Prolog 8.3.19, which runs fine normally:
sumlist([X|Y], R) => sumlist(Y, H), R is X+H.
sumlist([], R) => R is 0.
?- sumlist([1,2,3],X).
X = 6.
?- sumlist(X,Y).
ERROR: No rule matches sumlist(_21604,_21606)
But meta-interpretation goes wrong. The reason is that clause/2
doesn’t know about rules that use single sided unification:
?- clause(sumlist(A,B),C).
A = [_22728|_22730],
C = (sumlist(_22730, _22736), B is _22728+_22736) ;
A = [],
C = (B is 0).
?- solve(sumlist([1,2,3],X)).
X = 6.
?- solve(sumlist(X,Y)).
SWI-Prolog wurde unerwartet beendet.
Is there a solution for meta-interpreters and single sided unification?
One way out of the dilemma and stay inside the ISO core standard, is to translate single sided unfication to a combination of nonvar/1, (=)/2 and (==)/2, like here:
?- clause(sumlist(X,Y),Z), write((sumlist(X,Y):-Z)), nl, fail; true.
sumlist(_A, _B) :- nonvar(_A), _A = [_C|_D], sumlist(_D, _E), _B is _C+_E
sumlist(_A, _B) :- nonvar(_A), _A = [], _B is 0
Of course we need to add the built-ins nonvar/1, (=)/2 and (==)/2 as well to the meta interpreter:
solve(true) :- !.
solve(X is E) :- !, X is E.
solve(nonvar(X)) :- !, nonvar(X).
solve(X == Y) :- !, X == Y.
solve(X = Y) :- !, X = Y.
solve((A, B)) :- !, solve(A), solve(B).
solve(H) :- clause(H, B), solve(B).
Meta-interpreting sumlist/2 now works fine:
?- solve(sumlist([1,2,3],X)).
X = 6
?- solve(sumlist(X,Y)).
No
But the translator might challenge a Prolog system concering clause indexing. It moves away the functors from the head into the body. So the Prolog system would need some body front indexing as pioneered by YAP and found in Jekejeke Prolog.
Open Source:
Yet Another Pattern Matcher
https://gist.github.com/jburse/a3517410a28b759ef44f72584f89aaf8#file-picat3-pl
Vanilla Interpreter, Expansion Solution
https://gist.github.com/jburse/a3517410a28b759ef44f72584f89aaf8#file-vanilla4-pl
It turns out that SICStus Prolog doesn't have an occurs_check
Prolog flag. At least we couldn't find one, and this here
gives an error message:
/* SICStus 4.6.0 (x86_64-win32-nt-4) */
?- set_prolog_flag(occurs_check, true).
Domain error in argument 1 of set_prolog_flag/2
It seems the value "true" is not so much a problem, the
crictical unifications can be realized via the existing
built-in unify_with_occurs_check/2. An interesting value
of an occurs_check Prolog flag is the value "error".
How would one implement a predicate unify_with_occurs_check_and_error/2 ?
Please note, the solution for unify_with_occurs_check_and_error/2
should behave like unify_with_occurs_check/2, i.e. not trigger
attributed variables.
Here is an example usage of the Prolog flag where present:
?- set_prolog_flag(occurs_check, error).
true.
?- X = f(X).
ERROR: ...
And this is what one would do in SICStus Prolog:
?- unify_with_occurs_check_and_error(X, f(X)).
ERROR: ...
Was adapting the code from here and got the following solution:
unify_with_error(X, Y) :- var(X), var(Y), !, X = Y.
unify_with_error(X, Y) :- var(X), !, must_notin(X, Y), X = Y.
unify_with_error(X, Y) :- var(Y), !, must_notin(Y, X), X = Y.
unify_with_error(X, Y) :- functor(X, F, A), functor(Y, G, B),
F/A = G/B,
X =.. [_|L],
Y =.. [_|R],
maplist(unify_with_error, L, R).
must_notin(X, Y) :-
term_variables(Y, L),
maplist(\==(X), L), !.
must_notin(X, Y) :-
throw(error(occurs_check(X, Y),_)).
Seems to work and no interference with attributed variables:
/* SICStus 4.6.0 (x86_64-win32-nt-4) */
?- unify_with_error(X, f(X)).
error(occurs_check(_413,f(_413)),_409)
?- freeze(X, throw(ball)), unify_with_error(X, f(X)).
error(occurs_check(_413,f(_413)),_409)
I wonder whether there is a pure Prolog meta-interpreter with
only one rule. The usual Prolog vanilla meta-interpreter has two
rules. It reads as follows:
solve(true).
solve((A, B)) :- solve(A), solve(B). /* rule 1 */
solve(H) :- program(H, B), solve(B). /* rule 2 */
This Prolog vanilla meta-interpreter uses two rules /* rule 1 */
and /* rule 2 */. And the rest is facts. The program that
is executed is represented by program facts. Here is an example program:
program(append([], X, X), true).
program(append([X|Y], Z, [X|T]), append(Y, Z, T)).
program(nrev([], []), true).
program(nrev([H|T], R), (nrev(T, S), append(S, [H], R))).
And an example query:
?- solve(nrev([1,2,3], X)).
X = [3, 2, 1] .
Is there a way to represent the program differently as facts, and
then code a different meta-interpreter, which would use only facts
except for a single rule instead of two rules? Something that would
work for all pure Prolog programs, not only the nrev example?
Here is one idea, using a list to hold the rest of the computation:
solve([]).
solve([X|Xs]) :- program(X, Ys, Xs), solve(Ys).
program(true, Xs, Xs).
program(append([],X,X), Xs, Xs).
program(append([X|Y], Z, [X|T]), [append(Y,Z,T)|Xs], Xs).
program(nrev([],[]), Xs, Xs).
program(nrev([H|T],R), [nrev(T,S),append(S,[H],R)|Xs], Xs).
With test call (where one needs to wrap the call in a list).
?- solve([nrev([1,2,3],X)]).
X = [3,2,1] ? ;
no
Arguably, one could represent the program/3 facts as a DCG instead, for increased readability (but then it might not be considered a "fact" any more).
Here is another approach, known as binarization with continuation.
Its from this logic transformers paper here by Paul Tarau (2021).
solve(true).
solve(X) :- program(X, Y), solve(Y).
program(append([],X,X,C), C).
program(append([X|Y],Z,[X|T],C), append(Y,Z,T,C)).
program(nrev([],[],C), C).
program(nrev([H|T],R,C), nrev(T,S,append(S,[H],R,C))).
A little sanity check shows that it wurks:
?- solve(nrev([1,2,3], X, true)).
X = [3, 2, 1] ;
No
If ;/2 is allowed, then this seems to work:
solve(true).
solve(H) :- ((X, Y) = H, solve(X), solve(Y)); (program(H :- B), solve(B)).
program(append([], X, X) :- true).
program(append([X|Y], Z, [X|T]) :- append(Y, Z, T)).
program(nrev([], []) :- true).
program(nrev([H|T], R) :- (nrev(T, S), append(S, [H], R))).
Test:
?- solve(nrev([1,2,3], X)).
X = [3, 2, 1] ;
false.
This is my code, which is for Satchmo theorem proving. It does some unification.
:- op(700, xfx, ==>).
:- op(400, yfx, &).
:- op(400, yfx, or).
fact([a, 9]).
fact([b, 9]).
rule([a, X] & [b, X] ==> [c, X]). %% horn bit
rule([c, X] ==> [r, X] or [s, X]). %% non horn bit
rule([r, X] ==> [t, X]).
rule([s, X] ==> [t, X]).
horn(A & B) :-
!,
horn(A),
horn(B).
horn(A or B) :-
!,
(horn(A); horn(B)).
horn(P) :-
fact(P).
horn(P) :-
temp(P).
horn(P) :-
rule(SUBGOALS ==> P),
\+ P = (_A or _B),
horn(SUBGOALS).
satchmo(P) :-
retractall(temp(_)),
prove(P).
prove(P) :-
horn(P).
prove(P) :-
rule(LHS ==> (A or B)),
horn(LHS),
\+ horn(A or B),
cprove(A ==> P),
cprove(B ==> P).
cprove(A ==> P) :-
try(A),
(prove(P) ->
untry(A);
(untry(A), fail)).
try(A & B) :-
!,
try(A),
try(B).
try(A) :-
assert(temp(A)).
untry(A & B) :-
!,
untry(A),
untry(B).
untry(A) :-
retract(temp(A)).
To understand how is it working, we can do that by ?- spy([satchmo]).
1- if the given query is fact as:
?- satchmo([a, 9]).
yes.
or
?- satchmo([b, 9]).
yes.
the program will prove it as it is a fact.
2- If the query in the horn bit as:
?- satchmo([c, 9]).
yes.
the program will prove it as it is the horn rule.
3- If the query in the non-horn bit as:
?- satchmo([t, 9]).
yes.
It'll be proved as well.
This is working perfectly. But when I have tried to change it a bit. Instead of unification I need to do another kind of matching which can prove the following:
if I have:
rule[living, X] ==> [mortal, X].
[man, socrates].
I would like to prove:
?- satchmo([mortal, socrates]).
yes.
To do this I have amend my code a bit, so instead of having:
horn(P):-
fact(P).
I put something very similar:
horn(P):-
match(P, P0),
fact(P0).
and I have defined match as:
match(X, Y):-
X=Y.
I know that I have not do anything by this move, but I am thinking to amend the definition of match a bit to be able to prove what I need.
I am stuck somewhere here, look at my current code.
:- op(700, xfx, ==>).
:- op(400, yfx, &).
:- op(400, yfx, or).
:- op(400, yfx, <<<).
fact([a, 9]).
fact([b, 9]).
rule([a, X] & [b, X] ==> [c, X]). %% horn bit
rule([c, X] ==> [r, X] or [s, X]). %% non horn bit
rule([r, X] ==> [t, X]).
rule([s, X] ==> [t, X]).
man <<< human.
human <<< animal.
animal <<< living.
subset(X, X).
subset(X, Y) :-
X <<< Y.
subset(X, Z) :-
X <<< Y,
subset(Y, Z).
horn(A & B) :-
!,
horn(A),
horn(B).
horn(A or B) :-
!,
(horn(A); horn(B)).
horn(P) :-
fact(P).
horn(P) :-
temp(P).
horn(P) :-
rule(SUBGOALS ==> P),
\+ P = (_A or _B),
horn(SUBGOALS).
satchmo(P) :-
retractall(temp(_)),
prove(P).
prove(P) :-
horn(P).
prove(P) :-
rule(LHS ==> (A or B)),
horn(LHS),
\+ horn(A or B),
cprove(A ==> P),
cprove(B ==> P).
cprove(A ==> P) :-
try(A),
(prove(P) ->
untry(A);
(untry(A), fail)).
try(A & B) :-
!,
try(A),
try(B).
try(A) :-
assert(temp(A)).
untry(A & B) :-
!,
untry(A),
untry(B).
untry(A) :-
retract(temp(A)).
Here, we can test the subset:
?- subset(human, man).
yes.
The problem here, is I do not know how to achieve my goal by proving:
?- satchmo([mortal, socrates]).
yes.
from:
[living, X] ==> [mortal, X].
[man, socrates].
Could it be done by changing the definition of match? If not, is there any other method to do it?
Ok, done,
The solution of this problem is simply by changing the definition of match, so it will be as follows:
match(P, P0) :-
P = [X, _],
P0 = [Y, _],
subset(Y, X).
subset(X, X).
subset(X, Y) :-
X <<< Y.
subset(X, Z) :-
X <<< Y,
subset(Y, Z).
and when I have this facts:
fact([man, socrates]).
man <<< human.
human <<< animal.
animal <<< living.
and this rule:
rule([living, X] ==> [mortal, X]).
I can prove:
?- satchmo([mortal, socrates]).
Using recursion i need to find all blood relatives of any person in the family tree.
My attempt so far has failed.
Here is my code, with my attempt at the bottom
female(helen).
female(debbie).
female(louise).
female(yvonne).
female(belinda).
female(heather).
male(john).
male(andrew).
male(barry).
male(daniel).
male(charles).
parent(helen, debbie).
parent(helen, barry).
parent(helen, louise).
parent(john, debbie).
parent(john, barry).
parent(andrew, louise).
parent(debbie, yvonne).
parent(debbie, daniel).
parent(barry, charles).
parent(barry, belinda).
parent(louise, heather).
mother(X, Y) :-
female(X),
parent(X, Y).
father(X, Y) :-
male(X),
parent(X,Y).
child(X, Y) :-
parent(Y, X).
daughter(X, Y) :-
parent(Y, X),
female(X).
son(X, Y) :-
parent(Y,X),
male(X).
sister(X, Y) :-
female(X),
parent(Q,X),
parent(Q,Y).
brother(X, Y) :-
male(X),
parent(Q,X),
parent(Q,Y).
sibling(X, Y) :-
parent(Q,X),
parent(Q,Y),
X\=Y.
uncle(X, Y) :-
parent(P,Y),
brother(X,P).
aunt(X, Y) :-
parent(P,Y),
sister(X,P).
cousin(C, Cousin):-
parent(Parent,C),
sibling(Parent,AU),
child(Cousin,AU).
%Here is Relative
relative(An, Re):-
An\=Re,
parent(An, Re);
sibling(An, Re).
relative(An, Rela):-
parent(An, Child);
sibling(An, Rela),
relative(Child, Rela),
An\=Rela, C\=Rela.
Sort of works, but gets stuck in an infinite loop at the end.
Thanks.
not sure about 'relatives' (any person bound reachable in a parent/child relation ?), but your definition seems more complex than needed ( do you know what ; does ?).
I tried
relative(An, Re):-
parent(An, Re).
relative(An, Rela):-
parent(An, C),
relative(C, Rela).
that yields
16 ?- forall(relative(X,Y),writeln(X:Y)).
helen:debbie
helen:barry
helen:louise
john:debbie
john:barry
andrew:louise
debbie:yvonne
debbie:daniel
barry:charles
barry:belinda
louise:heather
helen:yvonne
helen:daniel
helen:charles
helen:belinda
helen:heather
john:yvonne
john:daniel
john:charles
john:belinda
andrew:heather
true.
edit I tried another relation, using a generalized parent/2, but still too permissive.
relative(Pers, Re):-
ancestor(Re, Pers) ; sibling(Pers, Re) ; cousin(Pers, Re) ; uncle(Re, Pers) ; aunt(Re, Pers).
ancestor(Anc, Pers) :- parent(Anc, Pers).
ancestor(Anc, Pers) :- parent(Anc, P), ancestor(P, Pers).
Maybe cousin/2 is too permissive also. Here is the graph
I guess that heather should have only luise,helen,andrew as relatives. It's this true ?
edit given latest comment, seems that the definition could be right. I get
24 ?- setln(X,relative(heather,X)).
andrew
barry
belinda
charles
daniel
debbie
helen
louise
yvonne
true.
that is everyone is related to heather apart john.
Here's one way that works, but it will sometimes produce duplicates. Using setof will give the unique collection. I avoided the miscellaneous relations and stuck with descendent or parent.
descendent(A, B) :-
parent(B, A).
descendent(A, B) :-
parent(C, A),
descendent(C, B).
relative(A, B) :-
descendent(B, A).
relative(A, B) :-
descendent(A, B).
relative(A, B) :-
descendent(A, C),
descendent(B, C),
A \= B.
setof(A, relative(heather, A), Relatives).
Relatives = [andrew,barry,belinda,charles,daniel,debbie,helen,louise,yvonne]
If you don't have setof, you can use the findall/3 and sort/2 ISO predicates:
findall(A, relative(heather, A), R), sort(R, Relatives).
Note that the solutions presented so far assume that all of the relatives have unique names. A general case of dealing with relatives with the same first name (and possibly the same last name) you would need to track and compare lineages for differences.