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
Related
I have the following code :
neighbor(C1, C2, [C1, C2|L]).
neighbor(C1, C2, [C2, C1|L]).
neighbor(C1, C2, [H|L]) :- neighbor(C1, C2, L).
not_neighbors(C5, C2, E, R) :-
not_neighbor(C5, C2, E).
not_neighbors(C5, C2, E, R) :-
not_neighbor(C5, C2, R).
/* THIS DON'T WORK */
not_neighbor(C5, C2, E) :-
\+ neighbor(C5, C2, E).
Or :
same_position(I, J, [I|U], [J|V]).
same_position(I, J, [M|U], [N|V]) :-
I \== M, % optimisation
J \== N, % optimisation
same_position(I, J, U, V).
/* THIS DON'T WORK */
not_under(C4, C1, R, E) :-
\+ same_position(C4, C1, R, E).
I know the problem is the negation and I want to get the opposite result of same_position for example.
M. #CapelliC suggested me to use dif/2 but I don't know how to apply this on my specific example.
Let us first think logically about what it means to be "neighbours" in a list: In what cases are A and B neighbouring elements in a list?
Answer: If the list is of the form [...,X,Y,...] and at least one of the following holds:
A = X and B = Y
A = Y and B = X.
In logical terms: ( A = X ∧ B = Y) ∨ (A = Y ∧ B = X).
We want to state the opposite of this, which is the negated formula:
¬ ( ( A = X ∧ B = Y) ∨ (A = Y ∧ B = X) ) ≡
≡ ¬ ( A = X ∧ B = Y) ∧ ¬ (A = Y ∧ B = X) ≡
≡ (¬ A = X ∨ ¬ B = Y) ∧ (¬ A = Y ∨ ¬ B = X) ≡
≡ (A ≠ X ∨ B ≠ Y) ∧ (A ≠ Y ∨ B ≠ X)
Who would have thought that De Morgan's laws had any practical application, right?
To state X ≠ Y in Prolog, we use the powerful dif/2 constraint, exactly as #CapelliC has already suggested. dif/2 is true iff its arguments are different terms. It is a pure predicate and works correctly in all directions. If your Prolog system does not yet provide it, make sure to let your vendor know that you need it! Until then, you can approximate it with iso_dif/2, if necessary.
In Prolog, the above thus becomes:
( dif(A, X) ; dif(B, Y) ), ( dif(A, Y) ; dif(B, X) )
because (',')/2 denotes conjunction, and (;)/2 denotes disjunction.
So we have:
not_neighbours(_, _, []).
not_neighbours(_, _, [_]).
not_neighbours(A, B, [X,Y|Rest]) :-
( dif(A, X) ; dif(B, Y) ),
( dif(A, Y) ; dif(B, X) ),
not_neighbours(A, B, [Y|Rest]).
A few test cases make us more confident about the predicate's correctness:
?- not_neighbours(a, b, [a,b]).
false.
?- not_neighbours(A, B, [A,B]).
false.
?- not_neighbours(A, B, [_,A,B|_]).
false.
?- not_neighbours(A, B, [_,B,A|_]).
false.
?- not_neighbours(a, b, [_,a,c,_]).
true .
Note that this definition works correctly also if all arguments are variables, which we call the most general case.
A drawback of this solution is that (;)/2 creates many alternatives, and many of them do not matter at all. We can make this significantly more efficient by another algebraic equivalence that lets us get rid of unneeded alternatives:
¬ A ∨ B ≡ A → B
So, in our case, we can write (¬ A = X ∨ ¬ B = Y) as A = X →B≠Y.
We can express implication in Prolog with the powerful if_/3 meta-predicate:
impl(A, B) :- if_(A, B, true).
And so we can declaratively equivalently write our solution as:
not_neighbours(_, _, []).
not_neighbours(_, _, [_]).
not_neighbours(A, B, [X,Y|Rest]) :-
impl(A=X, dif(B, Y)),
impl(B=X, dif(A, Y)),
not_neighbours(A, B, [Y|Rest]).
Sample query:
?- not_neighbours(a, b, [x,y]).
true ;
false.
And a more general case:
?- not_neighbours(a, b, [X,Y]).
X = a,
dif(Y, b) ;
X = b,
dif(Y, a) ;
dif(X, b),
dif(X, a) ;
false.
You can use this predicate for checking and generating answers. Try for example iterative deepening to fairly enumerate all answers:
?- length(Ls, _), not_neighbours(A, B, Ls).
Remarkably, pure logical reasoning has thus led us to a general and efficient Prolog program.
dif/2 may at first appear unusual to you, because it appeared in the very first Prolog system and was then for a time ignored by some vendors. Nowadays, dif/2 is becoming available (again) in an increasing number of implementations as an important built-in predicate that allows you to declaratively state that two terms are different. The massive confusion that its impure alternatives usually cause in Prolog courses can be avoided with dif/2.
If you want to generate the not-neighbors, \+ won't do as it is by definition semidet and never binds a variable. You need something that
constructs answers. One option is to generate all pairs and then use your \+ neighbor(...) to filter the non-neighbors. A direct constructive approach isn't that hard either, although the need to have both orderings complicate the code a little:
not_neighbor(C1, C2, List) :-
append(_, [C10,_|Postfix], List),
member(C20, Postfix),
swap(C1,C2, C10,C20).
swap(X,Y, X,Y).
swap(X,Y, Y,X).
See http://swish.swi-prolog.org/p/njssKnba.pl
Given a CNF logic formula
[[a, b, c], [b, d], [not(d), a]] that is equal to ((a or b or c) and (b or d) and (not d or a)), how do I calculate its models (possible values for its atoms that makes the formula true), using prolog? This is what i've got so far:
A valuation to the formula is a list of terms in the form os val(X,B), where X is an atom, and B is its value (0 or 1).
The relation value(X, Vs, B) is given by
value(X, [val(X, B)|_], B) :− !.
value(X, [_|Ps], B) :− value(X, Ps, B).
and its true whenever B is the value for the atom X in the valuation Vs.
The relation sp(F, Ss), given by
sp([],[]).
sp([F|Fs], Ss) :- setof(A, member(A,F), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss).
and its true whenever Ss is the list of atoms in logic formula F.
The relation valuation(As, Vs), given by
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
that is true whenever Vs is a possible valuation for the list of atoms As.
What I need:
The relation ext(F, Vs, B) that is true whenever F is a formula, Vs is a possible valuation for that formula, and B is the value of the formula applying Vs valuation. For example, the consult
ext([[a], [not(b), c]] , [val(a, 1), val(b, 0), val(c , 1)], B).
should return the value B = 1.
The relation model(F,Vs) that is true whenever the valuation Vs is a model for the formula F.
The relation models(F, Ms) that is true whenever Ms is a list which elements are models for the formula F. I guess we need to use prolog’s setof here.
And, at last, I don't know whats the best implementation of val(X,B) to make it work. I dont know if I should specify val(_,1) and val(_,0) to be true or only val(_,1), what is better knowing the other relations to be implemented?
Not sure to understand exactly what you want but...
First of all, let me try to simplify your code.
1) I think your value/2 should be written as
value(X, [val(X, B) | _], B).
value(X, [_ | Ps], B) :-
value(X, Ps, B).
2) I don't understand the purpose of your sp/2 but seems to me that can be simplified as
sp([], []).
sp([[A] | Fs], [A | Ss]) :-
sp(Fs, Ss).
sp([[A | As] | Fs], [A | Ss]) :-
append(As, Fs, N),
sp(N, Ss).
3) I don't understand the purpose of your valutation/2 but seems to me that can be simplified as
isBool(0).
isBool(1).
valuation([], []).
valuation([A | As], [val(A, B) | Vs]) :-
isBool(B),
valuation(As,Vs).
Now I try to respond to your question
4)
I need [...] The relation ext(F, Vs, B) that is true whenever F
is a formula, Vs is a possible valuation for that formula, and B
is the value of the formula applying Vs valuation
I suppose the following should work [caution: not tested really much]
ext([], _, 1).
ext([[] |_], _, 0).
ext([[X | L1] | L2], Vs, B) :-
value(X, Vs, 0),
ext([L1 | L2], Vs, B).
ext([[not(X) | L1] | L2], Vs, B) :-
value(X, Vs, 1),
ext([L1 | L2], Vs, B).
ext([[X | _] | L], Vs, B) :-
value(X, Vs, 1),
ext(L, Vs, B).
ext([[not(X) | _] | L], Vs, B) :-
value(X, Vs, 0),
ext(L, Vs, B).
5)
I need [...] The relation model(F,Vs) that is true whenever the
valuation Vs is a model for the formula F
What about the following ?
model(F, Vs) :-
ext(F, Vs, _). % or ext(F, Vs, 1)?
6)
I need [...] The relation models(F, Ms) that is true whenever Ms is a
list which elements are models for the formula F
If I understand correctly what do you want, given model/2, models/2 could be written as
models(_, []).
models(F, [Vs | Vl]) :-
model(F, Vs),
models(F, Vl).
7)
I don't know whats the best implementation of val(X,B) to make it
work. I dont know if I should specify val(,1) and val(,0) to be true
or only val(_,1)
Not sure to understand your question.
val/2 can't be true for every value; so you can't impose true val(_,1) and/or val(_,0) because given an atom (a, by example) is true val(a,1) or val(a,0) but ins't true val(X,1) for every X.
Another approach here. Translate to executable Prolog, and reify a specific execution (i.e. a proof with specific symbol bindings):
ext(F, Vs, B) :-
or_list(F, [], C, Vs), !,
assign(Vs), ( call(C), B = true ; B = false ).
assign(Dict) :- maplist(domain, Dict).
domain(val(_, true)).
domain(val(_, false)).
or_list([A], D, T, Du) :-
!, and_list(A, D, T, Du).
or_list([A|As], D, ( T ; Ts ), Du) :-
and_list(A, D, T, Dut),
or_list(As, Dut, Ts, Du).
and_list([V], D, T, Du) :-
!, negation(V, D, T, Du).
and_list([V|Vs], D, ( T , Ts ), Du) :-
negation(V, D, T, Dut),
and_list(Vs, Dut, Ts, Du).
negation(not(V), D, \+T, Du) :-
!, sym_bind(V, D, T, Du).
negation(V, D, T, Du) :-
sym_bind(V, D, T, Du).
sym_bind(V, D, T, D) :-
memberchk(val(V, T), D), !.
sym_bind(V, D, T, [val(V, T)|D]).
note:
false/true instead of 0/1
list to structure translation: could be way shorter, using foldl or DCGs or passing down the operators (that is (;)/2 (,)/2 (+)/1), but this way the Prolog patterns should be clearer...
I could finally finish it while waiting for replies, and improved it using max66's answer.
I made it to accept propositional logic forms too, so models/2 accepts both styles (CNF and Propositional form, based on operators and, not, or, imp, iff that I set).
:- op(400, fy , not).
:- op(500, xfy, and).
:- op(600, xfy, or ).
:- op(700, xfy, imp).
:- op(800, xfy, iff ).
distr(_, [], []).
distr([], _, []).
distr([C|Cs], Ds, Es) :- distr_un(C, Ds, Ss), distr(Cs, Ds, Ts), append(Ss, Ts, Es).
distr_un(_, [], []).
distr_un(C, [D|Ds], [E|Es]) :- append(C, D, E), distr_un(C, Ds, Es).
cnf(F, [[F]]) :- atom(F), !.
cnf(not(F), [[not(F )]]) :- atom(F), !.
cnf(not not F, Rs) :- cnf(F, Rs).
cnf(not (F imp G), Rs) :- cnf(F and not G, Rs).
cnf(not (F iff G), Rs) :- cnf((F and not G) or (not F and G), Rs).
cnf(not(F and G), Rs) :- cnf((not F) or (not G), Rs).
cnf(not(F or G), Rs) :- cnf((not F) and (not G), Rs).
cnf(F and G, Rs) :- cnf(F, Cs), cnf(G, Ds), append(Cs, Ds, Rs).
cnf(F or G, Rs) :- cnf(F, Cs), cnf(G, Ds), distr(Cs, Ds, Rs).
cnf(F imp G, Rs) :- cnf((not F) or G, Rs).
cnf(F iff G, Rs) :- cnf((not F or G) and (not G or F), Rs).
val(X,0) :- atom(X).
val(X,1) :- atom(X).
value(X, [val(X, B)|_], B) :- !.
value(X, [_|Ps], B) :- value(X, Ps, B), !.
value(not X, [val(X, B)|_], V) :- V is 1-B, !.
value(not X, [_|Ps], B) :- value(not X, Ps, B), !.
sp([],[]).
sp([F|Fs], Ss) :- setof(A1, member(not A1, F), R1), setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M1), append(M1, R1, M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
sp([F|Fs], Ss) :- setof(A, (member(not A,F), atom(A)), R), sp(Fs, N), append(R,N,M), setof(B,member(B,M),Ss), !.
valuation([],[]).
valuation([A|As], [V|Vs]) :- (V = val(A,0); V = val(A,1)), valuation(As,Vs).
ext([F|Fs], Vs, B) :- sp([F|Fs], Ss), valuation(Ss, Vs), ext_([F|Fs], Vs, B).
ext_([], _, 1).
ext_([F|Fs], Vs, 1) :- cl(F, Vs, 1), ext_(Fs, Vs, 1).
ext_([F|Fs], Vs, 0) :- cl(F, Vs, 0); ext_(Fs, Vs, 0).
cl([A|As], Vs, 1) :- value(A,Vs,1); cl(As, Vs, 1).
cl([A|As], Vs, 0) :- value(A,Vs,0), cl(As,Vs,0).
cl([], _, 0).
model(F, Vs) :- ext(F, Vs, 1).
models(F, Vs) :- cnf(F, Fs), setof(V, model(Fs, V), Vs).
models(F, Vs) :- setof(V, model(F, V), Vs).
I tested it and it seems to be working as intended.
Just a little question because I do not understand something on a program I have at one of my finals :
p(A, [A | _]).
p(B, [_, _ | C]) :- p(B, C).
q(D, [_, D | _]).
q(E, [_, _ | F]) :- q(E, F).
r(G, H) :- p(G, H).
r(I, J) :- q(I, J).
The question is to make the Tree of research of that with the purpose : r(X, [a,b,c]).
So actually, two possibilities :
r(G, H) :- p(G, H). (With G = X, and H = [a,b,c]).
r(I, J) :- q(I, J). (With I = X, and J = [a, b, c]).
If we take the 1st one, we have : p(X, [a,b,c]).
So we can use the 1st rule : p(A, [A | _]). (With A = X).
But I don't understand why when I launch the SWI-Prolog, a goes into X ...
Thanks !
Satisfying r(X, [a,b,c]) with the first rule goes into satisfying p(X, [a,b,c]).
Your first rule for p/2, p(A,[A|_]), states that a goal p(X,L) is satisfied when L is a list and its first element unifies with X.
In your case that list is [a,b,c] and X is unified with a.
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 have the following relation: index(X,N,List).
for example:
index(X,2,[a,b,c]).
X=b
index(b,N,[a,b,c]).
N=2
I don't know how to make my relation to work with the second example. It says that N is not defined well
Here is my code (it works well for the first example).
index(X,1,[X|_]).
index(X,N,[_|Tail]) :- N > 1, N1 is N - 1 , index(X,N1,Tail).
There is a SWI-Prolog built-in nth1/3 that does what you want:
?- nth1(N, [a, b, c], b).
N = 2 ;
false.
Look at its source code:
?- listing(nth1).
lists:nth1(A, C, D) :-
integer(A), !,
B is A+ -1,
nth0_det(B, C, D).
lists:nth1(A, B, C) :-
var(A), !,
nth_gen(B, C, 1, A).
true.
?- listing(nth0_det).
lists:nth0_det(0, [A|_], A) :- !.
lists:nth0_det(1, [_, A|_], A) :- !.
lists:nth0_det(2, [_, _, A|_], A) :- !.
lists:nth0_det(3, [_, _, _, A|_], A) :- !.
lists:nth0_det(4, [_, _, _, _, A|_], A) :- !.
lists:nth0_det(5, [_, _, _, _, _, A|_], A) :- !.
lists:nth0_det(A, [_, _, _, _, _, _|C], D) :-
B is A+ -6,
B>=0,
nth0_det(B, C, D).
true.
?- listing(nth_gen).
lists:nth_gen([A|_], A, B, B).
lists:nth_gen([_|B], C, A, E) :-
succ(A, D),
nth_gen(B, C, D, E).
true.
The variable N has not been instantiated to a numeric type when Prolog attempts to evaluate the goals N > 1 and N1 is N - 1 in the recursive clause defining index/3. This causes the instantiation error you are reporting.
I don't know how to solve your problem directly, but I have two suggestions. The first is to use an accumulator, so that the arithmetic operations in the recursive clause can be evaluated:
get(M,Xs,X) :- get(1,M,Xs,X).
get(N,N,[X|_],X).
get(N,M,[_|Xs],X) :-
L is N + 1,
get(L,M,Xs,X).
For instance:
?- index(N,[a,b],X).
N = 1,
X = a ;
N = 2,
X = b ;
false.
The other is to use a natural number type, so that the index can be constructed via unification:
nat(0).
nat(s(N)) :- nat(N).
get(s(0),[X|_],X).
get(s(N),[_|Y],X) :- get(N,Y,X).
For instance,
?- get(N,[a,b],X).
N = s(0),
X = a ;
N = s(s(0)),
X = b ;
false.
Hopefully this was helpful. Perhaps someone more knowledgeable will come along and give a better solution.