Extracting symbols from a given formula - prolog

I'm trying to extract symbols from formula. Ex:
?- formula((p v q) & (q v r), U).
U = [p, q, v].
What I've done so far:
simbol_formula([],[]).
simbol_formula(negation X, [X]).
simbol_formula(X or Y, [X,Y]).
simbol_formula(X and Y, [X,Y]).
I believe what I did is correct but incomplete. I am stuck. It obviously works for simple formulas but for more complex formulas it does not. I know I have to define something as simbol_formula(F,U) :-. Using recursion somehow or break the given formula into "smaller" ones.

The core problem in your case is the use of defaulty data structures.
In your representation, you cannot, by pattern matching alone, distinguish between:
a symbol
other formulas.
To overcome this shortcoming, I suggest to uniquely mark symbols with the (arbitrary) functor s/1.
For example, the formula (p v q) & (q v r) would be represented as:
(s(p) ∨ s(q)) & (s(q) ∨ s(r))
Then, we can use a DCG to relate formulas to symbols:
symbols(s(X)) --> [X].
symbols(negation(F)) --> symbols(F).
symbols(X ∨ Y) --> symbols(X), symbols(Y).
symbols(X & Y) --> symbols(X), symbols(Y).
Sample query:
?- phrase(symbols((s(p) ∨ s(q)) & (s(q) ∨ s(r))), Ls).
Ls = [p, q, q, r].
I leave defining the suitable operators as an exercise, so that the above compiles.
The above can also be used to enumerate formulas, albeit unfairly:
?- phrase(symbols(Formula), Ls).
Formula = s(_G1010),
Ls = [_G1010] ;
Formula = negation(s(_G1012)),
Ls = [_G1012] ;
Formula = negation(negation(s(_G1014))),
Ls = [_G1014] .

Related

Tool to solve propositional logic / boolean expressions (SAT Solver?)

