Prolog: Remove circle from graph-like problem - prolog

I have the following prolog program where I want to go from position a to position d. We can do that by following the path: a->b->c->d. Another path is: a->b->c->b->c->d etc. How do we remove that 'circling' path? I tried to remove it by using 'not(member(from_to(X,_),Z))' but it doesn't seem to work.
from_to(a, b).
from_to(b, c).
from_to(c, d).
from_to(d, c).
from_to(c, b).
move(X,Y,Z) :- from_to(X,Y), X \= Y,
Z = [from_to(X,Y)].
move(X,Y,Z) :- from_to(X,K), K \= Y, move(K,Y,Z1),
Z = [from_to(X,K)|Z1],
not(member(from_to(X,_),Z)).
(if you remove the line 'not(member(from_to(X,_),Z))' the program works fine but outputs the circling paths)

It is better to use an accumulator here: a variable that you update through recursive calls, and thus contains some sort of "memory". Here the accumulator can store a list of nodes that we have visited. In order to move to a new node, that node should not be in the list.
So we define a predicate move/4 instead of move/3, with:
move(X,Y,Z) :-
move(X, Y, Z, [X]).
Now we can define the predicate move(S, D, Path, Visited) by using two rules:
in case S and D are the same, we are done, regardless what Visited is, we unify Path with [D]; and
otherwise we "walk" to another node N through the from_to/2 predicate, ensure that it is not a member of Visited, then we make a recursive call where we prepend S to the N to the visited nodes. We prepend X to the result of the recursive Z.
Like for example:
move(S, S, [S], _).
move(S, D, [S|Z], Visited) :-
from_to(S, N),
\+ member(N, Visited),
move(N, D, Z, [N|Visited]).
For your sample graph:
it generates then:
?- move(a, d, Z).
Z = [a, b, c, d] ;
false.
?- move(a, D, Z).
D = a,
Z = [a] ;
D = b,
Z = [a, b] ;
D = c,
Z = [a, b, c] ;
D = d,
Z = [a, b, c, d] ;
false.
?- move(A, d, Z).
A = d,
Z = [d] ;
A = a,
Z = [a, b, c, d] ;
A = b,
Z = [b, c, d] ;
A = c,
Z = [c, d] ;
false.
?- move(A, D, Z).
A = D,
Z = [D] ;
A = a,
D = b,
Z = [a, b] ;
A = a,
D = c,
Z = [a, b, c] ;
A = a,
D = d,
Z = [a, b, c, d] ;
A = b,
D = c,
Z = [b, c] ;
A = b,
D = d,
Z = [b, c, d] ;
A = c,
D = d,
Z = [c, d] ;
A = d,
D = c,
Z = [d, c] ;
A = d,
D = b,
Z = [d, c, b] ;
A = c,
D = b,
Z = [c, b] ;
false.
In case a node is not "connected to itself" as in that we have not a path from a to a for example, we can implement move as:
move(S, D, [S|Z], V) :-
from_to(S, N),
\+ member(N, V),
move2(N, D, Z, [N|V]).
move2(S, S, [S], _).
move2(N, D, [S|Z], V) :-
move(N, D, Z, V).

Related

Why are solutions in the wrong order?

