Related
I wrote this small program in Prolog.
odd_even_flip(odd, even).
odd_even_flip(even, odd).
% flip_one, for A = a, B = b, P = [a, .., b, ..], gives M = [b, .., a, ..]
flip_one(A, B, P, M) :-
append([A|As], [B|Bs], P),
append([B], As, L),
append([A], Bs, R),
append(L, R, M).
permutation_parity([X|L], [X|P], R) :- permutation_parity(L, P, R).
% abc
permutation_parity([X|L], [Y|P], R) :-
X \= Y,
flip_one(Y, X, [Y|P], M),
permutation_parity([X|L], M, Res),
odd_even_flip(Res, R).
permutation_parity([], [], even).
I expect it to find the parity of a permutation P of list L. The few queries that assert that a given permutation of a given list is indeed even or odd worked fine.
However, from my experience with Prolog, I would expect that permutation_parity([a, b, c], X, Y). would show me all permutations of [a, b, c] but that is not happening.
Rather, I get X = [a, b, c], Y = even. and that is all.
I tried to add member(Y, L) in the rule that follows %abc as I was thinking that will help Prolog to know how to instantiate X in permutation_parity([a, b, c], X, Y) but that helped to no avail.
If someone could help me see what I am missing it would be great. Thanks in advance.
You only need to use unification to correctly instantiate the variable X (assuming that permutation_parity/3 is called with a proper list as its first argument). So I suggest you modify your code as follows:
permutation_parity([], [], even).
permutation_parity([X|Xs], [X|Zs], P) :-
permutation_parity(Xs, Zs, P).
permutation_parity([X|Xs], Zs, P) :-
permutation_parity(Xs, Ys, Q),
flip_first([X|Ys], Zs),
odd_even_flip(Q, P).
flip_first(L0, L1) :-
append([X|Xs], [Y|Ys], L0),
append([Y|Xs], [X|Ys], L1).
odd_even_flip(odd, even).
odd_even_flip(even, odd).
Examples:
?- permutation_parity([a,b,c], Permutation, Parity).
Permutation = [c, a, b],
Parity = even ;
Permutation = [b, c, a],
Parity = even ;
Permutation = [b, a, c],
Parity = odd ;
Permutation = [c, b, a],
Parity = odd ;
Permutation = [a, c, b],
Parity = odd ;
Permutation = [a, b, c],
Parity = even.
?- permutation_parity([a,b,c], [a,c,b], Parity).
Parity = odd ;
false.
?- permutation_parity([a,b,c], Permutation, even).
Permutation = [c, a, b] ;
Permutation = [b, c, a] ;
Permutation = [a, b, c].
EDIT
perm_parity(L0, L1, P) :-
same_length(L0, L1),
permutation_parity(L0, L1, P).
The predicate same_length/2 is defined in SWI-Prolog as follows:
same_length([], []).
same_length([_|T1], [_|T2]) :-
same_length(T1, T2).
Example:
?- perm_parity(L, [a,b,c], P).
L = [b, c, a],
P = even ;
L = [c, a, b],
P = even ;
L = [b, a, c],
P = odd ;
L = [c, b, a],
P = odd ;
L = [a, c, b],
P = odd ;
L = [a, b, c],
P = even.
I just can't seem to get the correct output - I am supposed to get -
?- dfs([a], X).
X = [a, f, i] ;
false.
But I get -
?- dfs([a], X).
X = [a|f] ;
% Representation of a tree
% choose initial state a
arc(a, b).
arc(a, f).
arc(b, c).
arc(b, d).
arc(b, e).
arc(f, g).
arc(f, i).
arc(i, j).
arc(i, k).
% the goal
goal(i).
dfs([Node|_], [Node|X]) :-
goal(X).
dfs([Node|_], [Node|X]) :-
expands([Node|_], NewNode),
append([Node|_], NewNode, appendedN),
dfs(appendedN, X).
% expands(+Path, ?NewNode).
% -- Path: is a list of nodes of the form Path=[Node|Nodes], where
% Node is the node we want to expand and Nodes is a list
% of remaining nodes already expanded and containing the root.
% -- NewNode: is a constant representing the node we want to go to,
% as there is an link to it from where we are currently.
%
expands([Node|_], NewNode):-
arc(Node, NewNode).
Your program matches the first clause, dfs([Node|_], [Node|X]), and nothing else, producing X = [a|i] .
Here's a working version.
% Representation of a tree
% choose initial state a
arc(a, b).
arc(a, f).
arc(b, c).
arc(b, d).
arc(b, e).
arc(f, g).
arc(f, i).
arc(i, j).
arc(i, k).
% the goal
goal(i).
% You can expand a starting symbol S to a list L if G is your goal, S expands
% to G in list L1, and you append the two lists.
dfs([S], L) :-
goal(G),
expands(S, G, L1),
append([S], L1, L).
% X expands to Y in list [Y] if there's a direct arc from X to Y (base case).
expands(X, Y, [Y]) :-
arc(X, Y).
% X expands to Z in list [Y|L] if there's a direct arc from X to Y and Y
% expands to Z in list L (recursive case).
expands(X, Z, [Y|L]) :-
arc(X, Y),
expands(Y, Z, L).
In this version, expands() produces all of the lists that start with a:
?- expands(a, X, L).
X = b,
L = [b] ;
X = f,
L = [f] ;
X = c,
L = [b, c] ;
X = d,
L = [b, d] ;
X = e,
L = [b, e] ;
X = g,
L = [f, g] ;
X = i,
L = [f, i] ;
X = j,
L = [f, i, j] ;
X = k,
L = [f, i, k] ;
false.
Then dfs() confirms that the goal i has been reached and adds the start symbol a to the head of the list:
?- dfs([a], X).
X = [a, f, i] ;
false.
So I have this undirected graph to traverse, and I should find all the verticies those are connected to a given vertex.
edge(a, b).
edge(b, c).
edge(c, d).
edge(d, e).
edge(e, f).
edge(f, d).
edge(d, g).
edge(g, f).
edge(g, h).
edge(h, i).
edge(i, j).
edge(j, d).
edge(d, k).
edge(l, m).
edge(m, n).
undirectedEdge(X, Y) :- edge(X, Y).
undirectedEdge(X, Y) :- edge(Y, X).
connected(X, Y) :- undirectedEdge(X, Y).
connected(X, Y) :- connected(X, Z), connected(Z, Y), X \= Y.
And once I type connected(a, X). it goes into an infinite loop.
I understand why I have it, but I have no idea how to avoid it, maybe I can find some help here?
Using closure0/3 and setof/3 we get:
connected(A,B) :-
setof(t, closure0(undirectedEdge, A, B), _).
And once I type connected(a, X). it goes into an infinite loop.
The reason this happens is because it is checking a path of the form a → b → a → b → a → b → …. So it keeps "hopping" between two nodes.
You can maintain a list of nodes that the algorithm already visisted, to prevent that like:
connected(X, Y) :-
connected(X, Y, [X]).
connected(X, X, _).
connected(X, Z, L) :-
undirectedEdge(X, Y),
\+ member(Y, L),
connected(Y, Z, [Y|L]).
You can make use of the distinct/1 predicate [swi-doc] to generate distinct answers:
?- distinct(connected(a, X)).
X = a ;
X = b ;
X = c ;
X = d ;
X = e ;
X = f ;
X = g ;
X = h ;
X = i ;
X = j ;
X = k ;
false.
predicate change_pos(E1, E2,Lin,Lout).
The Lin has any number of elements, and I need to change all occurences of E1 to E2, and vice-versa. And return in Lout.
I was thinking to do something like this:
change(X, Y, [], []).
change(X, Y, [X|L], [Y,L1]):- change(X,Y,L,L1).
change(X, Y, [Z|L], [Z,L1]:- X \== Z, change(X,Y,L,L1).
But this way is not swiping two number of the list
I'm supposing, since this is homework, it's an exercise to learn list processing and recursion. But in Prolog, a common tool for processing each term in turn in a list is maplist:
% Rule for changing one element
change_element(X, Y, X, Y).
change_element(X, Y, Y, X).
change_element(X, Y, Z, Z) :- dif(X, Z), dif(Y, Z).
% Rule for changing a list
change(X, Y, L1, L2) :-
maplist(change_element(X, Y), L1, L2).
Which yields:
?- change(a, b, [a,b,c,b,a], L).
L = [b, a, c, a, b] ? ;
no
?-
For a determinate solution, you can use if_/3:
change1(X, Y, A, B) :-
if_(=(Y, A), B = X, A = B).
change2(X, Y, A, B) :-
if_(=(X, A), B = Y, change1(X, Y, A, B)).
change(X, Y, L1, L2) :- maplist(change2(X, Y), L1, L2).
Which yields:
?- change(a, b, [a,b,c,b,a], L).
L = [b, a, c, a, b].
?-
You're almost there. Your base case (the empty lists) and your second rule (swap X for Y) are basically fine (apart from the details pointed out in the comments). However, you are missing a rule for vice-versa (swap Y for X). And in your last rule you likely want to make sure that Z differs not only from X but also from Y, otherwise Z would be subject to rule two or three.
change(X, Y, [], []).
change(X, Y, [X|L], [Y|L1]) :-
change(X,Y,L,L1).
change(X, Y, [Y|L], [X|L1]) :- % <- vice versa case
change(X,Y,L,L1).
change(X, Y, [Z|L], [Z|L1]) :-
dif(X,Z), % <- neither X=Z
dif(Y,Z), % <- nor vice versa
change(X,Y,L,L1).
Here are some example queries. What does [1,2,3,4] look like after swapping 1 with 2 and vice versa?
?- change(1,2,[1,2,3,4],L).
L = [2,1,3,4] ? ;
no
What did [2,1,3,4] look like before swapping 1 with 2 and vice versa?
?- change(1,2,L,[2,1,3,4]).
L = [1,2,3,4] ? ;
no
Which elements have been swapped in [1,2,3,4] if the resulting list is [2,1,3,4] ?
?- change(X,Y,[1,2,3,4],[2,1,3,4]).
X = 1,
Y = 2 ? ;
X = 2,
Y = 1 ? ;
no
Solve the following Caliban problem, translating each clue
'loyally' into Prolog, i.e. as loyally as possible.
As a simple exercise in abstraction suppose that four meaningless
symbols a, b, c, and d correspond in one order or another to the
equally meaningless symbols w, x, y, and z, and suppose further that
If a is not x, then c is not y.
If b is either y or z, then a is x.
If c is not w, then b is z.
If d is y, then b is not x.
If d is not x, then b is x.
In what order do the two sets of symbols correspond?
I tried the following code:
vban(L) :-
L=[[a,C1],[b,C2],[c,C3],[d,C4]],
( member(C1,[w,y,z]) -> member(C3,[w,x,z])),
( member(C2,[y,z]) -> member(C1,[x])),
( member(C3,[x,y,z]) -> member(C2,[z])),
( member(C4,[y]) -> member(C2,[w,y,z])),
( member(C4,[w,y,z]) -> member(C2,[x])).
But it shows fail.Any help would be appreciated.
Using CLP(B) in SICStus Prolog or SWI:
:- use_module(library(clpb)).
:- use_module(library(lists)).
:- use_module(library(clpfd)).
corresponding(Matrix) :-
Matrix = [[ _,AX, _, _],
[ _,BX,BY,BZ],
[CW, _,CY, _],
[ _,DX,DY, _]],
maplist(card1, Matrix),
transpose(Matrix, TMatrix),
maplist(card1, TMatrix),
sat(~AX =< ~CY),
sat(BY + BZ =< AX),
sat(~CW =< BZ),
sat(DY =< ~BX),
sat(~DX =< BX).
card1(Vs) :- sat(card([1], Vs)).
Example query:
?- corresponding(Vs),
pairs_keys_values(Pairs, [t,a,b,c,d], [[w,x,y,z]|Vs]),
maplist(writeln, Pairs).
Yielding (1 denotes corresponding elements):
t-[w,x,y,z]
a-[0,0,1,0]
b-[0,1,0,0]
c-[1,0,0,0]
d-[0,0,0,1]
and bindings for Vs and Pairs.
Direct translation of the problem statement to ECLiPSe Prolog with ic_symbolic constraint programming library:
:- lib(ic).
:- lib(ic_symbolic).
:- local domain(symbol(w,x,y,z)).
russel(A, B, C, D) :-
[A, B, C, D] &:: symbol,
(A &\= x) => (C &\= y),
(B &= y or B &= z) => (A &= x),
(C &\= w) => (B &= z),
(D &= y) => (B &\= x),
(D &\= x) => (B &= x),
ic_symbolic:alldifferent([A, B, C, D]),
ic_symbolic:indomain(A),
ic_symbolic:indomain(B),
ic_symbolic:indomain(C),
ic_symbolic:indomain(D).
Solution:
[eclipse]: russel(A,B,C,D).
A = y
B = x
C = w
D = z
Yes
I like Mat's solution, but to solve the problem, we can write logical expressions with "and" and "or".
a, b, c et d can be symbolised with [0,0], [0,1], [1,0] and [1,1].
Two numbers M and N are equals if (M1 = N1 and M2 = N2)
Two numbers are differents if (M1 \= N1) or (M2 \= N2) (or not(equals) )
Implication u => v is translated in not(u) or v
So we get :
:- use_module(library(clpb)).
:- use_module(library(lambda)).
or(A,B,A+B).
and(A,B,A*B).
% two numbers are equal
equal(A, B, Eq) :-
foldl(\X^Y^Z^T^and(Z, (X =:= Y), T), A, B, 1, Eq).
% two numbers are different
different(A, B, Diff) :-
equal(A,B,Eq),
Diff = ~Eq.
% foldl(\X^Y^Z^T^or(Z, (X =\= Y), T), A, B, 0, Diff).
puzzle :-
A = [0,0],
B = [0,1],
C = [1,0],
D = [1,1],
W = [_,_],
X = [_,_],
Y = [_,_],
Z = [_,_],
% If a is not x, then c is not y.
% (a is x) or (c is not y)
equal(A, X, Eq1),
different(C, Y, Di1),
or(Eq1, Di1, P1),
% If b is either y or z, then a is x.
% (b is not y) and (b is not z) or (a is x)
different(B, Y, Di2),
different(B, Z, Di3),
equal(A, X, Eq2),
and(Di2, Di3, P2),
or(Eq2, P2, P3),
% If c is not w, then b is z.
% (c is w) or (b is z)
equal(C, W, Eq3),
equal(B, Z, Eq4),
or(Eq3, Eq4, P4),
% If d is y, then b is not x.
% (d is not y) or (b is not x)
different(D, Y, Di4),
different(B, X, Di5),
or(Di4, Di5, P5),
% If d is not x, then b is x.
%(d is x) or (b is x)
equal(D, X, Eq5),
equal(B, X, Eq6),
or(Eq5, Eq6, P6),
% we must express that W,X,Y,Z are differents
% W is different from X, Y, Z
foldl(W +\R^S^T^(different(W, R, U),
and(S, U, T)),
[X,Y,Z], 1, Dif1),
% X is different from Y, Z
foldl(X +\R^S^T^(different(X, R, U),
and(S, U, T)),
[Y,Z], 1, Dif2),
% Y is different from Z
different(Y, Z, Dif3),
% now we join all these expressions with an and
Expr = *([P1,P3,P4,P5,P6, Dif1,Dif2, Dif3]),
% we ask Prolog to count the number of solutions
sat_count(Expr, N),
writeln(N : ' solution(s)'),
% we ask Prolog to satisfy the expr
sat(Expr),
maplist(writeln, [A, B, C, D]), nl,
maplist(writeln, [W, X, Y, Z]).
We get :
?- puzzle.
1: solution(s)
[0,0]
[0,1]
[1,0]
[1,1]
[1,0]
[0,1]
[0,0]
[1,1]
true.