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.
Related
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'm trying to implement Levenshtein distance in Prolog.
The implementation is pretty straightforward:
levenshtein(W1, W2, D) :-
atom_length(W1, L1),
atom_length(W2, L2),
lev(W1, W2, L1, L2, D),
!.
lev(_, _, L1, 0, D) :- D is L1, !.
lev(_, _, 0, L2, D) :- D is L2, !.
lev(W1, W2, L1, L2, D) :-
lev(W1, W2, L1 - 1, L2, D1),
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
min(D1, D2, D3 + T, D).
% Returns the character at position N in the atom A
% The position is 1-based
% A: The atom
% N: The position at which to extract the character
% C: The character of A at position N
charAt(A, N, C) :- P is N - 1, sub_atom(A, P, 1, _, C).
% min(...): These rules compute the minimum of the given integer values
% I1, I2, I3: Integer values
% M: The minimum over the values
min(I1, I2, M) :- integer(I1), integer(I2), ( I1 =< I2 -> M is I1; M is I2).
min(I1, I2, I3, M) :- min(I1, I2, A), min(I2, I3, B), min(A, B, M).
However, this code failures with this error:
?- levenshtein("poka", "po", X).
ERROR: Out of local stack
I'm using SWIPL implementation on Mac OS X Sierra.
There is a good reason for which your program does not work: your recursive calls lead into an infinite loop.
This is caused by those lines:
lev(W1, W2, L1 - 1, L2, D1),
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
min(D1, D2, D3 + T, D)
In Prolog things like L1 - 1 are expressions that do not get evaluated to numbers. Therefore your code will recursively call lev with the third argument as L1 -1, then L1 - 1 - 1, etc. which does not match your terminating rules.
To fix this you need to use temporary variables where you evaluate the result of e.g. L1 - 1.
This fixes it:
lev(W1, W2, L1, L2, D) :-
L11 is L1 - 1,
L22 is L2 - 1,
lev(W1, W2, L11, L2, D1),
lev(W1, W2, L1, L22, D2),
lev(W1, W2, L11, L22, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
D4 is D3 + T,
min(D1, D2, D4, D).
Now this does this:
?- levenshtein("poka","po",X).
X = 0.
Which is probably not the result you want, but at least it does not error. I will leave it to you to fix your predicate.
There are several problems with your program.
The loop
#Fatalize already gave you a reason, here is a general method how you can localize such problems, using a failure-slice by which some goals false are inserted into your program. If the remaining program loops, also the original version did:
?- levenshtein("poka","po",X), false.
levenshtein(W1, W2, D) :-
atom_length(W1, L1),
atom_length(W2, L2),
lev(W1, W2, L1, L2, D), false,
!.
lev(_, _, L1, 0, D) :- D is L1, !.
lev(_, _, 0, L2, D) :- D is L2, !.
lev(W1, W2, L1, L2, D) :-
lev(W1, W2, L1 - 1, L2, D1), false,
lev(W1, W2, L1, L2 - 1, D2),
lev(W1, W2, L1 - 1, L2 - 1, D3),
charAt(W1, L1, C1),
charAt(W2, L2, C2),
( C1 = C2 -> T is 0; T is 1 ),
min(D1, D2, D3 + T, D).
You have to modify something in the remaining, visible part. Otherwise, this problem will persist.
Use lists!
Instead of using atoms or strings, better use lists to represent words. The best is to add into your .swiplrc or .sicstusrc:
:- set_prolog_flag(double_quotes, chars).
In this manner, the following holds:
?- "abc" = [a,b,c].
Avoid cuts
Cuts somehow, sometimes work, but such programs are hard-to-debug. In particular for beginners. Therefore, avoid them at all costs
Use clean arithmetics
You are using the "olde" arithmetic of Prolog which is highly moded. Instead use_module(library(clpfd)) to get purer code.
I am trying to calculate cousin relationship in the format P'th cousin Qth removed. For example, In this picture below,
Thomas and Zack are cousins twice removed.
Thomas and Nikolay are second cousins once removed
Thomas and Saul are third cousins zero'th removed
So far I have a code like this that, finds the cousins:
ancestor(X,Z):-parent(X,Z).
ancestor(X,Z):-parent(X,Y), ancestor(Y,Z).
cousins(Child1, Child2) :-
ancestor(Y1,Child1),
ancestor(Y1,Child2),
Child1 \= Child2.
My logic is as long as Child1 and Child2 shares a common ancestor they are cousins.
The issue I am having is in trying to find out whether they are first cousins, or second cousins, or third cousins etc and whether they are once removed, twice removed, or thrice removed.
Any suggestion or hints on how I could solve this problem would be greatly helpful.
Thanks!
I think I got this right.
You will need the CLP(FD) library to make this work.
Simply write :- use_module(library(clpfd)). at the beginning of your program.
cousins_nth_removed/4
The first two arguments are atoms representing the persons' names. The third argument (in [1,sup)) represents the first/second/third/... cousins relationship, while the fourth argument (in [0,sup)) represents the zeroth/once/twice/... removed relationship
cousins_nth_removed(C1, C2, 1, 0) :- % First cousins, zeroth removed
dif(C1, C2),
dif(P1, P2), % They have different parents
parent_child(P1, C1),
parent_child(P2, C2),
parent_child(GP, P1), % Their parents have the same parent GP
parent_child(GP, P2).
cousins_nth_removed(C1, C2, N, 0) :- % Nth cousins, zeroth removed
N #> 1,
dif(C1, C2),
children_removed_ancestor(C1, C2, R, R), % They are both R generations away from
dif(P1, P2), % their oldest common ancestor
parent_child(P1, C1),
parent_child(P2, C2),
M #= N - 1, % Their parents are N-1th cousins
cousins_nth_removed(P1, P2, M, 0). % zeroth removed
cousins_nth_removed(C1, C2, N, R) :- % Nth cousins, Rth removed
R #> 0,
dif(C1, C2),
children_removed_ancestor(C1, C2, R1, R2), % R is the difference of the distances
R #= abs(R2 - R1), % between each cousin and their oldest
S #= R - 1, % common ancestor
( R1 #= R2, % R = 0 -> Zeroth removed, second rule
cousins_nth_removed(C1, C2, N, 0)
; R1 #> R2, % C1 is younger than C2
parent_child(P1, C1), % -> C2 is Nth cousin R-1th removed
cousins_nth_removed(P1, C2, N, S) % with the parent of C1
; R1 #< R2, % C2 is younger than C1
parent_child(P2, C2), % -> C1 is Nth cousin R-1th removed
cousins_nth_removed(C1, P2, N, S) % with the parent of C2
).
children_removed_ancestor/4
The name isn't ideal, but this predicate is basically used to retrieve the generation gaps of two persons to their oldest common ancestor.
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor/3
This predicate retrieves the generation gap between a person and their oldest ancestor.
child_removed_oldest_ancestor(C, 0, C) :- % The ancestor of all
\+ parent_child(_, C). % They have no parent
child_removed_oldest_ancestor(C, N, A) :-
N #> 0,
parent_child(P, C),
M #= N - 1,
child_removed_oldest_ancestor(P, M, A).
Some queries
?- cousins_nth_removed(thomas, zack, N, R). % Your example
N = 1,
R = 2 ;
false.
?- cousins_nth_removed(thomas, nikolay, N, R). % Your example
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(thomas, saul, N, R). % Your example
N = 3,
R = 0 ;
false.
?- cousins_nth_removed(thomas, C, N, R). % All cousins of thomas
C = farah,
N = 1,
R = 0 ;
C = ping,
N = 2,
R = 0 ;
C = william,
N = 3,
R = 0 ;
C = saul,
N = 3,
R = 0 ;
C = sean,
N = R, R = 1 ;
C = steven,
N = R, R = 1 ;
C = zack,
N = 1,
R = 2 ;
C = kyle,
N = 2,
R = 1 ;
C = nikolay,
N = 2,
R = 1 ;
C = wei,
N = 2,
R = 1 ;
false.
?- cousins_nth_removed(C1, C2, 3, 0). % All third cousins zeroth removed
C1 = ping,
C2 = william ;
C1 = ping,
C2 = saul ;
C1 = farah,
C2 = william ;
C1 = farah,
C2 = saul ;
C1 = ignat,
C2 = william ;
C1 = ignat,
C2 = saul ;
C1 = thomas,
C2 = william ;
C1 = thomas,
C2 = saul ;
C1 = william,
C2 = ping ;
C1 = william,
C2 = farah ;
C1 = william,
C2 = ignat ;
C1 = william,
C2 = thomas ;
C1 = saul,
C2 = ping ;
C1 = saul,
C2 = farah ;
C1 = saul,
C2 = ignat ;
C1 = saul,
C2 = thomas ;
false.
Overall program
:- use_module(library(clpfd)).
parent_child(leila,min).
parent_child(leila,seema).
parent_child(min,ali).
parent_child(min,jesse).
parent_child(min,john).
parent_child(ali,sean).
parent_child(ali,steven).
parent_child(sean,ping).
parent_child(jesse,dallas).
parent_child(jesse,mustafa).
parent_child(dallas,farah).
parent_child(mustafa,ignat).
parent_child(mustafa,thomas).
parent_child(seema,zack).
parent_child(zack,kyle).
parent_child(zack,nikolay).
parent_child(zack,wei).
parent_child(kyle,william).
parent_child(nikolay,saul).
cousins_nth_removed(C1, C2, 1, 0) :-
dif(C1, C2),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
parent_child(GP, P1),
parent_child(GP, P2).
cousins_nth_removed(C1, C2, N, 0) :-
N #> 1,
dif(C1, C2),
children_removed_ancestor(C1, C2, R, R),
dif(P1, P2),
parent_child(P1, C1),
parent_child(P2, C2),
M #= N - 1,
cousins_nth_removed(P1, P2, M, 0).
cousins_nth_removed(C1, C2, N, R) :-
R #> 0,
dif(C1, C2),
children_removed_ancestor(C1, C2, R1, R2),
R #= abs(R2 - R1),
S #= R - 1,
( R1 #= R2,
cousins_nth_removed(C1, C2, N, 0)
; R1 #> R2,
parent_child(P1, C1),
cousins_nth_removed(P1, C2, N, S)
; R1 #< R2,
parent_child(P2, C2),
cousins_nth_removed(C1, P2, N, S)
).
children_removed_ancestor(C1, C2, R1, R2) :-
child_removed_oldest_ancestor(C1, R1, A),
child_removed_oldest_ancestor(C2, R2, A).
child_removed_oldest_ancestor(C, 0, C) :-
\+ parent_child(_, C).
child_removed_oldest_ancestor(C, N, A) :-
N #> 0,
parent_child(P, C),
M #= N - 1,
child_removed_oldest_ancestor(P, M, A).
I now hate genealogical trees.
So I have a simpler variation of the Einstein/Zebra puzzle in Prolog.
And I came up with this possible solution:
b_setval(T_age, Var).
friends(L) :-
L = [person(A1, B1, T_age), person(A2, B2, C2), person(A3, B3, T_age+3)],
:
:
member(person(_,yang,T_age+3),L),
member(person(_,_,18),L).
But my query friends(L). - false. only returns false as stated.
What am I doing wrong?
After following the answer of #luker, you can check your answer
friends(L) :-
% 1
L = [person(ada, _, Ta), person(ama, _, _), person(ana, _, _)],
% 2
member(person(_,_,15), L),
member(person(_,_,17), L),
member(person(_,_,18), L),
% 3
member(person(_, chang, _), L),
% 4
member(person(_, yang, Ty), L), Ty is Ta + 3,
% 5
member(person(_, thatcher, 17), L).
Interesting, this produces 2 results, which is weird for this kind of problem.
One potential problem that stands out is the T_age+3 term in the list L. In Prolog, this will not be arithmetically evaluated in-line. It will simply be the term, '+'(T_age,3). So the only element that would match this member of the list would be a term that looks like, person(X, Y, <something>+3). It's unclear whether this is your intention.
You can do a trace to see how variables are being instantiated with each member call, but let's try doing this manually for illustrative purposes:
L = [person(A1, B1, T_age), person(A2, B2, C2), person(A3, B3, T_age+3)],
member(person(ada, _,T_age),L),
...
This member call should succeed because Prolog can match it to person(A1, B1, T_age) in the list by unifying A1 = ada. The list L now looks like:
[person(ada, B1, T_age), person(A2, B2, C2), person(A3, B3, T_age+3)]
Moving on to the next member call:
member(person(ama, _, _),L),
...
This can't match the first member, but can match the second by unifying A2 = ama. L is now:
[person(ada, B1, T_age), person(ama, B2, C2), person(A3, B3, T_age+3)]
Then you have:
member(person(ana, _, _),L),
This can't match the first or second members, but can match the third by unifying A3 = ana. L is now:
[person(ada, B1, T_age), person(ama, B2, C2), person(ana, B3, T_age+3)]
The next member call is:
member(person(_,chang, _),L),
Which can match the first member again by unifying B1 = chang, so L becomes:
[person(ada, chang, T_age), person(ama, B2, C2), person(ana, B3, T_age+3)]
Then
member(person(_,yang,T_age+3),L),
This will match the second element of the list by unifying, B2 = yang and C2 = T_age+3. L then becomes:
[person(ada, chang, T_age), person(ama, yang, T_age+3), person(ana, B3, T_age+3)]
Then
member(person(_,thatcher,17),L),
This is where you have some trouble. It cannot match the first two elements of L because of the second argument. The third argument, 17 cannot match the term, T_age+3 in the third element of L. Remember: Prolog does not solve this as an equation T_age+3 = 17. It is just going to see 17 as an atomic integer, and see T_age+3 as a term with two arguments and find that they don't match. So this member call fails, and the whole predicate fails.
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...