I have been asked to
define a predicate subseq/2, with signature subseq(-,+),
which is true when both its arguments are lists, and its first
argument can be constructed by removing zero or more elements
from its second argument.
... with intended solution order:
?- subseq(X, [a, b, c]).
X = [a, b, c] ;
X = [a, b] ;
X = [a, c] ;
X = [a] ;
X = [b, c] ;
X = [b] ;
X = [c] ;
X = [].
My code:
subseq([], []).
subseq([], [_|_]).
subseq([X|XS], [X|YS]) :- subseq(XS, YS).
subseq([X|XS], [_|YS]) :- subseq([X|XS], YS).
My code's solution order:
?- subseq(X, [a, b, c]).
X = []
X = [a]
X = [a, b]
X = [a, b, c]
X = [a, c]
X = [b]
X = [b, c]
X = [c] ;
false.
How do I achieve the intended solution order?
In Prolog, the order of the rules is crucial. To get the desired output, simply change the order of the rules, like this:
subseq([X|XS], [X|YS]) :- subseq(XS, YS).
subseq([X|XS], [_|YS]) :- subseq([X|XS], YS).
subseq([], []).
subseq([], [_|_]).
?- subseq(X,[a,b,c]).
X = [a, b, c]
X = [a, b]
X = [a, c]
X = [a]
X = [b, c]
X = [b]
X = [c]
X = []
Little tweaks can change the order:
sub_list_forwards(Sub, Long) :-
sub_list_forwards_(Long, Sub).
sub_list_forwards_([], []).
% Either pick H, or don't
sub_list_forwards_([H|T], S) :-
(S = Sub ; S = [H|Sub]),
sub_list_forwards_(T, Sub).
Result in swi-prolog:
?- sub_list_forwards(S, [a,b,c]).
S = [] ;
S = [c] ;
S = [b] ;
S = [b, c] ;
S = [a] ;
S = [a, c] ;
S = [a, b] ;
S = [a, b, c].
Or tweak the selection line to be:
(S = [H|Sub] ; S = Sub),
... which results in the order you were given:
?- sub_list_forwards(S, [a,b,c]).
S = [a, b, c] ;
S = [a, b] ;
S = [a, c] ;
S = [a] ;
S = [b, c] ;
S = [b] ;
S = [c] ;
S = [].
Note that neither of these leave an unwanted choicepoint at the end, because they use first-argument indexing on [] vs [H|T] with 1 selection each.
Does the order matter? What would be an optimum order? It probably varies.
In general it is best to put the base case (i.e. [], []) first, for flexibility (and because they sometimes contain a cut).
This is programming, rather than mathematics, so meaningful variable names/initials are far better for readability than using the likes of X and Y continually.
Using (S = [H|Sub] ; S = Sub), produces the sensible:
?- nth1(5, L, e), sub_list_forwards([a,b,c], L).
L = [a, b, c, _, e] ;
L = [a, b, c, _, e, _] ;
L = [a, b, c, _, e, _, _] ;
L = [a, b, c, _, e, _, _, _] ;
... rather than a stack overflow, and so is preferable.

A Prolog program for permutation parity

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.

Finding all possible paths in a graph without cycle

