I want to understand SICStus-style extensible unification.
The User's Manual on library(atts) states that:
Module:verify_attributes(-Var, +Value, -Goals) hook
...
verify_attributes/3 may invoke arbitrary Prolog goals, but Var should not be bound by it. Binding Var will result in undefined behavior.
...
In the case when a single unification binds multiple attributed variables, first all such bindings are undone, then the following actions are carried out for each relevant variable:
For each relevant module M, M:verify_attributes/3 is called, collecting a list of returned Goals.
The variable binding is redone.
Any Goals are called.
Any goals blocked on the variable, that has now become unblocked, are called.
So far, I came up with the following interpretation of the above:
Different verify_attribute/3 handlers hooked on Var, see the same state of Var: All see it "pre_unify".
verify_attribute/3 must not bind Var, but it may bind other attributed variables.
These bindings are to be delayed, too, so that the handlers not only see the same state of Var, but of all attributed variables involved.
Above list of actions entails "5. Force any delayed bindings of attributed variables."
Am I moving in the right direction—is this what "done, then undone, then redone" is all about?
Please help!
That mechanism was originally designed by Christian Holzbaur and implemented by yours truly. Re. your interpretation:
Different verify_attribute/3 handlers hooked on Var, see the same
state of Var: All see it "pre_unify".
Right.
verify_attribute/3 must not bind Var, but it may bind other
attributed variables.
Right.
These bindings are to be delayed, too, so that the handlers not only
see the same state of Var, but of all attributed variables involved.
Wrong. If it binds other attributed variables, the whole extended unification mechanism gets invoked recursively on those variables.
Above list of actions entails "5. Force any delayed bindings of
attributed variables."
Wrong.
This is the meta-interpreter:
:- use_module(library(lists), [append/2,append/3,maplist/2,maplist/3,member/2,select/3]).
% Source: https://sicstus.sics.se/sicstus/docs/3.7.1/html/sicstus_17.html
% Source: https://sicstus.sics.se/sicstus/docs/latest4/html/sicstus.html/lib_002datts.html#lib_002datts
element(Es, E) :-
member(E, Es).
get_atts(S, _, _, _, _, _) :-
var(S),
throw(error(instantiation_error,get_atts/3)).
get_atts(_, V, _, _, _, _) :-
nonvar(V),
throw(error(uninstantiation_error,get_atts/3)).
get_atts(+, V, D, G_3, As0, As) :-
element(As0, s(V0,D0,G0_3)),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3), !,
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As0, As).
get_atts(-, V, D, G_3, As0, _) :-
element(As0, s(V0,D0,G0_3)),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3),
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As0, _), !,
false.
get_atts(-, _, _, _, As, As).
put_atts(S, _, _, _, _, _) :-
var(S),
throw(error(instantiation_error,put_atts/3)).
put_atts(_, V, _, _, _, _) :-
nonvar(V),
throw(error(uninstantiation_error,put_atts/3)).
put_atts(_, _, D, _, _, _) :-
var(D),
throw(error(instantiation_error,put_atts/3)).
put_atts(+, V, D, G_3, As0, [s(V,D,G_3)|As]) :-
functor(D, A, N),
functor(D0, A, N),
select(s(V0,D0,_), As0, As),
V == V0, !.
put_atts(+, V, D, G_3, As, [s(V,D,G_3)|As]).
put_atts(-, V, D, G_3, As0, As) :-
select(s(V0,D0,G0_3), As0, As1),
V == V0,
\+ \+ s(V,D,G_3) = s(V0,D0,G0_3),
mi([s(V0,D0,G0_3) = s(V,D,G_3)], As1, As), !.
put_atts(-, _, _, _, As, As).
mi(G, As) :-
mi([G], [], As).
mi([], As, As).
mi([G|_], _, _) :-
var(G),
throw(error(instantiation_error,mi/3)).
mi([G|_], As, _) :-
false,
writeq([G,As]), nl,
false.
mi([false|_], _, _) :-
!,
false.
mi([true|Gs], As0, As) :-
!,
mi(Gs, As0, As).
mi([G0|Gs], As0, As) :-
functor(G0, call, N),
N #> 0,
G0 =.. [call,F|Bs0], !,
F =.. Bs1,
append(Bs1, Bs0, Bs),
G =.. Bs,
mi([G|Gs], As0, As).
mi([(G0, G)|Gs], As0, As) :-
!,
mi([G0,G|Gs], As0, As).
mi([(G ; _)|Gs], As0, As) :-
G \= (_->_),
mi([G|Gs], As0, As).
mi([(G0 -> G ; _)|Gs], As0, As) :-
mi([G0], As0, As1), !,
mi([G|Gs], As1, As).
mi([(_ ; G)|Gs], As0, As) :-
!,
mi([G|Gs], As0, As).
mi([(G0 -> G)|Gs], As0, As) :-
mi([G0], As0, As1), !,
mi([G|Gs], As1, As).
mi([catch(G0, E, G)|Gs], As0, As) :-
catch(mi([G0|Gs], As0, As), E, mi([G|Gs], As0, As)).
mi([throw(E)|_], _, _) :-
throw(E).
mi([A \= B|_], As, _) :-
mi([A = B], As, _), !,
false.
mi([_ \= _|Gs], As0, As) :-
!,
mi(Gs, As0, As).
mi([get_atts(Mode, V, D, G_3)|Gs], As0, As) :-
!,
get_atts(Mode, V, D, G_3, As0, As1),
mi(Gs, As1, As).
mi([put_atts(Mode, V, D, G_3)|Gs], As0, As) :-
!,
put_atts(Mode, V, D, G_3, As0, As1),
mi(Gs, As1, As).
% mi([G0|_], _, _) :-
% functor(G0, A, N),
% \+ pi(A, N), !,
% throw(error(existence_error(procedure,A/N),mi/3)).
mi([G0|Gs0], As0, As) :-
copy_term(G0, G),
head_body(G, Gs, Gs0),
unify(G0, G, As0, As1),
mi(Gs, As1, As).
unify(G0, G, As0, As) :-
maplist(arg(1), As0, Vs0),
sort(Vs0, Vs),
unify_(G0, G, Vs, As0, As).
unify_(G, G, Vs, As0, As) :-
maplist(var, Vs),
term_variables(Vs, Vs), !,
As0 = As.
unify_(G0, G, Vs, As0, As) :-
unifiable(G0, G, Eqs0),
shrink_equations(Vs, Eqs0, Eqs),
gather_attributes_goals(Eqs, As0, As1, Gs),
G0 = G, % maplist(call, Eqs),
filter_attributes(As1, As2),
mi(Gs, As2, As).
shrink_equations(_, [], []).
shrink_equations(Vs, [Eq|Eqs0], Eqs) :-
call(Eq),
maplist(var, Vs),
term_variables(Vs, Vs), !,
shrink_equations(Vs, Eqs0, Eqs).
shrink_equations(Vs, [Eq|Eqs0], [Eq|Eqs]) :-
shrink_equations(Vs, Eqs0, Eqs).
unifiable(X, Y, Eqs) :-
\+ \+ X = Y,
unifiable_([X], [Y], Eqs, Eqs, []).
unifiable_([], [], _, Eqs, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, Eqs1, Eqs) :-
nonvar(X),
nonvar(Y), !,
functor(X, A, N),
functor(Y, A, N),
X =.. [A|Xs0],
Y =.. [A|Ys0],
unifiable_(Xs0, Ys0, Eqs0, Eqs1, Eqs2),
unifiable_(Xs, Ys, Eqs0, Eqs2, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, Eqs1, Eqs) :-
element([X=Y,Y=X], Eq),
\+ maplist(\==(Eq), Eqs0), !,
unifiable_(Xs, Ys, Eqs0, Eqs1, Eqs).
unifiable_([X|Xs], [Y|Ys], Eqs0, [X=Y|Eqs1], Eqs) :-
unifiable_(Xs, Ys, Eqs0, Eqs1, Eqs).
gather_attributes_goals(Eqs, As0, As, Gs) :-
gather_attributes_goals_(Eqs, As0, As, Gss, []),
append(Gss, Gs).
gather_attributes_goals_([], As, As, Gss, Gss).
gather_attributes_goals_([X=Y|Eqs], As0, As, Gss0, Gss) :-
% TODO: Investigate `==(X)` and `==(Y)`, since goals are executed.
filter(ar(1, ==(X)), As0, SubAs0),
maplist(arg(3), SubAs0, Gs0),
execute_attributes(Gs0, X, Y, As0, As1, Gss0, Gss1),
filter(ar(1, ==(Y)), As1, SubAs1),
maplist(arg(3), SubAs1, Gs1),
execute_attributes(Gs1, Y, X, As1, As2, Gss1, Gss2),
gather_attributes_goals_(Eqs, As2, As, Gss2, Gss).
execute_attributes([], _, _, As, As, Gss, Gss).
execute_attributes([G_3|Gs], X, Y, As0, As, [Gs0|Gss0], Gss) :-
mi([call(G_3, X, Y, Gs0)], As0, As1),
execute_attributes(Gs, X, Y, As1, As, Gss0, Gss).
filter_attributes([], []).
filter_attributes([s(V,_,_)|As0], As) :-
nonvar(V), !,
filter_attributes(As0, As).
filter_attributes([s(V,D,_)|As0], As) :-
var(V),
functor(D, A, N),
functor(D0, A, N),
element(As0, s(V0,D0,_)),
V == V0, !,
filter_attributes(As0, As).
filter_attributes([A|As0], [A|As]) :-
filter_attributes(As0, As).
ar(N, G_1, A0) :-
arg(N, A0, A),
call(G_1, A).
filter(_, [], []).
filter(G_1, [L|Ls0], Ms) :-
call(G_1, L), !,
Ms = [L|Ls],
filter(G_1, Ls0, Ls).
filter(G_1, [_|Ls0], Ls) :-
filter(G_1, Ls0, Ls).
head_body(true, Rs, Rs).
head_body(A=A, Rs, Rs).
head_body(element([A|_], A), Rs, Rs).
head_body(element([_|As], A), [element(As, A)|Rs], Rs).
head_body(select(A0, [A0|As], As), Rs, Rs).
head_body(select(A0, [A|As0], [A|As]), [select(A0, As0, As)|Rs], Rs).
head_body(maplist(_, []), Rs, Rs).
head_body(maplist(G_1, [A|As]), [call(G_1, A), maplist(G_1, As)|Rs], Rs).
head_body(p(_), Rs, Rs).
head_body(p(a), Rs, Rs).
head_body(var(T), Rs, Rs) :-
var(T).
head_body(nonvar(T), Rs, Rs) :-
nonvar(T).
head_body(T0==T, Rs, Rs) :-
T0 == T.
head_body(T0\==T, Rs, Rs) :-
T0 \== T.
head_body(sort(As0,As), Rs, Rs) :-
sort(As0, As).
head_body(freeze(V, G_0), [(
( var(V) ->
put_atts(+, W, frozen(G_0), freezer),
W = V
; nonvar(V), call(G_0)
)
)|Rs], Rs).
head_body(freezer(V, W, Gs), [(
get_atts(+, V, frozen(G0), _),
( var(W) ->
( get_atts(+, W, frozen(G1), _) ->
put_atts(+, V, frozen((G0, G1)), freezer)
; true
),
Gs = []
; Gs = [G0]
)
)|Rs], Rs).
head_body(domain(V, Dom0), [(
( var(Dom0) ->
get_atts(+, V, dom(Dom0), _)
; maplist(nonvar, Dom0),
sort(Dom0, Dom),
Dom = [E|Es],
( Es = [] ->
V = E
; put_atts(+, W, dom(Dom), contraction),
V = W
)
)
)|Rs], Rs).
head_body(contraction(V, W, Gs), [(
get_atts(+, V, dom(Dom0), _),
( var(W) ->
( get_atts(+, W, dom(Dom1), _) ->
intersection(Dom0, Dom1, Dom),
Dom = [E|Es],
( Es = [] ->
Gs = [W=E]
; put_atts(+, V, dom(Dom), contraction),
% put_atts(+, W, dom(Dom), contraction),
Gs = []
)
; Gs = []
)
; ( element(Dom0, W) ->
true
; false
),
Gs = []
)
)|Rs], Rs).
head_body(intersection(Us, Vs, Ws), [(
( (Us = [] ; Vs = []) ->
Ws = []
; [U|Us0] = Us,
( select(V, Vs, Vs0), U == V ->
[U|Ws0] = Ws
; Vs0 = Vs,
Ws0 = Ws
),
intersection(Us0, Vs0, Ws0)
)
)|Rs], Rs).
/*
head_body(dif(X, Y), [(
X \== Y,
( X \= Y ->
true
; put
)
)|Rs], Rs).
head_body(differentiator(V, W, Gs), [(
get_atts(+, V, dif(Vs), _),
( var(W) ->
( get_atts(+, W, dif(Ws), _) ->
intersection(Vs, Ws, Xs),
maplist(differentiate(V, W), Xs, Gs)
; Gs = []
)
; Gs = []
)
)|Rs], Rs).
% */
test :-
writeq(freeze), nl,
mi(freeze(A,false), As),
writeq([A,As]), nl,
false.
test :-
writeq(freeze), nl,
mi((freeze(A,false),freeze(A,true)), As),
writeq([A,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8])), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8]),X=Y), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
writeq(domain), nl,
mi((domain(X,[5,6,7,1]),domain(Y,[3,4,5,6]),domain(Z,[1,6,7,8]),X=Y,Y=Z), As),
writeq([X,Y,Z,As]), nl,
false.
test :-
halt.
For a quick test run test/0.
The predicates of interest are get_atts/6 and put_atts/6. This meta-interpreter doesn't handle module so the interface has been generalized (thus creating new unknown issue).
This hasn't been tested extensively, the predicate gather_attributes_goals/4 may need a deeper inspection. Only freeze/2 and domain/2 has been implemented (but need more testing). Implementing dif/2 could help in testing it. Implementing cut could also help load a library like clpz for testing.
Unification is done with unify/4 where handling the attributed variables begins.
This is the first implementation polished, it's more something to learn how does it work, I still need to work on something better.
I've been trying for a while now to implement a Dijkstra shortest path algorithm in JIProlog. There are a few implementations available online, such as here and here, but they all return the path as a list of nodes. This is problematic for my implementation, because I'm technically using a multigraph, where vertices can be connected by multiple edges. Therefore, I need an algorithm that returns a list of edges rather than a list of nodes.
I've been trying to adjust the first implementation I mentioned to track edges, but I get lost in the dijkstra_l/3 rule. Could someone help me? Thanks!
I answered some time ago to a similar question, with an implementation.
Alas, that code doesn't work with the lastes SWI-Prlog, I've debugged and found that ord_memberchk (used for efficiency) has changed behaviour. I've replaced with memberchk and now is working...
I would suggest to use the output of the algorithm with a simple post processing pass that recovers the edges from nodes, selecting the smaller value. I've implemented as it dijkstra_edges/3
/* File: dijkstra_av.pl
Author: Carlo,,,
Created: Aug 3 2012
Modified:Oct 28 2012
Purpose: learn graph programming with attribute variables
*/
:- module(dijkstra_av, [dijkstra_av/3,
dijkstra_edges/3]).
dijkstra_av(Graph, Start, Solution) :-
setof(X, Y^D^(member(d(X,Y,D), Graph) ; member(d(Y,X,D), Graph)), Xs),
length(Xs, L),
length(Vs, L),
aggregate_all(sum(D), member(d(_, _, D), Graph), Infinity),
catch((algo(Graph, Infinity, Xs, Vs, Start, Solution),
throw(sol(Solution))
), sol(Solution), true).
dijkstra_edges(Graph, Start, Edges) :-
dijkstra_av(Graph, Start, Solution),
maplist(nodes_to_edges(Graph), Solution, Edges).
nodes_to_edges(Graph, s(Node, Dist, Nodes), s(Node, Dist, Edges)) :-
join_nodes(Graph, Nodes, Edges).
join_nodes(_Graph, [_Last], []).
join_nodes(Graph, [N,M|Ns], [e(N,M,D)|Es]) :-
aggregate_all(min(X), member(d(N, M, X), Graph), D),
join_nodes(Graph, [M|Ns], Es).
algo(Graph, Infinity, Xs, Vs, Start, Solution) :-
pairs_keys_values(Ps, Xs, Vs),
maplist(init_adjs(Ps), Graph),
maplist(init_dist(Infinity), Ps),
%ord_memberchk(Start-Sv, Ps),
memberchk(Start-Sv, Ps),
put_attr(Sv, dist, 0),
time(main_loop(Vs)),
maplist(solution(Start), Vs, Solution).
solution(Start, V, s(N, D, [Start|P])) :-
get_attr(V, name, N),
get_attr(V, dist, D),
rpath(V, [], P).
rpath(V, X, P) :-
get_attr(V, name, N),
( get_attr(V, previous, Q)
-> rpath(Q, [N|X], P)
; P = X
).
init_dist(Infinity, N-V) :-
put_attr(V, name, N),
put_attr(V, dist, Infinity).
init_adjs(Ps, d(X, Y, D)) :-
%ord_memberchk(X-Xv, Ps),
%ord_memberchk(Y-Yv, Ps),
memberchk(X-Xv, Ps),
memberchk(Y-Yv, Ps),
adj_add(Xv, Yv, D),
adj_add(Yv, Xv, D).
adj_add(X, Y, D) :-
( get_attr(X, adjs, L)
-> put_attr(X, adjs, [Y-D|L])
; put_attr(X, adjs, [Y-D])
).
main_loop([]).
main_loop([Q|Qs]) :-
smallest_distance(Qs, Q, U, Qn),
put_attr(U, assigned, true),
get_attr(U, adjs, As),
update_neighbours(As, U),
main_loop(Qn).
smallest_distance([A|Qs], C, M, [T|Qn]) :-
get_attr(A, dist, Av),
get_attr(C, dist, Cv),
( Av < Cv
-> (N,T) = (A,C)
; (N,T) = (C,A)
),
!, smallest_distance(Qs, N, M, Qn).
smallest_distance([], U, U, []).
update_neighbours([V-Duv|Vs], U) :-
( get_attr(V, assigned, true)
-> true
; get_attr(U, dist, Du),
get_attr(V, dist, Dv),
Alt is Du + Duv,
( Alt < Dv
-> put_attr(V, dist, Alt),
put_attr(V, previous, U)
; true
)
),
update_neighbours(Vs, U).
update_neighbours([], _).
:- begin_tests(dijkstra_av).
small([d(a,b,2),d(a,b,1),d(b,c,1),d(c,d,1),d(a,d,3),d(a,d,2)]).
test(1) :-
nl,
small(S),
time(dijkstra_av(S, a, L)),
maplist(writeln, L).
test(2) :-
open('salesman.pl', read, F),
readf(F, L),
close(F),
nl,
dijkstra_av(L, penzance, R),
maplist(writeln, R).
readf(F, [d(X,Y,D)|R]) :-
read(F, dist(X,Y,D)), !, readf(F, R).
readf(_, []).
test(3) :-
nl, small(S),
time(dijkstra_edges(S, a, Es)),
maplist(writeln, Es).
:- end_tests(dijkstra_av).
test(3) shows the implementation, I've added some edge with higher values to verify, the output shows that these are correctly discarded:
s(a,0,[])
s(b,1,[e(a,b,1)])
s(c,2,[e(a,b,1),e(b,c,1)])
s(d,2,[e(a,d,2)])
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.