Tell prolog to stop and start search with other possibilities - prolog

I'm trying to solve the Rubik's cube with prolog, I've tried this:
cubo_resuelto(F, F, F, F, F, F, F, F, F,
A, A, A, A, A, A, A, A, A,
I, I, I, I, I, I, I, I, I,
D, D, D, D, D, D, D, D, D,
B, B, B, B, B, B, B, B, B,
T, T, T, T, T, T, T, T, T).
mov(f, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(F7, F4, F1, F8, F5, F2, F9, F6, F3,
A1, A2, A3, A4, A5, A6, I9, I6, I3,
I1, I2, B1, I4, I5, B2, I7, I8, B3,
A7, D2, D3, A8, D5, D6, A9, D8, D9,
D7, D4, D1, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9)).
mov(a, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,%
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(D1, D2, D3, F4, F5, F6, F7, F8, F9,
A7, A4, A1, A8, A5, A2, A9, A6, A3,
F1, F2, F3, I4, I5, I6, I7, I8, I9,
T9, T8, T7, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, I3, I2, I1)).
mov(d, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(F1, F2, B3, F4, F5, B6, F7, F8, B9,
A1, A2, F3, A4, A5, F6, A7, A8, F9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D7, D4, D1, D8, D5, D2, D9, D6, D3,
B1, B2, T3, B4, B5, T6, B7, B8, T9,
T1, T2, A3, T4, T5, A6, T7, T8, A9)).
mov(i, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(A1, F2, F3, A4, F5, F6, A7, F8, F9,
T1, A2, A3, T4, A5, A6, T7, A8, A9,
I7, I4, I1, I8, I5, I2, I9, I6, I3,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
F1, B2, B3, F4, B5, B6, F7, B8, B9,
B1, T2, T3, B4, T5, T6, B7, T8, T9)).
mov(b, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(F1, F2, F3, F4, F5, F6, I7, I8, I9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, T3, T2, T1,
D1, D2, D3, D4, D5, D6, F7, F8, F9,
B7, B4, B1, B8, B5, B2, B9, B6, B3,
D9, D8, D7, T4, T5, T6, T7, T8, T9)).
mov(t, cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
A1, A2, A3, A4, A5, A6, A7, A8, A9,
I1, I2, I3, I4, I5, I6, I7, I8, I9,
D1, D2, D3, D4, D5, D6, D7, D8, D9,
B1, B2, B3, B4, B5, B6, B7, B8, B9,
T1, T2, T3, T4, T5, T6, T7, T8, T9),
cubo(F1, F2, F3, F4, F5, F6, F7, F8, F9,
D3, D6, D9, A4, A5, A6, A7, A8, A9,
A3, I2, I3, A2, I5, I6, A1, I8, I9,
D1, D2, B9, D4, D5, B8, D7, D8, B7,
B1, B2, B3, B4, B5, B6, I1, I4, I7,
T7, T4, T1, T8, T5, T2, T9, T6, T3)).
move(+M, OldState, NewState):-
mov(M, OldState, NewState).
move(-M, OldState, NewState):-
mov(M, NewState, OldState).
move_list([], X, X).
move_list([Move|T], X, Z):-
move(Move, X, Y),
move_list(T, Y, Z).
So I can do something like this:
move_list(X, cubo('R', 'R', 'R', 'R', 'R', 'R', 'R', 'R', 'R',
'B', 'B', 'B', 'B', 'B', 'B', 'G', 'G', 'G',
'G', 'G', 'W', 'G', 'G', 'W', 'G', 'G', 'W',
'B', 'P', 'P', 'B', 'P', 'P', 'B', 'P', 'P',
'P', 'P', 'P', 'W', 'W', 'W', 'W', 'W', 'W',
'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y'),
cubo('R', 'R', 'R', 'R', 'R', 'R', 'R', 'R', 'R',
'B', 'B', 'B', 'B', 'B', 'B', 'B', 'B', 'B',
'G', 'G', 'G', 'G', 'G', 'G', 'G', 'G', 'G',
'P', 'P', 'P', 'P', 'P', 'P', 'P', 'P', 'P',
'W', 'W', 'W', 'W', 'W', 'W', 'W', 'W', 'W',
'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y')).
And it will answer with
X = [+f, +f, +f]
But when I try this:
move_list(X, cubo('R', 'R', 'P', 'R', 'R', 'W', 'P', 'P', 'P',
'B', 'B', 'R', 'B', 'B', 'R', 'G', 'G', 'R',
'G', 'G', 'W', 'G', 'G', 'W', 'R', 'R', 'W',
'B', 'B', 'B', 'P', 'P', 'P', 'B', 'Y', 'Y',
'Y', 'Y', 'Y', 'P', 'W', 'W', 'P', 'W', 'W',
'W', 'G', 'G', 'Y', 'Y', 'B', 'Y', 'Y', 'G'),
cubo('R', 'R', 'R', 'R', 'R', 'R', 'R', 'R', 'R',
'B', 'B', 'B', 'B', 'B', 'B', 'B', 'B', 'B',
'G', 'G', 'G', 'G', 'G', 'G', 'G', 'G', 'G',
'P', 'P', 'P', 'P', 'P', 'P', 'P', 'P', 'P',
'W', 'W', 'W', 'W', 'W', 'W', 'W', 'W', 'W',
'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y', 'Y')).
Prolog try to solve just with the +f movement.
I want to tell prolog that after 4 +f start look with other moves.
I also want to tell it that just try at max N movements.
How can I do that?
Thanks.
PS: I know that is not the best way to solve the Rubik's cube, but I want to try that way.