I'm trying to write a Prolog program to give me all possible paths between two points in a graph (with cycle).
edge(a,b).
edge(a,c).
edge(a,d).
edge(b,e).
edge(c,e).
edge(c,f).
edge(d,f).
edge(f,g).
edge(g,e).
edge(e,a).
show_path(X,Y,[X,Y]) :- edge(X,Y).
show_path(X,Z,[X|T]) :- edge(X,Y), not(member(Y, T)), show_path(Y,Z,T).
I'm trying to use not(member()) to exclude the cycles and avoid infinite loop but it doesn't yield all possible solutions. How can I alter the program to get the all possible paths between two points in a graph with cycle?
Your program does not work because not(member(Y, T)) will always be false: at this point, T is not instantiated so it's always possible to find a list which contains Y.
You can fix your program by adding an accumulator:
show_path(X,X,T,P) :- reverse([X|T],P).
show_path(X,Z,T,P) :- edge(X,Y), not(member(X,T)), show_path(Y,Z,[X|T],P).
show_path(X,Y,P) :- show_path(X,Y,[],P).
It's not clear what you mean by avoiding cycles. Here, it will avoid passing twice on the same point, unlike #coder's answer. For example:
?- show_path(a,e,Z).
Z = [a, b, e] ;
Z = [a, c, e] ;
Z = [a, c, f, g, e] ;
Z = [a, d, f, g, e] ;
false.
You can easily see that not(member(Y, T)) fails when T is not instantiated. For example try:
?- not(member(X,L)).
false.
where you see that it fails. To solve that you need to keep an extra list that will be instantiated in every step beginning with empty list:
show_path(X,Y,R):-show_path(X,Y,[],R).
show_path(X,Y,_,[X,Y]) :- edge(X,Y).
show_path(X,Y,L,[X|R]) :- edge(X,Z),\+member(Z,L),
show_path(Z,Y,[Z|L],R).
Example:
?- show_path(a,e,L).
L = [a, b, e] ;
L = [a, b, e, a, c, e] ;
L = [a, b, e, a, c, f, g, e] ;
L = [a, b, e, a, d, f, g, e] ;
L = [a, c, e] ;
L = [a, c, e, a, b, e] ;
L = [a, c, e, a, d, f, g, e] ;
L = [a, c, f, g, e] ;
L = [a, c, f, g, e, a, b, e] ;
L = [a, d, f, g, e] ;
L = [a, d, f, g, e, a, b, e] ;
L = [a, d, f, g, e, a, c, e] ;
false.
You could have the output that #Fatalize suggested also by writing:
show_path(X,Y,[X,Y]) :- edge(X,Y).
show_path(X,Y,R) :- edge(X,Z), show_path(Z,Y,RZ),R=[X|RZ],
sort(R,R1),length(R,N),length(R1,N1),
(N>N1->!,fail ;true).
Example:
?- show_path(a,e,L).
L = [a, b, e] ;
L = [a, c, e] ;
L = [a, c, f, g, e] ;
L = [a, d, f, g, e] ;
false.

All simple paths from a vertex to all other reachable nodes

I am completely new to Prolog and was looking into graphs. I found a problem online that asks me to specify a node and then list all simple paths reachable from that node. There is no goal node, just try all possibilities and return all those paths.
I represented the graph as path(X, Y), symbolizing a directed edge from X to Y.
I built this simple knowledge base which is cyclical:
path(a, b).
path(b, c).
path(c, d).
path(d, a).
path(d, e).
path(d, f).
path(f, g).
If I query all_paths(a, P), then P should be(assuming ; is spammed until all options exhausted).
P = [a].
P = [a, b].
P = [a, b, c].
P = [a, b, c, d].
P = [a, b, c, d, e].
P = [a, b, c, d, f].
P = [a, b, c, d, f, g].
I wrote something like that as a starter:
all_paths(Source, P) :- all_paths(Source, P, []).
all_paths(_, [], _).
all_paths(Source, [Source | P], Visited) :-
path(Source, Node),
\+ memberchk(Node, Visited),
all_paths(Node, P, [Node | Visited]).
Ok, changed it a bit, now I get back:
X = [] ? ;
X = [a] ? ;
X = [a,b] ? ;
X = [a,b,c] ? ;
X = [a,b,c,d] ? ; <- Here it does not pick up e
X = [a,b,c,d] ? ;
X = [a,b,c,d] ? ;
X = [a,b,c,d,f] ? ;
Can someone help in figuring out how to get all paths correctly?
No need to reinvent the wheel!
First, we rename your predicate path/2 to edge/2:
edge(a, b).
edge(b, c).
edge(c, d).
edge(d, a).
edge(d, e).
edge(d, f).
edge(f, g).
Then, we use meta-predicate path/4 in combination with edge/2:
?- path(edge,Path,From,To).
Path = [To], From = To
; Path = [a,b], From = a, To = b
; Path = [a,b,c], From = a, To = c
; Path = [a,b,c,d], From = a, To = d
; Path = [a,b,c,d,e], From = a, To = e
; Path = [a,b,c,d,f], From = a, To = f
; Path = [a,b,c,d,f,g], From = a, To = g
; Path = [b,c], From = b, To = c
; Path = [b,c,d], From = b, To = d
; Path = [b,c,d,a], From = b, To = a
; Path = [b,c,d,e], From = b, To = e
; Path = [b,c,d,f], From = b, To = f
; Path = [b,c,d,f,g], From = b, To = g
; Path = [c,d], From = c, To = d
; Path = [c,d,a], From = c, To = a
; Path = [c,d,a,b], From = c, To = b
; Path = [c,d,e], From = c, To = e
; Path = [c,d,f], From = c, To = f
; Path = [c,d,f,g], From = c, To = g
; Path = [d,a], From = d, To = a
; Path = [d,a,b], From = d, To = b
; Path = [d,a,b,c], From = d, To = c
; Path = [d,e], From = d, To = e
; Path = [d,f], From = d, To = f
; Path = [d,f,g], From = d, To = g
; Path = [f,g], From = f, To = g
; false.
Edit
If we are only interested in the paths starting at a, we simply write:
?- path(edge,Path,a,To).
Path = [a], To = a
; Path = [a, b], To = b
; Path = [a, b, c], To = c
; Path = [a, b, c, d], To = d
; Path = [a, b, c, d, e], To = e
; Path = [a, b, c, d, f], To = f
; Path = [a, b, c, d, f, g], To = g
; false.
'swapping' Node and Source
all_paths(_, [], _).
all_paths(Source, [Node | P], Visited) :-
path(Source, Node),
\+ memberchk(Node, Visited),
all_paths(Node, P, [Source | Visited]).
yields
?- all_paths(a, P).
P = [] ;
P = [b] ;
P = [b, c] ;
P = [b, c, d] ;
P = [b, c, d, e] ;
P = [b, c, d, f] ;
P = [b, c, d, f, g] ;
false.
it's missing the start node, that I would simply add in the 'driver' predicate:
all_paths(Source, [Source|P]) :- all_paths(Source, P, []).
yields
?- all_paths(a, P).
P = [a] ;
P = [a, b] ;
P = [a, b, c] ;
P = [a, b, c, d] ;
P = [a, b, c, d, e] ;
P = [a, b, c, d, f] ;
P = [a, b, c, d, f, g] ;
false.
a style note: the code is more readable if we follow some rule about IO arguments. Output arguments should go after input ones. Well, this is not always applicable...