I am new to the topic of propositional logic and boolean expressions. So this is why I need help. Here is my problem:
In the car industry you have thousand of different variants of components available to choose from when you buy a car. Not every component is combinable, so for each car there exist a lot of rules that are expressed in propositional logic. In my case each car has between 2000 and 4000 rules.
They look like this:
A → B ∨ C ∨ D
C → ¬F
F ∧ G → D
...
where "∧" = "and" / "∨" = "or" / "¬" = "not" / "→" = "implication".
The variables A, B, C, ... are linked to the components in the bill of material. The data I have consists of pairs of components with their linked variables.
Example:
Component_1, Component_2: (A) ∧ (B)
Component_1, Component_3: (A) ∧ (C ∨ F)
Component_3, Component_5: (B ∨ G)
...
Now, my question is how to solve this problem. Specifically, I would like to know if each combination of the components is possible according to rules above.
Which tool, software and algorithm can solve these type of problems?
Is there a illustrative example?
How can I automate it, so I can check each combination in my list?
Generally, what should I search for in Google to deepen my knowledge in this topic?
Thank you very much for your help!
Olaf
You might want to try a Prolog system with a SAT Solver, such as SWI-Prolog, Jekejeke Minlog, etc... you can readily play with it in the REPL of the Prolog system. To load the SAT solver just type (you don't need to type the ?- itself):
/* in SWI-Prolog */
?- use_module(library(clpb)).
/* in Jekejeke Minlog */
?- use_module(library(finite/clpb)).
You can then use the top-level to search for solutions of a boolean formula, like this example here an xor:
?- sat(X#Y), labeling([X,Y]).
X = 0,
Y = 1 ;
X = 1,
Y = 0.
Here is an example of a kitchen planner code. The kitchen has 3 places,
and we assign a freezer and a stove. The freezer is not allowed to be near to the stove.
The freezer has code 0,1 and the stove has code 1,0. We make use of the card constraint to place the freezer and the stove.
:- use_module(library(finite/clpb)).
freezer([X,Y|L],[(~X)*Y|R]) :-
freezer(L, R).
freezer([], []).
stove([X,Y|L],[X*(~Y)|R]) :-
stove(L, R).
stove([], []).
free([X,Y|L],[(~X)*(~Y)|R]) :-
free(L, R).
free([], []).
allowed([X,Y,Z,T|L]) :-
sat(~((~X)*Y*Z*(~T))),
sat(~(X*(~Y)*(~Z)*T)),
allowed([Z,T|L]).
allowed([_,_]).
allowed([]).
kitchen(L) :-
freezer(L, F), card(1, F),
stove(L, G), card(1, G),
free(L, H), card(1, H),
allowed(L).
What I want to demonstrate with the Prolog code is the benefit, that problem encoding towards a SAT formulation can be done via Prolog code itself. When the above code is run I get the following result as expected:
?- L=[_,_,_,_,_,_], kitchen(L), labeling(L).
L = [0,1,0,0,1,0] ;
L = [1,0,0,0,0,1] ;
No

Prolog - simplify derivative

so I just got started with Prolog this semester, and got the homework to implement a pretty basic d(function, variable, derivative) which I did like this:
d(X,X,1) :- !.
d(C,X,0) :- atomic(C). %, (C \= X).
d(X**E,X,E*X**(E-1)).
d(U+V,X,A+B) :- d(U,X,A), d(V,X,B).
d(U-V,X,A-B) :- d(U,X,A), d(V,X,B).
d(U*V,X,DU*V+U*DV) :- d(U,X,DU), d(V,X,DV).
d(U/V,X,(DU*V-U*DV)/(V*V)) :- d(U,X,DU), d(V,X,DV).
I know this is not complete, but it covers all the tasks required in the exercise.
However,
?- d((x*x+2*x+3)/(3*x),x,R).
leads to
R = ((1*x+x*1+ (0*x+2*1)+0)* (3*x)- (x*x+2*x+3)* (0*x+3*1))/ (3*x* (3*x)).
which doesn't look pretty at all. is/2 unfortunately doesn't like my x as it is not a number...
Is there a simple solution to achieve a cleaner result?
I would rather see this as two separate problems:
First, get derivation right (you're probably getting close, depending on your concrete requirements).
Then, work on simplifying expressions on an algebraic level. Exploit algebraic identities, see if applying the laws of commutativity / associativity / distributivity on some subexpressions enable their rewriting into something equivalent (but simpler / more compact).
As a starting point, you may want to look at the somewhat related question "Replacing parts of expression in prolog".
Here's a simplistic sketch how you could do the simplification—using iwhen/2 to safeguard against insufficient instantiation:
expr_simplified(A, B) :-
iwhen(ground(A), xpr_simplr(A,B)).
xpr_simplr(A, B) :-
( atomic(A)
-> A = B
; ( A = X+0 ; A = 0+X ; A = 1*X ; A = X*1 )
-> xpr_simplr(X, B)
; ( A = 0*_ ; A = _*0 )
-> B = 0
; A = X+X
-> B = X*2
; A = X*X
-> B = X**2
; A = X**1
-> B = X
; A =.. [F|Xs0], % defaulty catch-all
maplist(xpr_simplr, Xs0, Xs),
B =.. [F|Xs]
).
Let's see what it does with the expression you gave. We apply expr_simplified/2 until we reach a fixed point:
?- A = ((1*x+x*1+(0*x+2*1)+0)*(3*x)-(x*x+2*x+3)*(0*x+3*1))/(3*x*(3*x)),
expr_simplified(A,B),
expr_simplified(B,C),
expr_simplified(C,D).
A = ((1*x+x*1+(0*x+2*1)+0)*(3*x)-(x*x+2*x+3)*(0*x+3*1))/(3*x*(3*x)),
B = ((x+x+(0+2))*(3*x)-(x**2+2*x+3)*(0+3))/(3*x)**2,
C = ((x*2+2)*(3*x)-(x**2+2*x+3)*3)/(3*x)**2,
D = C. % fixed point reached
As imperfect as the simplifier is, the expression got a lot more readable.
a possibility to get a number is to replace each instance of variable x with a value, visiting the derived tree. You should do writing a clause to match each binary operator, or use a generic visit, like
set_vars(E, Vs, Ev) :-
E =.. [F,L,R],
set_vars(L, Vs, Lv),
set_vars(R, Vs, Rv),
Ev =.. [F,Lv,Rv].
set_vars(V, Vs, N) :- memberchk(V=N, Vs).
set_vars(V, _, V).
that yields
?- d((x*x+2*x+3)/(3*x),x,R), set_vars(R,[x=5],E), T is E.
R = ((1*x+x*1+ (0*x+2*1)+0)* (3*x)- (x*x+2*x+3)* (0*x+3*1))/ (3*x* (3*x)),
E = ((1*5+5*1+ (0*5+2*1)+0)* (3*5)- (5*5+2*5+3)* (0*5+3*1))/ (3*5* (3*5)),
T = 0.29333333333333333
but, there is a bug in your first clause, that once corrected, will allow to evaluate directly the derived expression:
d(X,V,1) :- X == V, !.
...
now, we can throw away the utility set_vars/3, so
?- d((T*T+2*T+3)/(3*T),T,R), T=8, V is R.
T = 8,
R = ((1*8+8*1+ (0*8+2*1)+0)* (3*8)- (8*8+2*8+3)* (0*8+3*1))/ (3*8* (3*8)),
V = 0.3177083333333333.

Better termination for s(X)-sum

(Let me sneak that in within the wave of midterm questions.)
A common definition for the sum of two natural numbers is nat_nat_sum/3:
nat_nat_sum(0, N, N).
nat_nat_sum(s(M), N, s(O)) :-
nat_nat_sum(M, N, O).
Strictly speaking, this definition is too general, for we have now also success for
?- nat_nat_sum(A, B, unnatural_number).
Similarly, we get the following answer substitution:
?- nat_nat_sum(0, A, B).
A = B.
We interpret this answer substitution as including all natural numbers and do not care about other terms.
Given that, now lets consider its termination property. In fact, it suffices to consider the following failure slice. That is, not only will nat_nat_sum/3 not terminate, if this slice does not terminate. This time they are completely the same! So we can say iff.
nat_nat_sum(0, N, N) :- false.
nat_nat_sum(s(M), N, s(O)) :-
nat_nat_sum(M, N, O), false.
This failure slice now exposes the symmetry between the first and third argument: They both influence non-termination in exactly the same manner! So while they describe entirely different things — one a summand, the other a sum — they have exactly the same influence on termination. And the poor second argument has no influence whatsoever.
Just to be sure, not only is the failure slice identical in its common termination condition
(use cTI) which reads
nat_nat_sum(A,B,C)terminates_if b(A);b(C).
It also terminates exactly the same for those cases that are not covered by this condition, like
?- nat_nat_sum(f(X),Y,Z).
Now my question:
Is there an alternate definition of nat_nat_sum/3 which possesses the termination condition:
nat_nat_sum2(A,B,C) terminates_if b(A);b(B);b(C).
(If yes, show it. If no, justify why)
In other words, the new definition nat_nat_sum2/3 should terminate if already one of its arguments is finite and ground.
Fine print. Consider only pure, monotonic, Prolog programs. That is, no built-ins apart from (=)/2 and dif/2
(I will award a 200 bounty on this)
nat_nat_sum(0, B, B).
nat_nat_sum(s(A), B, s(C)) :-
nat_nat_sum(B, A, C).
?
Ok, seems its over. The solution I was thinking of was:
nat_nat_sum2(0, N,N).
nat_nat_sum2(s(N), 0, s(N)).
nat_nat_sum2(s(N), s(M), s(s(O))) :-
nat_nat_sum2(N, M, O).
But as I realize, that's just the same as #mat's one which is almost the same as #WillNess'es.
Is this really the better nat_nat_sum/3? The original's runtime is independent of B (if we ignore one (1) occurs check for the moment).
There is another downside of my solution compared to #mat's solution which naturally extends to nat_nat_nat_sum/3
nat_nat_nat_sum(0, B, C, D) :-
nat_nat_sum(B, C, D).
nat_nat_nat_sum(s(A), B, C, s(D)) :-
nat_nat_nat_sum2(B, C, A, D).
Which gives
nat_nat_nat_sum(A,B,C,D)terminates_if b(A),b(B);b(A),b(C);b(B),b(C);b(D).
(provable in the unfolded version
with cTI)
The obvious trick is to flip the arguments:
sum(0,N,N).
sum(N,0,N).
sum(s(A),B,s(C)):- sum(B,A,C) ; sum(A,B,C).
Take the following two definitions:
Definition 1:
add(n,X,X).
add(s(X),Y,s(Z)) :- add(X,Y,Z).
Definition 2:
add(n,X,X).
add(s(X),Y,Z) :- add(X,s(Y),Z).
Definition 1 terminates for pattern add(-,-,+), whereas definition 2
does not terminate for pattern add(-,-,+). Look see:
Definition 1:
?- add(X,Y,s(s(s(n)))).
X = n,
Y = s(s(s(n))) ;
X = s(n),
Y = s(s(n)) ;
X = s(s(n)),
Y = s(n) ;
X = s(s(s(n))),
Y = n
?-
Definition 2:
?- add(X,Y,s(s(s(n)))).
X = n,
Y = s(s(s(n))) ;
X = s(n),
Y = s(s(n)) ;
X = s(s(n)),
Y = s(n) ;
X = s(s(s(n))),
Y = n ;
Error: Execution aborted since memory threshold exceeded.
add/3
add/3
?-
So I guess definition 1 is better than definition 2.
Bye

How to add polynoms in Prolog?

I have the following task:
Write a method that will add two polynoms. I.e 0+2*x^3 and 0+1*x^3+2*x^4 will give 0+3*x^3+2*x^4.
I also wrote the following code:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
(
B1=B2,
B3 = B2,
A3 is A1+A2,
add_poly(P1,P2,P3)
;
B1<B2,
B3=B1,
A3=A1,
add_poly(P1,+A2*x^B2+P2,P3)
;
B1>B2,
B3=B2,
A3=A2,
add_poly(+A1*x^B1+P1,P2,P3)
).
add_poly(X+P1,Y+P2,Z+P3):-
Z is X+Y,
add_poly(P1,P2,P3).
My problem is that I don't know how to stop. I would like to stop when one the arguments is null and than to append the second argument to the third one. But how can I check that they are null?
Thanks.
Several remarks:
Try to avoid disjunctions (;)/2 in the beginning. They need special indentation to be readable. And they make reading a single rule more complex — think of all the extra (=)/2 goals you have to write and keep track of.
Then, I am not sure what you can assume about your polynomials. Can you assume they are written in canonical form?
And for your program: Consider the head of your first rule:
add_poly(+A1*x^B1+P1,+A2*x^B2+P2,+A3*x^B3+P3):-
I will generalize away some of the arguments:
add_poly(+A1*x^B1+P1,_,_):-
and some of the subterms:
add_poly(+_+_,_,_):-
This corresponds to:
add_poly(+(+(_),_),_,_) :-
Not sure you like this.
So this rule applies only to terms starting with a prefix + followed by an infix +. At least your sample data did not contain a prefix +.
Also, please remark that the +-operator is left associative. That means that 1+2+3+4 associates to the left:
?- write_canonical(1+2+3+4).
+(+(+(1,2),3),4)
So if you have a term 0+3*x^3+2*x^4 the first thing you "see" is _+2*x^4. The terms on the left are nested deeper.
For your actual question (how to stop) - you will have to test explicitly that the leftmost subterm is an integer, use integer/1 - or maybe a term (*)/2 (that depends on your assumptions).
I assume that polynomials you are speaking of are in 1 variable and with integer exponents.
Here a procedure working on normal polynomial form: a polynomial can be represented as a list (a sum) of factors, where the (integer) exponent is implicitly represented by the position.
:- [library(clpfd)].
add_poly(P1, P2, Sum) :-
normalize(P1, N1),
normalize(P2, N2),
append(N1, N2, Nt),
aggregate_all(max(L), (member(M, Nt), length(M, L)), LMax),
maplist(rpad(LMax), Nt, Nn),
clpfd:transpose(Nn, Tn),
maplist(sumlist, Tn, NSum),
denormalize(NSum, Sum).
rpad(LMax, List, ListN) :-
length(List, L),
D is LMax - L,
zeros(D, Z),
append(List, Z, ListN).
% the hardest part is of course normalization: here a draft
normalize(Ts + T, [N|Ns]) :-
normalize_fact(T, N),
normalize(Ts, Ns).
normalize(T, [N]) :-
normalize_fact(T, N).
% build a list with 0s left before position E
normalize_fact(T, Normal) :-
fact_exp(T, F, E),
zeros(E, Zeros),
nth0(E, Normal, F, Zeros).
zeros(E, Zeros) :-
length(Zeros, E),
maplist(copy_term(0), Zeros).
fact_exp(F * x ^ E, F, E).
fact_exp(x ^ E, 1, E).
fact_exp(F * x, F, 1).
fact_exp(F, F, 0).
% TBD...
denormalize(NSum, NSum).
test:
?- add_poly(0+2*x^3, 0+1*x^3+2*x^4, P).
P = [0, 0, 0, 3, 2]
the answer is still in normal form, denormalize/2 should be written...

SWI-Prolog. Check correctness of mathematical expression

I try to check the correctness of student mathematical expression using Prolog (SWI-Prolog). So, for example if the student were asked to add three variable x, y, and z, and there's a rule that the first two variable that must be added are: x and y (in any order), and the last variable that must be added is z then I expect that prolog can give me true value if the student's answer is any of these:
x+y+z
(x+y)+ z
z+(x+y)
z+x+y
y+x+z
and many other possibilities.
I use the following rule for this checking:
addData :-
assert(variable(v1)),
assert(variable(v2)),
assert(variable(v3)),
assert(varName(v1,x)),
assert(varName(v2,y)),
assert(varName(v3,z)),
assert(varExpr(v1,x)),
assert(varExpr(v2,y)),
assert(varExpr(v3,z)).
add(A,B,R) :- R = A + B.
removeAll :- retractall(variable(X)),
retractall(varName(X,_)),
retractall(varExpr(X,_)).
checkExpr :-
% The first two variable must be x and y, in any combination
( (varExpr(v1,AExpr), varExpr(v2,BExpr));
(varExpr(v2,AExpr), varExpr(v1,BExpr))
),
add(AExpr, BExpr, R1),
% store the expression result as another variable, say v4
retractall(variable(v4)),
retractall(varName(v4, _)),
retractall(varExpr(v4, _)),
assert(variable(v4)),
assert(varName(v4, result)),
assert(varExpr(v4, R1)),
% add the result from prev addition with Z (in any combination)
( (varExpr(v3,CExpr), varExpr(v4,DExpr));
(varExpr(v4,CExpr), varExpr(v3,DExpr))
),
add(CExpr, DExpr, R2),
R2 = z + x + y. % will give me false
% R2 = z + (x + y). % will give me true
% Expected: both should give me true
checkCorrect :- removeAll,
addData,
checkExpr.
You should try to specify a grammar and write a parser for your expressions.
Avoid assert/retract, that make the program much more difficult to understand, and attempt instead to master the declarative model of Prolog.
Expressions are recursive data structures, using operators with known precedence and associativity to compose, and parenthesis to change specified precedence where required.
See this answer for a parser and evaluator, that accepts input from text. In your question you show expressions from code. Then you are using Prolog' parser to do the dirty work, and can simply express your requirements on the resulting syntax tree:
expression(A + B) :-
expression(A),
expression(B).
expression(A * B) :-
expression(A),
expression(B).
expression(V) :-
memberchk(V, [x,y,z]).
?- expression(x+y+(x+z*y)).
true .
edit: we can provide a template of what we want and let Prolog work out the details by means of unification:
% enumerate acceptable expressions
checkExpr(E) :-
member(E, [F = A + D, F = D + A]),
F = f,
A = c * N,
N = 1.8,
D = d.
And so on...
Test:
?- checkExpr(f=(c*1.8)+d).
true.
?- checkExpr(f=(c*1.8)+e).
false.
?- checkExpr(f=d+c*1.8).
true.

Resources