Related
Got this strange behaviour. I was running these test cases:
s1 :-
Q=[[lambda,symbol(_3026),[cons,[quote,_3434],
[quote,_3514]]],[quote,_3206]],
P=[_3434|_3514],
freeze(_3434, (write(foo), nl)),
unify_with_occurs_check(P, Q).
s2 :-
Q=[[lambda,symbol(_3026),[cons,[quote,_3434],
[quote,_3514]]],[quote,_3206]],
P=[_3434|_3514],
freeze(_3434, (write(foo), nl)),
freeze(_3514, (write(bar), nl)),
unify_with_occurs_check(P, Q).
Now I get these results, where the outcome of s2 is wrong. The outcome is wrong in two respects, first _3434 gets triggered and second unify_with_occurs_check succeeds:
SWI-Prolog (threaded, 64 bits, version 8.3.16)
?- s1.
false.
?- s2.
foo
bar
true.
That _3434 shouldn't get triggered follows from 7.3.2 Herband Algorithm in ISO core standard. According to clause 7.3.2 f) 1) an instantiation of variable X to a term t is only propagated when it X does not occur in t.
That the unification should fail follows from clause 7.3.2 g). So it seems in SWI-Prolog, attributed variables in various incarnations such as freeze/2, dif/2, etc… seem to interfer with unify_with_occurs_check.
Any workaround?
Edit 06.02.2021:
The bug has been fixed in SWI-Prolog 8.3.17 (devel) and
was backported to SWI-Prolog 8.2.4 (stable) as well.
Here is another somewhat simpler workaround:
unify(X,X) :-
acyclic_term(X).
Certainly, this only works as expected if the two arguments are finite from the very start, but at least it does not loop in this case.
One way out could be to roll your own unify_with_occurs_check/2. We can write it in Prolog itself, as was done in the past, for Prolog systems that did not have unify_with_occurs_check/2:
R.A.O'Keefe, 15 September 1984
http://www.picat-lang.org/bprolog/publib/metutl.html
Here is an alternative take that uses (=..)/2 and term_variables/2:
unify(X, Y) :- var(X), var(Y), !, X = Y.
unify(X, Y) :- var(X), !, notin(X, Y), X = Y.
unify(X, Y) :- var(Y), !, notin(Y, X), X = Y.
unify(X, Y) :- functor(X, F, A), functor(Y, G, B),
F/A = G/B,
X =.. [_|L],
Y =.. [_|R],
maplist(unify, L, R).
notin(X, Y) :-
term_variables(Y, L),
maplist(\==(X), L).
I now get the expected result:
?- s1.
false.
?- s2.
false.
Datalog is not Turing complete.
But what is its computational class?
Is it equivalent to Finite state machine or Pushdown machine (i.e. context free) ... or is it something in between?
Let's assume we have access, whether built-in or defined in the language by us, to the following predicates:
Head(x, y) iff y is a list and x is the first element in the list
Tail(x, y) iff x and y are lists and x is the same as y but is missing y's first element
Equal(x, y) iff x and y are the the same thing
First off, I think it's clear that this language can accept all the regular languages. By the Myhill-Nerode theorem, all states in a minimal DFA for a regular language correspond to a unique equivalence class under the indistinguishability relation. It seems like we could have one predicate per equivalence class/state to represent whether a list corresponding to an input string belongs to that class, and then another predicate that is true only if one of the predicates corresponding to an accepting state is true. So, for the language over {a, b} with an even number of a and an odd number of b, a minimal DFA has four states:
O
|
V
q0<---a--->q1
^ ^
| |
b b
| |
V V
q2<---a--->q3
Here, q2 is the only accepting state. Our DataLog program might look like:
Q0(()).
Q0(x) :- Head(y, x), Equal(y, 'a'), Tail(z, x), Q1(z).
Q0(x) :- Head(y, x), Equal(y, 'b'), Tail(z, x), Q2(z).
Q1(x) :- Head(y, x), Equal(y, 'a'), Tail(z, x), Q0(z).
Q1(x) :- Head(y, x), Equal(y, 'b'), Tail(z, x), Q3(z).
Q2(x) :- Head(y, x), Equal(y, 'a'), Tail(z, x), Q3(z).
Q2(x) :- Head(y, x), Equal(y, 'b'), Tail(z, x), Q0(z).
Q3(x) :- Head(y, x), Equal(y, 'a'), Tail(z, x), Q2(z).
Q3(x) :- Head(y, x), Equal(y, 'b'), Tail(z, x), Q1(z).
EvenAOddB(x) :- Q2(x).
Based on this example I think it's clear we can always encode transitions in this fashion and so any regular language can be accepted. Thus, DataLog is at least as powerful as deterministic finite automata.
We can define this:
// Last(x, y) iff x is the last element of y
Last(x, y) :- Head(x, y), Tail(z, y), Equal(z, ()).
// AllButLast(x, y) iff x and y are the same list but x is missing the last element of y
AllButLast((), (x)).
AllButLast(x, y) :- Head(w, x), Head(z, y), Equal(w, z),
Tail(w', x), Tail(z', y), AllButLast(w', z').
Now we can recognize lists corresponding to strings in the context-free language a^n b^n:
// ANBN(x) iff x is a list beginning with n 'a's followed by n 'b's
ANBN(()).
ANBN(x) :- Head(y, x), Equal(y, 'a'), Tail(z, x),
Last(w, z), Equal(w, 'b'), AllButLast(z', z),
ANBN(z').
It's easy to tweak that predicate to find the language of even-length palindromes, and from there it's easy to tweak to find the language of all palindromes. I feel confident we can also get it to accept languages like balanced parentheses, etc. Based on this experience, I am guessing that we can accept all the context-free languages.
Can we get a context-sensitive language? Let's try a^n b^n c^n. If we assume DataLog has built-in predicates like this for integer types:
Zero(x) iff x is equal to zero
Successor(x, y) iff x and y are integers and x = y + 1
Then I think we can, as follows:
ANBNCN(()).
ANBNCN(x) :- Zero(y), ANBNCNZ(x, y).
ANBNCNZ(x, y) :- BN(x, y).
ANBNCNZ(x, y) :- Head(w, x), Equal(w, 'a'),
Last(z, x), Equal(z, 'c'),
Tail(u, x), AllButLast(v, u),
Successor(r, y), ANBNCNZ(v, r).
BN(x, y) :- Head(w, x), Equal(w, 'b'),
Successor(y, z), Tail(u, x),
BN(u, z).
What the above says is the following:
the empty string is in a^n b^n c^n
otherwise, a string is in a^n b^n c^n if f(s, 0) is true
f(s, n) is true if s consists only of n instances of 'b'
f(s, n) is true if s starts with a, ends with c, and f(s', n + 1) is true of everything in the middle
This should work since each recursive call of f(s, n) strips one a and one c off the ends and remembers how many it has counted. It then counts off that many instances of b once all the a and c are gone.
My feeling based on this is that we can probably do some or all of the context-sensitive languages as well. Probably, the lack of unbounded execution is precisely what distinguishes the linear-bounded automata (productions in phrase-structure grammars must have a RHS no longer than the LHS) from general unrestricted grammars (whose intermediate forms can grow and shrink arbitrarily).
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
I'm writing a prolog program that will check if two math expressions are actually the same. For example, if my math expression goal is: (a + b) + c then any of the following expressions are considered the same:
(a+b)+c
a+(b+c)
(b+a)+c
(c+a)+b
a+(c+b)
c+(a+b)
and other combinations
Certainly, I don't expect to check the combination of possible answers because the expression can be more complex than that.
Currently, this is my approach:
For example, if I want to check if a + b *c is the same with another expression such as c*b+a, then I store both expression recursively as binary expressions, and I should create a rule such as ValueOf that will give me the "value" of the first expression and the second expression. Then I just check if the "value" of both expression are the same, then I can say that both expression are the same. Problem is, because the content of the expression is not number, but identifier, I cannot use the prolog "is" keyword to get the value.
Any suggestion?
many thanks
% represent a + b * c
binExprID(binEx1).
hasLeftArg(binEx1, a).
hasRightArg(binEx1, binEx2).
hasOperator(binEx1, +).
binExprID(binEx2).
hasLeftArg(binEx2, b).
hasRightArg(binEx2, c).
hasOperator(binEx2, *).
% represent c * b + a
binExprID(binEx3).
hasLeftArg(binEx3, c).
hasRightArg(binEx3, b).
hasOperator(binEx3, *).
binExprID(binEx4).
hasLeftArg(binEx4, binEx3).
hasRightArg(binEx4, a).
hasOperator(binEx4, +).
goal:- valueOf(binEx1, V),
valueOf(binEx4, V).
Math expressions can be very complex, I presume you are referring to arithmetic instead. The normal form (I hope my wording is appropriate) is 'sum of monomials'.
Anyway, it's not an easy task to solve generally, and there is an ambiguity in your request: 2 expressions can be syntactically different (i.e. their syntax tree differ) but still have the same value. Obviously this is due to operations that leave unchanged the value, like adding/subtracting 0.
From your description, I presume that you are interested in 'evaluated' identity. Then you could normalize both expressions, before comparing for equality.
To evaluate syntactical identity, I would remove all parenthesis, 'distributing' factors over addends. The expression become a list of multiplicative terms. Essentially, we get a list of list, that can be sorted without changing the 'value'.
After the expression has been flattened, all multiplicative constants must be accumulated.
a simplified example:
a+(b+c)*5 will be [[1,a],[b,5],[c,5]] while a+5*(c+b) will be [[1,a],[5,c],[5,b]]
edit after some improvement, here is a very essential normalization procedure:
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N).
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[1, N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(msort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
accum(T2, [Total|Symbols]) :-
include(number, T2, Numbers),
foldl(mul, Numbers, 1, Total),
exclude(number, T2, Symbols).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
Some test:
?- arith_equivalence(a+(b+c), (a+c)+b).
true .
?- arith_equivalence(a+b*c+0*77, c*b+a*1).
true .
?- arith_equivalence(a+a+a, a*3).
true .
I've used some SWI-Prolog builtin, like include/3, exclude/3, foldl/5, and msort/2 to avoid losing duplicates.
These are basic list manipulation builtins, easily implemented if your system doesn't have them.
edit
foldl/4 as defined in SWI-Prolog apply.pl:
:- meta_predicate
foldl(3, +, +, -).
foldl(Goal, List, V0, V) :-
foldl_(List, Goal, V0, V).
foldl_([], _, V, V).
foldl_([H|T], Goal, V0, V) :-
call(Goal, H, V0, V1),
foldl_(T, Goal, V1, V).
handling division
Division introduces some complexity, but this should be expected. After all, it introduces a full class of numbers: rationals.
Here are the modified predicates, but I think that the code will need much more debug. So I allegate also the 'unit test' of what this micro rewrite system can solve. Also note that I didn't introduce the negation by myself. I hope you can work out any required modification.
/* File: arith_equivalence.pl
Author: Carlo,,,
Created: Oct 3 2012
Purpose: answer to http://stackoverflow.com/q/12665359/874024
How to check if two math expressions are the same?
I warned that generalizing could be a though task :) See the edit.
*/
:- module(arith_equivalence,
[arith_equivalence/2,
normalize/2,
distribute/2,
sortex/2
]).
:- [library(apply)].
arith_equivalence(E1, E2) :-
normalize(E1, N),
normalize(E2, N), !.
normalize(E, N) :-
distribute(E, D),
sortex(D, N).
distribute(A, [[1, A]]) :- atom(A).
distribute(N, [[N]]) :- number(N).
distribute(X * Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
% distribute over factors
findall(Mono, (member(Xm, Xn), member(Ym, Yn), append(Xm, Ym, Mono)), L).
distribute(X / Y, L) :-
normalize(X, Xn),
normalize(Y, Yn),
divide(Xn, Yn, L).
distribute(X + Y, L) :-
distribute(X, Xn),
distribute(Y, Yn),
append(Xn, Yn, L).
sortex(L, R) :-
maplist(dsort, L, T),
maplist(accum, T, A),
sumeqfac(A, Z),
exclude(zero, Z, S),
msort(S, R).
dsort(L, S) :- is_list(L) -> msort(L, S) ; L = S.
divide([], _, []).
divide([N|Nr], D, [R|Rs]) :-
( N = [Nn|Ns],
D = [[Dn|Ds]]
-> Q is Nn/Dn, % denominator is monomial
remove_common(Ns, Ds, Ar, Br),
( Br = []
-> R = [Q|Ar]
; R = [Q|Ar]/[1|Br]
)
; R = [N/D] % no simplification available
),
divide(Nr, D, Rs).
remove_common(As, [], As, []) :- !.
remove_common([], Bs, [], Bs).
remove_common([A|As], Bs, Ar, Br) :-
select(A, Bs, Bt),
!, remove_common(As, Bt, Ar, Br).
remove_common([A|As], Bs, [A|Ar], Br) :-
remove_common(As, Bs, Ar, Br).
accum(T, [Total|Symbols]) :-
partition(number, T, Numbers, Symbols),
foldl(mul, Numbers, 1, Total), !.
accum(T, T).
sumeqfac([[N|F]|Fs], S) :-
select([M|F], Fs, Rs),
X is N+M,
!, sumeqfac([[X|F]|Rs], S).
sumeqfac([F|Fs], [F|Rs]) :-
sumeqfac(Fs, Rs).
sumeqfac([], []).
zero([0|_]).
mul(X, Y, Z) :- Z is X * Y.
:- begin_tests(arith_equivalence).
test(1) :-
arith_equivalence(a+(b+c), (a+c)+b).
test(2) :-
arith_equivalence(a+b*c+0*77, c*b+a*1).
test(3) :-
arith_equivalence(a+a+a, a*3).
test(4) :-
arith_equivalence((1+1)/x, 2/x).
test(5) :-
arith_equivalence(1/x+1, (1+x)/x).
test(6) :-
arith_equivalence((x+a)/(x*x), 1/x + a/(x*x)).
:- end_tests(arith_equivalence).
running the unit test:
?- run_tests(arith_equivalence).
% PL-Unit: arith_equivalence ...... done
% All 6 tests passed
true.
I am trying to make a simple knowledge base. However, I'm struggling getting the category system to work.
Here is the program so far:
subset(tomatoes, fruits).
subset(fruits, food).
subset(X, Z) :- subset(X, Y), subset(Y, Z), not(X==Y), not(Y==Z), not(X==Z).
member(X, Z) :- member(X, Y), subset(Y, Z).
member(t1, tomatoes).
Query:
member(t1,tomatoes).
ERROR: Out of local stack
Exception: (1,765,494) member(t1, _G28504) ? abort
% Execution Aborted
You encountered the phenomenon called left recursion. Solving the goal subset(X, Z) is reduced to solving the goal subset(X, Y) with a new unbound variable Y and this leads to solving the same goal subset(X, Z) etc, ad infinitum. Left recursions should be avoided.
The usual approach is to dinstinguish between basic facts and rules for transitive closures. You could try:
subset1(tomatoes, fruits).
subset1(fruits, food).
subset(X, Y) :- subset1(X, Y).
subset(X, Z) :- subset1(X, Y), subset(Y, Z).
member1(t1, tomatoes).
member1(t2, tomatoes).
member(X, Y) :- member1(X, Y).
member(X, Z) :- member1(X, Y), subset(Y, Z).
?- member(t1, food). ===> TRUE
There is no left recursion in this formulation. First a direct fact is tried that can terminate the recursion. Only if there is no fact, a recursive call is performed.