To limit the number of moves, add counter to the predicate. Move should be valid only if the counter is within the limit. Every move should decrease the counter. Counter(s) should be part of your state.
And you are right, that seems like a very bad way to solve Rubik's cube, especially if you allow reaching the same state twice - to prevent this, look at designing backtracking algorithms in prolog.

Related

Finding shortest path in water jugs problem

Here's my solution for the water jugs problem
:- use_module(library(clpfd)).
initial(state(8, 0, 0)).
final(state(4, 4, 0)).
constraint(A0, A1, B0, B1, C0, C1, V) :-
A0 #< A1,
( B0 #> 0, T #= min(V - A0, B0), A1 #= A0 + T, B1 #= B0 - T, C1 #= C0
; C0 #> 0, T #= min(V - A0, C0), A1 #= A0 + T, C1 #= C0 - T, B1 #= B0
).
transition(state(A0, B0, C0), state(A1, B1, C1)) :-
( constraint(A0, A1, B0, B1, C0, C1, 8)
; constraint(B0, B1, A0, A1, C0, C1, 5)
; constraint(C0, C1, A0, A1, B0, B1, 3)
).
solve(A, A, _, [A]).
solve(A, B, P, [A|Q]) :-
transition(A, A1),
\+ member(A1, P),
solve(A1, B, [A|P], Q).
path(P) :-
initial(S0),
final(S),
solve(S0, S, [], P).
Is there a way to find the P of minimal length without traversing all options?

