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.
Related
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.
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]).
I am quite new to Prolog and want to create a program, where I can ask for a route with the predicate "route(Startpoint,Endpoint,Route)".
My code so far is:
% facts
connection(s1,s2).
connection(s2,s3).
connection(s3,s4).
connection(s4,s5).
connection(s5,s6).
connection(s6,s7).
connection(s7,s1).
% predicates
route1(X,Y,[X,Y]) :- connection(X,Y).
route1(X,Y,R) :- connection(X,Z), route1(Z,Y,RZ), R=[X|RZ].
route2(X,Y,[X,Y]) :- connection(Y,X).
route2(X,Y,R) :- connection(Z,X), route2(Z,Y,RZ), R=[X|RZ].
route(X,Y,R) :- route1(X,Y,R); route2(X,Y,R).
My code works for some routes, but not when it comes to a cycle (like in the facts above). How can I prevent in Prolog, that a station gets visited in a route multiple times?
For example when I ask "?- route1(s1,s4,R).", Prolog gives me the correct route "[s1,s2,s3,s4]" first, but it also gives me other routes like "[s1, s2, s3, s4, s5, s6, s7, s1, s2, s3, s4]", "[s1, s2, s3, s4, s5, s6, s7, s1, s2, s3, s4, s5, s6, s7, s1, s2, s3, s4]" and so on.
Thanks in advance!
You could just write:
route1(X,Y,[X,Y]) :- connection(X,Y).
route1(X,Y,R) :- connection(X,Z), route1(Z,Y,RZ),R=[X|RZ],
sort(R,R1),length(R,N),length(R1,N1),
(N>N1->!,fail ;true).
sort/2 removes duplicates so if you want your solution not to have duplicates the sorted list and the output list must have same length.
?- route1(s1,s4,R).
R = [s1, s2, s3, s4] ;
false.
Another ways to do that would be :
route1(X,Y,R):-route1(X,Y,[],R).
route1(X,Y,_,[X,Y]) :- connection(X,Y).
route1(X,Y,L,R) :- connection(X,Z),\+member(Z,L),
route1(Z,Y,[Z|L],RZ),R=[X|RZ].
Example:
?- route1(s1,s4,R).
R = [s1, s2, s3, s4] ;
false.
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...
Suppose there are two lists a = {a1, a2, a3} and b = {b1, b2, b3}, and I want to write an assignment statement to make a1=b1,a2=b2,a3=b3 which only refers to a and b:
Thread[a = b]
But it only makes a={b1,b2,b3}. Using := (SetDelayed) instead of = doesn't work either.
Any solution? Thanks.
I think the Thread only works on "explicit" lists; the variables need to be expanded before being operated on.
After some experimentation, this works for me:
a = {a1, a2, a3};
b = {b1, b2, b3};
Thread[Set[Evaluate#a, Evaluate#b]];
{a1, a2, a3}
You could also write Thread[Evaluate#a = Evaluate#b]; just depends whichever you find more readable.
What's wrong with
MapThread[Set,{{a1,a2,a3},{b1,b2,b3}}]
?
Here's another solution:
a = {a1, a2, a3};
b = {b1, b2, b3};
each[{x_, y_}, Transpose[{a, b}],
x = y]
Which uses my handy each function:
SetAttributes[each, HoldAll]; (* each[pattern, list, body] *)
each[pat_, lst_, bod_] := (* converts pattern to body for *)
Scan[Replace[#, pat:>bod]&, Evaluate#lst] (* each element of list. *)
Similarly, you can do this:
MapThread[(#1 = #2)&, {a, b}]
Well, if they are really called a1, a2, etc, you could do this:
Assign[x_, y_] := Module[{s1, s2, n, sn},
s1 = SymbolName[Unevaluated[x]];
s2 = SymbolName[Unevaluated[y]];
For[n = 1, n <= Length[x] && n <= Length[y], n++,
sn = ToString[n];
Evaluate[Symbol[s1 <> sn]] = Evaluate[Symbol[s2 <> sn]]
]
]
SetAttributes[Assign, HoldAll]
And then
Clear[b1, b2, b3];
Clear[a1, a2, a3];
a = {a1, a2, a3}
b = {b1, b2, b3}
Assign[a, b]
a
Gives the results for a, b and a again as:
{a1, a2, a3}
{b1, b2, b3}
{b1, b2, b3}
As expected.
In general you can create expressions like these from proper use of SymbolName and Symbol, but be careful with your evaluation. If I had written SymbolName[x] (without the Unevaluated) then it would've interpreted that as SymbolName[{a1, a2, a3}], which is clearly not desirable. Not using Evaluate on Symbol[s1 <> sn] will have Mathematica complain that you're trying to reassign the Symbol function.