Building an Expression Tree in Prolog - prolog

I'm looking for a way to build an Expression Tree in Prolog. I already did some experiments and came up with the following working code (that will only handle constants and the plus expression):
const(_).
plus(_, _).
eval(const(R), R).
eval(plus(A, B), R) :- number(A), number(B), R is A+B.
eval(plus(A, B), R) :- number(A), eval(B, B_R), R is A+B_R.
eval(plus(A, B), R) :- eval(A, A_R), number(B), R is A_R+B.
eval(plus(A, B), R) :- eval(A, A_R), eval(B, B_R), R is A_R+B_R.
Is there any simpler alternative to this approach? Will I have to define these 4 cases for each one of the operators I plan on adding to my program?

See here another schema, exploiting DCG and (a kind of) lazy evaluation:
/*
File: dcg_calculator.pl
Author: Carlo,,,
Created: Aug 16 2011
Purpose: associativity and precedences in calculator
*/
:- module(dcg_calculator, [dcg_calculator/2, expr//1]).
%- [library(http/dcg_basics)]. obsolete
:- [library(dcg/basics)].
/* usage
?- dcg_calculator("1+(-2-2)",S),V is S.
S = 1+ (-2-2),
V = -3 ;
false.
*/
dcg_calculator(Formula, IsEvaluable) :-
phrase(expr(IsEvaluable), Formula, []).
expr(Evaluable) -->
sum(Evaluable).
sum(S) -->
product(P), sum_1(P, S).
sum_1(L, S) -->
"+", product(P), sum_1(L + P, S);
"-", product(P), sum_1(L - P, S);
{L = S}.
product(P) -->
value(V), product_1(V, P).
product_1(V, P) -->
"*", value(U), product_1(V * U, P);
"/", value(U), product_1(V / U, P);
{V = P}.
% value(V) -->
% {var(V)} -> {V=0 /* between(0, 9, V)*/ }, "0".
value(V) -->
"(", expr(V), ")" ;
number(V).
Using grammars to model data structures it's a very useful technique in Prolog. The grammar used it's an implementation of PEGs. Dependency from SWI-Prolog it's very limited, just number//1.

I think this should do it, though I'm not familiar with the construct pred1(pred2(...)...) :- ... (my Prolog is very rusty).
eval(A, A) :- number(A).
eval(plus(A, B), R) :- eval(A, A_R), eval(B, B_R), R is A_R+B_R.

Related

How do I see a detailed order (execution) for a Prolog query?

Let's say I have this Prolog program:
loves(vincent, mia).
loves(marcellus, mia).
jealous(A, B) :- loves(A, C), loves(B, C).
With query jealous(A,B). I'm very new to Prolog and I'd like to know how is it possible to see the exact order the program will be running and taking its ways for this query? I have tried using trace, jealous(A,B). command but it has only given me that:
Isn't there any more detailed solution for that? :/
Have you seen the Prolog Visualizer?
When you get to the page be sure to click on the icons in the upper right to learn more.
Enjoy.
Screenshot after step 10 of 49.
Screenshot for example given after all steps.
The Prolog Visualizer uses a slightly nonstandard way to enter a query by ending the query with a question mark (?), e.g.
jealous(A,B)?
If you do not post a query in the input area on the left you will receive an error, e.g.
The input for the Prolog Visualizer for your example is
loves(vincent, mia).
loves(marcellus, mia).
jealous(A, B) :- loves(A, C), loves(B, C).
jealous(A,B)?
When the Prolog Visualizer completes your example, notice the four results in green on the right
If you are using SWI-Prolog and after you understand syntactic unification, backtracking and write more advanced code you will find this of use:
Overview of the SWI Prolog Graphical Debugger
For other useful Prolog references see: Useful Prolog references
If the Prolog system has callable_property/2 and sys_rule/3, then one can code
a smart "unify" port as follows, showing most general unifiers (mgu's`):
:- op(1200, fx, ?-).
% solve(+Goal, +Assoc, +Integer, -Assoc)
solve(true, L, _, L) :- !.
solve((A, B), L, P, R) :- !, solve(A, L, P, H), solve(B, H, P, R).
solve(H, L, P, R) :- functor(H, F, A), sys_rule(F/A, J, B),
callable_property(J, sys_variable_names(N)),
number_codes(P, U), atom_codes(V, [0'_|U]), shift(N, V, W),
append(L, W, M), H = J, reverse(M, Z), triage(M, Z, I, K),
offset(P), write_term(I, [variable_names(Z)]), nl,
O is P+1, solve(B, K, O, R).
% triage(+Assoc, +Assoc, -Assoc, -Assoc)
triage([V=T|L], M, R, [V=T|S]) :- var(T), once((member(W=U, M), U==T)), W==V, !,
triage(L, M, R, S).
triage([V=T|L], M, [V=T|R], S) :-
triage(L, M, R, S).
triage([], _, [], []).
% shift(+Assoc, +Atom, -Assoc)
shift([V=T|L], N, [W=T|R]) :-
atom_concat(V, N, W),
shift(L, N, R).
shift([], _, []).
% offset(+Integer)
offset(1) :- !.
offset(N) :- write('\t'), M is N-1, offset(M).
% ?- Goal
(?- G) :-
callable_property(G, sys_variable_names(N)),
shift(N, '_0', M),
solve(G, M, 1, _).
Its not necessary to modify mgu's retrospectively, since a solution to a
Prolog query is the sequential composition of mgu's. Here is an example run:
?- ?- jealous(A,B).
[A_0 = X_1, B_0 = Y_1]
[H_1 = mia, X_1 = vincent]
[Y_1 = vincent]
A = vincent,
B = vincent ;
[Y_1 = marcellus]
A = vincent,
B = marcellus ;
Etc..
This is a preview of Jekejeke Prolog 1.5.0 the new
predicate sys_rule/3, its inspired by the new
predicate rule/2 of SWI-Prolog, but keeps the
clause/2 argument of head and body and uses a predicate
indicator.

How add finitely failed branches to a Prolog visualizer?

Assume we want to visualize this Prolog execution. No goals from the fidschi islands, or something else exotic assumed, only good old SLDNF
with the default selection rule:
p(a).
p(b).
?- \+ p(c).
Yes
But we have only a Prolog visualizer that can show derivations
without negation as failure, like here. How can we boost
the Prolog visualizer to also show negation as failure?
The good thing about negation as failure, writing a meta interpreter for negation as failure is much easier, than writing a meta interpreter for cut (!). So basically the vanilla interpreter for SLDNF can be derived from the vanilla interpreter for SLD by inserting one additional rule:
solve(true) :- !.
solve((A,B)) :- !, solve(A), solve(B).
solve((\+ A)) :- !, \+ solve(A). /* new */
solve(H) :- functor(H, F, A), sys_rule(F/A, H, B), solve(B).
We can now go on and extend solve/3 from here in the same vain. But we do something more, we also write out failure branches in the search tree, similar like Prolog visualizer does by strikethrough of a clause. So the amended solve/3 is as follows:
% solve(+Goal, +Assoc, +Integer, -Assoc)
solve(true, L, _, L) :- !.
solve((A, B), L, P, R) :- !, solve(A, L, P, H), solve(B, H, P, R).
solve((\+ A), L, P, L) :- !, \+ solve(A, L, P, _). /* new */
solve(H, L, P, R) :- functor(H, F, A), sys_rule(F/A, J, B),
callable_property(J, sys_variable_names(N)),
number_codes(P, U), atom_codes(V, [0'_|U]), shift(N, V, W),
append(L, W, M),
(H = J -> true; offset(P), write(fail), nl, fail), /* new */
reverse(M, Z), triage(M, Z, I, K),
offset(P), write_term(I, [variable_names(Z)]), nl,
O is P+1, solve(B, K, O, R).
Here is an example run:
?- ?- \+ p(c).
fail
fail
Yes
See also:
AI Algorithms, Data Structures and Idioms
CH6: Three Meta-Interpreters
Georg F. Luger - Addison-Wesley 2009
https://www.cs.unm.edu/~luger/

word processing prolog

I am trying to break a word into different syllables in Prolog according to 2 different rules ..
rule 1: vowel-consonant-vowel (break word after second vowel)
rule 2: vowel-consonant-consonant-vowel (break word between the 2
consonant) , for example, calculator = cal-cula-tor ..
I already have the following code in Prolog, however, it only analyzes the first 3 or 4 letters of the word ..
I need it to process and analyze the entire word.
vowel(a).
vowel(e).
vowel(i).
vowel(o).
vowel(u).
consonant(L):- not(vowel(L)).
syllable(W, S, RW):-
atom_chars(W, [V1, C, V2|Tail]),
vowel(V1),
consonant(C),
vowel(V2),
!,
atomic_list_concat([V1, C, V2], S),
atomic_list_concat(Tail, RW).
syllable(W, S, RW):-
atom_chars(W, [V1, C, C2, V2|Tail]),
vowel(V1),
consonant(C),
consonant(C2),
vowel(V2),
!,
atomic_list_concat([V1, C, C2, V2], S),
atomic_list_concat(Tail, RW).
syllable(W, W, _).
break(W, B):-
syllable(W, B, ''), !.
break(W, B):-
syllable(W, S, RW),
break(RW, B2),
atomic_list_concat([S, '-', B2], B).
First, a setting that makes it much more convenient to specify lists of characters, and which I recommend you use in your code if you process text a lot:
:- set_prolog_flag(double_quotes, chars).
Second, the data, represented in such a way that the definitions can be used in all directions:
vowel(a). vowel(e). vowel(i). vowel(o). vowel(u).
consonant(C) :- maplist(dif(C), [a,e,i,o,u]).
For example:
?- consonant(C).
dif(C, u),
dif(C, o),
dif(C, i),
dif(C, e),
dif(C, a).
whereas the version you posted incorrectly says that there is no consonant:
?- consonant(C).
false.
The rules you outline are readily described in Prolog:
% rule 1: vowel-consonant-vowel (break after second vowel)
rule([V1,C,V2|Rest], Bs0, Bs, Rest) :-
vowel(V1), consonant(C), vowel(V2),
reverse([V2,C,V1|Bs0], Bs).
% rule 2: vowel-consonant-consonant-vowel (break between the consonants)
rule([V1,C1,C2,V2|Rest], Bs0, Bs, [C2,V2|Rest]) :-
vowel(V1), consonant(C1), consonant(C2), vowel(V2),
reverse([C1,V1|Bs0], Bs).
% alternative: no break at this position
rule([L|Ls], Bs0, Bs, Rest) :-
rule(Ls, [L|Bs0], Bs, Rest).
Exercise: Why am I writing [V2,C,V1|_] instead of [V1,C,V2|...] in the call of reverse/2?
Now, it only remains to describe the list of resulting syllables. This is easy with dcg notation:
word_breaks([]) --> [].
word_breaks([L|Ls]) --> [Bs],
{ rule([L|Ls], [], Bs, Rest) },
word_breaks(Rest).
word_breaks([L|Ls]) --> [[L|Ls]].
Now the point: Since this program is completely pure and does not incorrectly commit prematurely, we can use it to show that there are also other admissible hyphenations:
?- phrase(word_breaks("calculator"), Hs).
Hs = [[c, a, l], [c, u, l, a], [t, o, r]] ;
Hs = [[c, a, l], [c, u, l, a, t, o], [r]] ;
Hs = [[c, a, l], [c, u, l, a, t, o, r]] ;
Hs = [[c, a, l, c, u, l, a], [t, o, r]] ;
Hs = [[c, a, l, c, u, l, a, t, o], [r]] ;
Hs = [[c, a, l, c, u, l, a, t, o, r]].
In Prolog, it is good practice to retain the generality of your code so that you can readily observe alternative solutions. See logical-purity.
I guess its time for a DCG push back solution. The push back is used in the second rule of break//1. It is to reflect that we look at four characters but only consume two characters:
vowel(a). vowel(e). vowel(i). vowel(o). vowel(u).
consonant(C) :- \+ vowel(C).
break([V1,C,V2]) -->
[V1,C,V2],
{vowel(V1), consonant(C), vowel(V2)}.
break([V1,C1]), [C2,V2] -->
[V1,C1,C2,V2],
{vowel(V1), consonant(C1), consonant(C2), vowel(V2)}.
syllables([L|R]) --> break(L), !, syllables(R).
syllables([[C|L]|R]) --> [C], syllables([L|R]).
syllables([[]]) --> [].
So the overall solution doesn't need some extra predicates such as append/3 or reverse/2. We have also placed a cut to prune the search, which can be done because of the character catchall in the second rule of syllables//1.
Here are some example runs:
Jekejeke Prolog 2, Laufzeitbibliothek 1.1.6
(c) 1985-2016, XLOG Technologies GmbH, Schweiz
?- set_prolog_flag(double_quotes, chars).
Ja
?- phrase(syllables(R), "calculator").
R = [[c,a,l],[c,u,l,a],[t,o,r]] ;
Nein
?- phrase(syllables(R), "kitchensink").
R = [[k,i,t,c,h,e,n],[s,i,n,k]] ;
Nein
P.S.: In some older draft standards this DCG technique was
called "right-hand-context", and instead of the verb "push
back", the verb "prefixing" was used. In a newer draft standard
this is called "semicontext", and instead of the verb "push back",
the verb "restoring" is used.
https://www.complang.tuwien.ac.at/ulrich/iso-prolog/dcgs/dcgsdraft-2015-11-10.pdf
I think you could write it more simply.Here is my implementation:
syllable( Input, Final_Word):-
atom_chars( Input, Char_list),
(split(Char_list, Word)-> atom_chars( Final_Word, Word);
Final_Word=Input).
split([],[]).
split([X,Y,Z|T],[X,Y,Z,'-'|T1]):-
vowel(X),vowel(Z),
atom_chars( Input, T),
syllable(Input,T2),
atom_chars( T2, T1).
split([X,Y,Z,W|T],[X,Y,'-',Z|T1]):-
vowel(X),\+vowel(Y),\+vowel(Z),vowel(W),
atom_chars( Input, [W|T]),
syllable(Input,T2),
atom_chars( T2, T1).
split([X|T],[X|T1]):- \+vowel(X),split(T,T1).
split/2 splits the word adding '-' where it could be added following the above rules you stated and returns a list to syllable. atom_chars/2 transforms the list to a word. If the word couldn't be split then the output is the input.
Example:
?- syllable(calculator,L).
L = 'calcu-lato-r'.
I'm don't understand why you wrote 'calculator = cal-cula-tor ' since it doesn't follows the rules stated, since "cal" is not vowel-constant-vowel but constant-vowel-constant and same for the rest of thr word...

Brute-force Prolog SAT solver for boolean formulas

I'm trying to write an algorithm that naively looks for models of a boolean formula (NNF, but not CNF).
The code I have can check an existing model, but it'll fail (or not finish) when asked to find models, seemingly because it generates infinitely many solutions for member(X, Y) along the lines of [X|_], [_,X|_], [_,_,X|_]...
What I have so far is this:
:- op(100, fy, ~).
:- op(200, xfx, /\).
:- op(200, xfx, \/).
:- op(300, xfx, =>).
:- op(300, xfx, <=>).
formula(X) :- atom(X).
formula(~X) :- formula(X).
formula(X /\ Y) :- formula(X), formula(Y).
formula(X \/ Y) :- formula(X), formula(Y).
formula(X => Y) :- formula(X), formula(Y).
formula(X <=> Y) :- formula(X), formula(Y).
model(1, _).
model(X, F) :- atom(X), member([X, 1], F).
model(~X, F) :- atom(X), member([X, 0], F). % NNF
model(A /\ B, F) :- model(A, F), model(B, F).
model(A \/ B, F) :- (model(A, F); model(B, F)).
model(A => B, F) :- model(~A \/ B, F).
model(A <=> B, F) :- model((A => B) /\ (B => A), F).
sat(A) :- model(A, F), \+ (member([X, 1], F), member([X, 0], F)).
%%% examples:
% formula(~(~ (a /\ b) \/ (c => d))).
% model(a, [[a,1]]).
Is there a better data structure for F, or some other way the partially-instantiated lists can be cut off?
Edit: Added definitions and examples.
Use clpb!
:- use_module(library(clpb)).
Sample query using sat/1:
?- sat(~(~ (A * B) + (C * D))).
A = B, B = 1, sat(1#C*D).
Some variables (A and B) already have been bound to exactly one Boolean value (in above query), but search is not yet complete (which is indicated by residual goals).
To trigger the smart brute-force enumeration of all solutions use labeling/1 like so:
?- sat(~(~ (A * B) + (C * D))), labeling([A,B,C,D]).
A = B, B = 1, C = D, D = 0
; A = B, B = D, D = 1, C = 0
; A = B, B = C, C = 1, D = 0.
I solved it by writing a generate_model predicate that created a pre-defined list with exactly one element for each variable:
generate_model([], []).
generate_model([X|T], [[X,_]|T2]) :- generate_model(T, T2).
sat(A) :-
var_list(A, Vars),
generate_model(Vars, F),
model(A, F).
Do I understand you, that you are happy with a single model. You
don't need labeling or sat_count. Here is an alternative model finder, that is similar to yours, but will only return consistent models.
Since it finds counter models, you need to supply the negation of the formula to find a model. The predicate maze/3 was developed as a negative implementation of the positive predicate proof/2:
% Find a counter model.
% maze(+Norm,+List,-List)
maze(or(A,_),L,_) :- member(A,L), !, fail.
maze(or(A,B),L,R) :- !, inv(A,C), maze(B,[C|L],R).
maze(and(A,_),L,R) :- maze(A,L,R), !.
maze(and(_,B),L,R) :- !, maze(B,L,R).
maze(A,L,_) :- member(A,L), !, fail.
maze(A,L,M) :- oneof(L,B,R), connective(B), !,
inv(A,C), inv(B,D), maze(D,[C|R],M).
maze(A,L,[B|L]) :- inv(A,B).
It can find counter models to all of the following fallacies:
Affirming a Disjunct: (p v q) & p => ~q.
Affirming the Consequent: (p => q) & q => p.
Commutation of Conditionals: (p => q) => (q => p).
Denying a Conjunct: ~(p & q) & ~p => q.
Denying the Antecedent: (p => q) & ~p => ~q.
Improper Transposition: (p => q) => (~p => ~q).
Here is an example run:
Jekejeke Prolog 2, Runtime Library 1.2.5
(c) 1985-2017, XLOG Technologies GmbH, Switzerland
?- negcase(_,N,F), norm(F,G), maze(G,[],L),
write(N), write(': '), sort(L,R), write(R), nl, fail; true.
Affirming a Disjunct: [pos(p),pos(q)]
Affirming the Consequent: [neg(p),pos(q)]
Commutation of Conditionals: [neg(p),pos(q)]
Denying a Conjunct: [neg(p),neg(q)]
Denying the Antecedent: [neg(p),pos(q)]
Improper Transposition: [neg(p),pos(q)]
Interestingly the thing is much faster than CLP(B). Here are some timings running the same problem in CLP(B) and with maze:
?- time((between(1,1000,_), negcaseclp(_,N,F,L),
sat(~F), once(labeling(L)), fail; true)).
% Up 296 ms, GC 3 ms, Thread Cpu 250 ms (Current 01/27/18 00:34:20)
Yes
?- time((between(1,1000,_), negcase(_,_,F),
norm(F,G), maze(G,[],_), fail; true)).
% Up 82 ms, GC 0 ms, Thread Cpu 78 ms (Current 01/27/18 00:30:21)
Yes

Prolog. How to check if two math expressions are the same

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.

Resources