Here is a solution that makes more use of the power of clpfd: First state the problem, then try to solve it (using labeling/2 or similar). Given that we do not know the length of the (shortest) path, this will generate larger and larger problems until a solution is found. In my code, I do not prevent visiting the same state twice (but this could be added in the same way as in the MiniZinc model written by #DavidTonhofer, or as some post-processing). However, in order to ensure a finite search space, I've added code to stop the problem generation if the length of the path is longer than (5+1)*(3+1), as this is an upper bound on the number of different states (assuming we have do not add or remove water outside of the 3 jugs).
:- use_module(library(clpfd)).
initial(state(8, 0, 0)).
final(state(4, 4, 0)).
constraint(A0,A1,B0,B1,C0,C1,R,Max):-
T#=min(Max-B0,A0),
R in 0..1,
R#==>T#>0,
R#==>A1#=A0-T,
R#==>B1#=B0+T,
R#==>C1#=C0.
transition(state(A0, B0, C0), state(A1, B1, C1)) :-
A0+B0+C0#=A1+B1+C1,
A0 in 0..8,
B0 in 0..5,
C0 in 0..3,
A1 in 0..8,
B1 in 0..5,
C1 in 0..3,
constraint(A0,A1,B0,B1,C0,C1,RAB,5),
constraint(B0,B1,A0,A1,C0,C1,RBA,8),
constraint(A0,A1,C0,C1,B0,B1,RAC,3),
constraint(C0,C1,A0,A1,B0,B1,RCA,8),
constraint(C0,C1,B0,B1,A0,A1,RCB,5),
constraint(B0,B1,C0,C1,A0,A1,RBC,3),
RAB+RBA+RAC+RCA+RCB+RBC#=1.
solve(A, A, Xs, [A]):-
labeling([],Xs).
solve(A, B, Xs, [A|Q]) :-
length(Xs, L),
L < 24*3,
transition(A, A1),
A=state(X1,X2,X3),
solve(A1, B, [X1,X2,X3|Xs], Q).
path(P) :-
initial(S0),
final(S),
solve(S0, S, [], P).
I tried to keep the code relatively close to the one in the question. The main difference is that all the prolog-level disjunctions in transition/2 and constraint/7 have been removed and replaced by reification. In particular, I added the parameter R to constraint/8 which is equal to 1 if that specific transition is taken. Then I state in transition/2 that exactly one of the transitions must take place.
I must add that this formulation is not particularly efficient and I would not be surprised to find out that one can solve the problem more efficiently with either a different clpfd formulation or without using clpfd at all.

Sum values of variables?

I'm new with Prolog, and I'm trying to create a predicate that find a specific fact and sum the values.
This is my predicate:
position(X,T,P1,P2,P3,P4) :- object(X,C1,C2,C3,C4,T1),
T>T1,
move(X,S1,S2,S3,S4,T2),
T2>T1,
T2=<T,
P1 is C1+S1,P2 is C2+S2,P3 is C3+S3,P4 is C4+S4.
And what i get is this:
?- position(car0,31,P1,P2,P3,P4).
P1 = 930,
P2 = 278,
P3 = 1057,
P4 = 365 ;
P1 = 943,
P2 = 288,
P3 = 1058,
P4 = 370 ;
false.
I want the sum of all(S1,S2,S3,S4) values of move with the (C1,C2,C3,C4) of object but I don't know how to do this.

You try to do too much in a single predicate. It usually is better to split the logic in several predicates that each perform a certain task.
Cummulative coordinates
We can first create a list of list of values with findall/3 [swi-doc]:
all_moves(X, T, Diffs) :-
findall([T1, C1, C2, C3, C4], (move(X,C1,C2,C3,C4,T1), T1 <= T), Cs),
sort(Cs, Diffs).
We here thus sort the move/6s on timestamp, and create a list of 5-tuples with [T1, C1, C2, C3, C4] with T1 the time stamp, and C1, C2, C3, and C4 the timestamps.
Next we can define a cummulative sum function by making use of plus/3 [swi-doc] and maplist/3 [swi-doc]:
cumsum(P, _, P).
cumsum(P, [[_|D]|R], P2) :-
maplist(plus, P, D, P1),
cumsum(P1, R, P2).
then we can thus obtain the positions of an object with:
position(X,T,P1,P2,P3,P4) :-
object(X, C1, C2, C3, C4, T1),
T > T1,
all_moves(X, T, Mvs),
cumsum([C1, C2, C3, C4], Mvs, [P1, P2, P3, P4]).
Final coordinates
If we only need the final coordinates, we can improve the above. In that case, the order of the moves is irrelevant, as long as these are properly filtered. So we can define allmoves_unsorted/3, like:
all_moves_unsorted(X, T, Diffs) :-
findall([C1, C2, C3, C4], (move(X, C1, C2, C3, C4, T1), T1 <= T), Diffs).
Then we can sum these up with the object, with foldl/4 [swi-doc]:
final_position(X, T, S1, S2, S3, S4) :-
object(X, P1, P2, P3, P4, T1),
T1 < T,
all_moves_unsorted(X, T, Diffs),
foldl(maplist(plus), Diffs, [P1, P2, P3, P4], [S1, S2, S3, S4]).

Compare lists of functors and unify variables

How can I verify if two lists represent the same relationship between their variables in any given order and then unify the corresponding variables?
For example the list:
[#=(_G13544,_G13547+1),#=(_G13553,_G13554),#=(_G13559,2),#>(_G13559, _G13544)]
would be equivalent to:
[#>(_G13453,_G13430),#=(_G13409,_G13355),#=(_G13453,2),#=(_G13430,1+_G13370)]
because both could be written as:
[A#>B,C#=D,A#=2,B#=E+1]
and the variable would be bound in the following way:
_G13453 = _G13559 # Equivalent to A
_G13430 = _G13544 # Equivalent to B
_G13409 = _G13553 # Equivalent to C
_G13355 = _G13554 # Equivalent to D
_G13370 = _G13547 # Equivalent to E
The functors are the following CLPFD operators:
Symmetrical: #=/2,+/2,-/2, and #\//2;
Not symmetrical: #>/2, and #</2;
Unary: abs/1

something to get started
'same relationship between their variables'(L1, L2, Vs) :-
copy_term(L1, T1),
copy_term(L2, T2),
numbervars(T1, 0, N),
numbervars(T2, 0, N),
rel_pairs(T1, T2, [], Vs).
rel_pairs([], [], B, B).
rel_pairs(Xs, Ys, B0, B2) :-
select(X, Xs, Xr),
select(Y, Ys, Yr),
assign(X, Y, B0, B1),
rel_pairs(Xr, Yr, B1, B2).
assign(A#=B, C#=D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2)
;
assign(A, D, B0, B1),
assign(B, C, B1, B2).
assign(A#>B, C#>D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2).
assign(A+B, C+D, B0, B2) :-
assign(A, C, B0, B1),
assign(B, D, B1, B2)
;
assign(A, D, B0, B1),
assign(B, C, B1, B2).
assign('$VAR'(A), '$VAR'(B), B0, B0) :-
memberchk(A-B, B0), !.
assign('$VAR'(A), '$VAR'(B), B0, [A-B|B0]) :-
\+memberchk(A-_, B0),
\+memberchk(_-B, B0), !.
assign(X, X, B, B).
surely there are a number of improvements that could be done...

Solving system of non-linear equations in Mathematica

I am trying to numerically solve the below system of six equations (g0-g5) for a0-a5 in Mathematica. I am no expert in Mathematica and am not entirely sure how to do this.
f[x_, y_] := Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y]
g0[x_, y_] := Integrate[f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g1[x_, y_] := Integrate[x*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]
g2[x_, y_] := Integrate[y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]
g3[x_, y_] := Integrate[x*x*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g4[x_, y_] := Integrate[y*y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}] - 1
g5[x_, y_] := Integrate[x*y*f[x, y],{y,-Infinity,Infinity},{x,-Infinity,Infinity}]
I have, however, spent considerable time trying to get NSolve and FindRoot to yield a solution. Here is that code:
NSolve[{g0[x, y]==0, g1[x, y]==0, g2[x, y]==0, g3[x, y]==0, g4[x, y]==0,
g5[x, y]==0}, {a0, a1, a2, a3, a4, a5}, Reals]
FindRoot[{g0[x, y]==0, g1[x, y]==0, g2[x, y]==0, g3[x, y]==0, g4[x, y]==0,
g5[x, y]==0}, {{a0,1}, {a1,1}, {a2,1}, {a3,1}, {a4,1}, {a5,1}}]
One additional piece of information I can offer is that the resulting solution for f(x,y) should be equivalent to the bivariate standard normal density. Any help would be much appreciated. This is my first post on SO, so please let me know if any additional information is necessary.

I am astonished. I never expected it to finish. But if you subtract off all the time for it to do the integrals then Reduce finishes in the blink of an eye.
f[x_, y_] := Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y];
g0[x_, y_] := Integrate[f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g1[x_, y_] := Integrate[x*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
g2[x_, y_] := Integrate[y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
g3[x_, y_] := Integrate[x*x*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g4[x_, y_] := Integrate[y*y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}]-1;
g5[x_, y_] := Integrate[x*y*f[x, y], {y, -Infinity, Infinity}, {x, -Infinity, Infinity}];
Reduce[Simplify[{g0[x,y]==0, g1[x,y]==0, g2[x,y]==0, g3[x,y]==0, g4[x,y]==0, g5[x,y]==0},
Re[4 a4-a5^2/a3]<0], {a0,a1,a2,a3,a4,a5}]
gives you
C[1] \[Element] Integers && a0==1+2I\[Pi] C[1]-Log[2]-Log[\[Pi]] &&
a1==0 && a2==0 && a3== -(1/2) && a4== -(1/2) && a5==0
Note: That gives Simplify one assumption which you should verify is justified. That assumption allows it to turn all your ConditionalExpression into presumably valid expressions for your problem. I got that assumption by looking at each of the results returned from Integrate and seeing that they all depended on that for the result to be valid.

Here is how to formulate this numerically:
f[x_, y_, a0_, a1_, a2_, a3_, a4_, a5_] :=
Exp[a0 - 1 + a1*x + a2*y + a3*x*x + a4*y*y + a5*x*y]
g0[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, Infinity},
{x, -Infinity, Infinity}] - 1
g1[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
x*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, Infinity},
{x, -Infinity, Infinity}]
g2[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity, Infinity},
{x, -Infinity, Infinity}]
g3[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
x*x*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity,
Infinity}, {x, -Infinity, Infinity}] - 1
g4[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
y*y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity,
Infinity}, {x, -Infinity, Infinity}] - 1
g5[a0_?NumericQ, a1_, a2_, a3_, a4_, a5_] :=
Integrate[
x*y*f[x, y, a0, a1, a2, a3, a4, a5], {y, -Infinity,
Infinity}, {x, -Infinity, Infinity}]
FindRoot[ {
g0[a0, a1, a2, a3, a4, a5] == 0,
g1[a0, a1, a2, a3, a4, a5] == 0,
g2[a0, a1, a2, a3, a4, a5] == 0,
g3[a0, a1, a2, a3, a4, a5] == 0,
g4[a0, a1, a2, a3, a4, a5] == 0,
g5[a0, a1, a2, a3, a4, a5] == 0} ,
{{a0, -.8379}, {a1, 0}, {a2, 0}, {a3, -.501},
{a4, -.499}, {a5, 0}}]
Note I've put in an initial guess very close to the known solution (thanks #Bill) and it still takes a very long time to find the answer.
{a0 -> -0.837388 - 1.4099*10^-29 I,
a1 -> -6.35273*10^-22 + 7.19577*10^-46 I,
a2 -> -1.27815*10^-20 + 6.00264*10^-38 I,
a3 -> -0.500489 + 1.41128*10^-29 I, a4 -> -0.5 - 7.13595*10^-44 I,
a5 -> -5.55356*10^-28 - 9.23563*10^-47 I}
Chop#%
{a0 -> -0.837388, a1 -> 0, a2 -> 0, a3 -> -0.500489, a4 -> -0.5,
a5 -> 0}

Syntax error: operator expected when trying to compare

I am trying to compare S1 with A1, S2 with A2, ..., S5 with A5 and get the total number of pairs that match each other. But the interpreter shows "syntax error, operator expected". Is there any simple approach to solve this problem and what's wrong with my code? Thanks!
grade(S1, S2, S3, S4, S5, A1, A2, A3, A4, A5, N):-
S1 = A1, grade2(S2, S3, S4, S5, A2, A3, A4, A5, N+1).
grade(S1, S2, S3, S4, S5, A1, A2, A3, A4, A5, N):-
\+ S1=A1, grade2(S2, S3, S4, S5, A2, A3, A4, A5, N).
grade2(S2, S3, S4, S5, A2, A3, A4, A5, N):-
S2=A2, grade3(S3, S4, S5, A3, A4, A5, N+1).
grade2(S2, S3, S4, S5, A2, A3, A4, A5, N):-
\+ S2=A2, grade3(S3, S4, S5, A3, A4, A5, N).
grade3(S3, S4, S5, A3, A4, A5, N):-
S3=A3, grade4(S4, S5, A4, A5, N+1).
grade3(S3, S4, S5, A3, A4, A5, N):-
\+ S3=A3, grade4(S4, S5, A4, A5, N).
grade4(S4, S5, A4, A5, N):-
S4=A4, grade5(S5, A5, N+1).
grade4(S4, S5, A4, A5, N):-
\+ S4=A4, grade5(S5, A5, N).
grade5(S5, A5, N):-
S5=A5, N is 1.
grade5(S5, A5, N):-
\+ S5=A5, N is 0.

With SWI-Prolog and module lambda you can write :
:- use_module(library(lambda)).
grade(S1, S2, S3, S4, S5, A1, A2, A3, A4, A5, N) :-
foldl(\X^Y^Z^T^(X = Y -> T is Z+1 ; T = Z),
[S1, S2, S3, S4, S5],
[A1, A2, A3, A4, A5],
0, N).

I don't get any syntax error from your code, but it can't execute: your first rule (for instance) should read
grade(S1, S2, S3, S4, S5, A1, A2, A3, A4, A5, N):-
S1 = A1, grade2(S2, S3, S4, S5, A2, A3, A4, A5, M),
N is M+1.
You used is/2 in the only place where it's useless. Last rule(s) could read
grade5(S5, S5, 1):-!.
grade5(_, _, 0).
Then for some easier to read code (understanding code with too much useless detail is harmful for my poor brain...), using library(aggregate)
grade(S1, S2, S3, S4, S5, A1, A2, A3, A4, A5, N):-
aggregate_all(count,
(nth1(I,[S1,S2,S3,S4,S5],X),
nth1(I,[A1,A2,A3,A4,A5],X)
), N).
I get
4 ?- grade(a,b,c,d,e, u,v,c,d,x, N).
N = 2.

I could not reproduce your error. However, as it is now it cannot work because of the way you calculate the value of N. If you do a trace you should be able to see where it goes wrong.
Anyway, although you seem to know in advance how many pairs you are comparing, a more generic approach is to put the pairs in two lists, or even better, in a list of pairs:
[S1-A1, S2-A2, ...]
The - here is just a way of writing -(S, A), and the usual Prolog way of representing "pairs". Once the list of pairs is in this form, you could then explicitly write:
grade([], 0).
grade([S-A|Rest], N) :-
( S == A
-> Add = 1
; Add = 0
),
grade(Rest, N0),
N is N0 + Add.
Note that you cannot use tail-recursion unless you have an extra argument to collect the result so far:
grade([], N, N).
grade([S-A|Rest], Acc, N) :-
( S == A
-> NewAcc is Acc + 1
; NewAcc = Acc
),
grade(Rest, NewAcc, N).
(you need to "initialize" the accumulator when you call the predicate)
?- grade(List, 0, N).
So for your case:
use your initial approach, but fix how N is calculated taking either of the two approaches shown
represent your list of pairs as an actual list of pairs
if you are working with lists, there are other techniques available, see library(aggregate), for example. Might be useful for more complex problems of the same kind.

Resources