using prolog to generate sentences

Consider the following list of states:
[Sin,S2,S3,...,Sout]
and following rules:
it is possible to go back from S(n) to S(n-1) if there is such
S(n-1)
it is not possible to go back from S(out)
a sentence always begins with S(in) and ends with S(out)
I would like to have a rule that could be activated like this:
?- sentence(X, backs)
in which 'backs' means how many times a "back" is allowed.
For this list [a,b,c,d]
?- sentence(x, 2)
would generate:
[a,b,c,d] %no backs
[a,b,a,b,c,d] %one back
[a,b,c,b,c,d] %from d we cannot go back
[a,b,a,b,c,b,c,d] %two backs
[a,b,c,b,a,b,c,d] %two backs
Here's something that seems to be working:
sentence( [A|B], N, [A|X]) :- B=[_|_] -> sentence(B,[A],N,X)
; B = X.
sentence( B, _, 0, B). % no more moves back left
sentence( [B,C], _, N, [B,C]):- N>0. % no going back from end node
sentence( [B|C], A, N, [B|X]):- N>0, C=[_|_],
sentence( C, [B|A], N, X). $ fore
sentence( [B|C], [A|D], N, [B|X]):- N>0, C=[_|_], N1 is N-1,
sentence( [A,B|C], D, N1, X). $ aft
Running it gives me
23 ?- sentence([a,b,c,d],2,X).
X = [a, b, c, d] ;
X = [a, b, c, b, c, d] ;
X = [a, b, c, b, c, b, c, d] ;
X = [a, b, c, b, a, b, c, d] ;
X = [a, b, a, b, c, d] ;
X = [a, b, a, b, c, b, c, d] ;
X = [a, b, a, b, a, b, c, d] ;
No

Resources