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...
Related
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.
I've been trying to write a simple code, that would behave in this manner:
| ?- hasCoppiesOf(X,[a,b,a,b,a,b,a,b]).
X = [a,b] ? ;
X = [a,b,a,b] ? ;
X = [a,b,a,b,a,b,a,b] ? ;
And
| ?- hasCoppiesOf([a,b,a,b,a,b,a,b], X).
X = [] ? ;
X = [a,b,a,b,a,b,a,b] ? ;
X = [a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b] ? ;
X = ...
This desire resulted in next piece of code:
hasCoppiesOf(A,[]).
hasCoppiesOf([H1|T1], [H1|T2]) :-
append(T1, [H1], X),
hasCoppiesOf([H1|T1], X, T2).
hasCoppiesOf(A, A, B) :-
hasCoppiesOf(A, B).
hasCoppiesOf(A, [H1|T1], [H1|T2]) :-
append(T1, [H1], X),
hasCoppiesOf(A, X, T2).
And it gives me what I want on the second query, however, the first results in:
?- hasCoppiesOf(X,[a,b,a,b,a,b,a,b]).
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b] ;
X = [a, b, a, b, a, b] ;
X = [a, b, a, b, a, b] ;
X = [a, b, a, b, a, b] ;
X = [a, b, a, b, a, b] ;
X = [a, b, a, b, a, b] ;
It seems to be working fine, but that repetition of the same answers bothers me. It's, probably, a simple mistake, but is there a way to make the output prettier?
And honestly, that a mystery, why Prolog treats two identical arrays as different answers.
Or maybe it's just something wrong with my system?
Edit:
The gentle guidance of the person in the comments helped me to solve this issue. However, if this question will be reading the person who wants to solve exactly the same problem - code not really working well, my apologies.
I think you just made your predicate more complex than it needs to be, probably just overthinking it. A given solution may succeed in multiple paths through the logic.
You can do this without append/3 by aligning the front end of the lists and keep the original list to "reset" on repeats:
% Empty list base cases
dups_list([], []).
dups_list([_|_], []).
% Main predicate, calling aux predicate
dups_list(L, Ls) :-
dups_list(L, L, Ls).
% Recursive auxiliary predicate
dups_list([], [_|_], []).
dups_list([], [X|Xs], [X|Ls]) :-
dups_list(Xs, [X|Xs], Ls).
dups_list([X|Xs], L, [X|Ls]) :-
dups_list(Xs, L, Ls).
Here are some results:
| ?- dups_list(X,[a,b,a,b,a,b,a,b]).
X = [a,b] ? a
X = [a,b,a,b]
X = [a,b,a,b,a,b,a,b]
no
| ?- dups_list([a,b,a,b,a,b,a,b], X).
X = [] ? ;
X = [a,b,a,b,a,b,a,b] ? ;
X = [a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b] ? ;
X = [a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b,a,b] ?
...
| ?- dups_list(A, B).
A = []
B = [] ? ;
A = [_|_]
B = [] ? ;
A = [C]
B = [C] ? ;
A = [C]
B = [C,C] ? ;
A = [C,D]
B = [C,D] ? ;
A = [C]
B = [C,C,C] ? ;
A = [C,D,E]
B = [C,D,E] ? ;
...
There may be a way to simplify the solution just a bit more, but I haven't played with it enough to determine if that's the case.
I think this is what you're trying for...
coppies(Z,Z,[]).
coppies(X,Z,[Y|Ys]):- \+member(Y,Z),coppies(X,[Y|Z],Ys).
coppies(X,Z,[Y|Ys]):- member(Y,Z),coppies(X,Z,Ys).
copies(M,[Y|Ys]):-coppies(M,[],[Y|Ys]).
Input:
copies(X,[1,2,1,2,1,2]).
Output:
X = [2, 1].
BTW I've used some different names instead..
Okay, I got your problem, you want to eliminate the repetitions.
hasCoppiesOf(A,[]).
hasCoppiesOf([H1|T1], [H1|T2]) :-
append(T1, [H1], X),
hasCoppiesOf([H1|T1], X, T2).
hasCoppiesOf(A, A, B) :-
hasCoppiesOf(A, B),!. %Change here, place a cut after the termination.
hasCoppiesOf(A, [H1|T1], [H1|T2]) :-
append(T1, [H1], X),
hasCoppiesOf(A, X, T2).
This is the change that you need to make.
hasCoppiesOf(A, A, B) :-
hasCoppiesOf(A, B),!.
A Cut '!' terminates the unwanted backtracking and thereby repetitions.
I Have an automaton.
The question here is: how to find at least one word of even length accepted by my given finite automaton?
states /* states(Q) <=> Q is the list of automata's states */
symbols /* symbols(Sigma) <=> Sigma is the list of automata's input symbols */
transition /* transition(X, A, Y) <=> δ(X, A)=Y */
startState /* startState(S) <=> S is the start state of automata */
finalStates /* finalStates(F) <=> F is the list of automata's final states */
states([q0, q1, q2]).
symbols([a, b]).
transition(q0, a, q1).
transition(q0, b, q2).
transition(q1, a, q2).
transition(q1, b, q0).
transition(q2, a, q1).
transition(q2, b, q2).
startState(q0).
finalStates([q2]).
It looks like you have successfully encoded your automaton in Prolog. What you are actually missing is the code to execute it. So let's think about what's needed to do that. First, we need to kick off the execution by passing the input to something to run it. That first thing will find the start state and use that. Then we'll run a loop, finding the transition for this state and the next input value and next state. If we run out of input and are in a final state, then we have succeeded. So it seems like the only thing special about the first call is that it looks up the initial state.
In true inductive fashion, let's write the termination condition first.
step(State, []) :- finalStates(FinalStates), memberchk(State, FinalStates).
This simply says that if we try to perform a step when we're out of input, the state we were in is in the list of final states. Now let's try to run a step that is not the final step. We'll recursively call step/2 to implement a loop.
step(State, [Sym|Tape]) :-
transition(State, Sym, NextState),
step(NextState, Tape),
!.
This simply peels off the next symbol on the tape and finds the right next state based on it, and recurs. I have added the cut here to prevent it from attempting to find other transitions; if you were building an NFA you might want to remove that. Now what we are missing is the initial driver, which I'll just call evaluate:
evaluate(Tape) :-
startState(Start),
step(Start, Tape).
Let's try this out on a few inputs:
?- evaluate([a,a,a,a]).
true.
This succeeded because it transitioned from q0 -> q1 -> q2 -> q1 -> q2 and q2 is a final state.
?- evaluate([a,a,a]).
false.
This failed because it transitioned from q0 -> q1 -> q2 -> q1 and q1 is not a final state.
Now on to finding strings that match. We can generate them quite easily since we have the set of symbols on-hand; let's make a little helper predicate:
symbol(X) :- symbols(Symbols), member(X, Symbols).
This is something we can use easily with maplist/2 to generate sample inputs:
?- length(L, 3), maplist(symbol, L).
L = [a, a, a] ;
L = [a, a, b] ;
L = [a, b, a] ;
L = [a, b, b] ;
L = [b, a, a] ;
L = [b, a, b] ;
L = [b, b, a] ;
L = [b, b, b].
Now you can do a classic generate-and-test thing with Prolog:
?- length(L, 3), maplist(symbol, L), evaluate(L).
L = [a, a, b] ;
L = [a, b, b] ;
L = [b, a, a] ;
L = [b, b, b].
To find an even list of symbols that works, make a helper for finding evens and we'll use between/3 to generate lists of those lengths and then do the same kind of thing:
even(X) :- 0 is X mod 2.
Trying:
?- between(1,100,X), even(X).
X = 2 ;
X = 4 ;
X = 6 ;
X = 8 .
?- between(1,100,X), even(X), length(L, X).
X = 2,
L = [_2954, _2960] ;
X = 4,
L = [_2954, _2960, _2966, _2972] ;
X = 6,
L = [_2954, _2960, _2966, _2972, _2978, _2984] .
?- between(1,100,X), even(X), length(L, X), maplist(symbol, L).
X = 2,
L = [a, a] ;
X = 2,
L = [a, b] ;
X = 2,
L = [b, a] ;
X = 2,
L = [b, b] ;
X = 4,
L = [a, a, a, a] ;
X = 4,
L = [a, a, a, b] ;
X = 4,
L = [a, a, b, a] ;
X = 4,
L = [a, a, b, b] ;
X = 4,
L = [a, b, a, a] ;
X = 4,
L = [a, b, a, b] ;
X = 4,
L = [a, b, b, a] ;
X = 4,
L = [a, b, b, b] ;
X = 4,
L = [b, a, a, a] .
?- between(1,100,X), even(X), length(L, X), maplist(symbol, L), evaluate(L).
X = 2,
L = [a, a] ;
X = 2,
L = [b, b] ;
X = 4,
L = [a, a, a, a] ;
X = 4,
L = [a, a, b, b] ;
X = 4,
L = [a, b, a, a] ;
X = 4,
L = [a, b, b, b] ;
X = 4,
L = [b, a, a, b] ;
X = 4,
L = [b, a, b, b] ;
X = 4,
L = [b, b, a, a] ;
X = 4,
L = [b, b, b, b] ;
X = 6,
L = [a, a, a, a, a, a]
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).
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.