Simplified Travelling Salesman in Prolog - prolog

I've looked through the similar questions but can't find anything that's relevant to my problem. I'm struggling to find an algorithm or set of 'loops' that will find a path from CityA to CityB, using a database of
distance(City1,City2,Distance)
facts. What I've managed to do so far is below, but it always backtracks at write(X), and then completes with the final iteration, which is what I want it to do but only to a certain extent.
For example, I don't want it to print out any city names that are dead ends, or to use the final iteration. I want it to basically make a path from CityA to CityB, writing the name of the cities it goes to on the path.
I hope somebody can help me!
all_possible_paths(CityA, CityB) :-
write(CityA),
nl,
loop_process(CityA, CityB).
loop_process(CityA, CityB) :-
CityA == CityB.
loop_process(CityA, CityB) :-
CityA \== CityB,
distance(CityA, X, _),
write(X),
nl,
loop_process(X, CityB).

I tried to demonstrate how you can achieve what you're working on so that you can understand better how it works. So since your OP wasn't very complete, I took some liberties ! Here are the facts I'm working with :
road(birmingham,bristol, 9).
road(london,birmingham, 3).
road(london,bristol, 6).
road(london,plymouth, 5).
road(plymouth,london, 5).
road(portsmouth,london, 4).
road(portsmouth,plymouth, 8).
Here is the predicate we will call to find our paths, get_road/4. It basically calls the working predicate, that has two accumulators (one for the points already visited and one for the distance we went through).
get_road(Start, End, Visited, Result) :-
get_road(Start, End, [Start], 0, Visited, Result).
Here is the working predicate,
get_road/6 : get_road(+Start, +End, +Waypoints, +DistanceAcc, -Visited, -TotalDistance) :
The first clause tells that if there is a road between our first point and our last point, we can end here.
get_road(Start, End, Waypoints, DistanceAcc, Visited, TotalDistance) :-
road(Start, End, Distance),
reverse([End|Waypoints], Visited),
TotalDistance is DistanceAcc + Distance.
The second clause tells that if there is a road between our first point and an intermediate point, we can take it and then solve get_road(intermediate, end).
get_road(Start, End, Waypoints, DistanceAcc, Visited, TotalDistance) :-
road(Start, Waypoint, Distance),
\+ member(Waypoint, Waypoints),
NewDistanceAcc is DistanceAcc + Distance,
get_road(Waypoint, End, [Waypoint|Waypoints], NewDistanceAcc, Visited, TotalDistance).
Usage is as follows :
?- get_road(portsmouth, plymouth, Visited, Distance).
And yields :
Visited = [portsmouth, plymouth],
Distance = 8 ;
Visited = [portsmouth, london, plymouth],
Distance = 9 ;
Visited = [portsmouth, plymouth, london, plymouth],
Distance = 18 ;
false.
I hope it will be helpful to you.

Please separate the pure part from the impure (I/O, like write/1, nl/0 but also (==)/2 and (\==)/2). As long as they are entirely interlaced with your pure code you cannot expect much.
Probably you want a relation between a starting point, an end point and a path in between.
Should that path be acyclic or do you permit cycles?
To ensure that an element X does not occur in a list Xs use the goal maplist(dif(X),Xs).
You do not need any further auxiliary predicates to make this a nice relation!

You should return a successful list as an Out variable in all_possible_paths. Then write out that list. Don't do both in the same procedure.

Related

swi-ProLog Finding all possible starting nodes which can arrive specific ending node

I am new to logic programming. I am trying to write a program which can find all nodes which can reach to an specific node.
Here is my code:
link(0, 1).
link(3, 4).
link(1, 2).
link(2, 0).
link(2, 1).
link(3, 2).
link(4, 3).
So show above by graph, it should look like below:
I want to do something like this:
?- go(X,0).
X=1;
X=2;
X=3;
X=4;
....
Which mean that from all 1,2,3 and 4 can go to 0.
[1->2->0],[2->0],[3->2->0],[4->3->2->0]...
so I try
go(X,Y) :- link(X,Y).
go(X,Y) :- link(X,Z),go(Z,Y).
?- go(X,0).
X=2;
X=0;
X=0;
X=0;
X=0;
....
but i don't want 0 as one of the output, it is meaningless to show I can go to 0 when I am already in 0. Also, it keeps repeating.
I try to fix this problem by:
go(X,Y) :- link(X,Y).
go(X,Y) :- (X\==Y),link(X,Z),go(Z,Y).
?- go(X,0).
X = 2 ;
false.
I'm not sure why it will stop at X=2. I try to draw the ProLog search tree and i still don't know why my code wont continue go for other facts(link(3,4)). Seem it stop at some point and no keep going for the green part below:
I try to test it using go(1,0). to go(4,0).
go(1,0) and go(2,0) success
But go(3,0) and go(4,0) return Error: Stack limit. I found that the recursion keep going and going between node 3 and 4. But I don't really know how to solve it.
I am so confused now, please tell me what is my mistake, or how to implement this function in a correct way? Thank you.
The problem is that your graph is a cyclic, rather than acyclic graph. That means that starting from some node X, you [eventually] will return to X.
That means that (for starters) unless you handle the cycles somehow, you will be stuck in an endless recursive loop (until you run out of stack space).
As you traverse the graph, you need to maintain some extra state (a list of nodes that you have already visited). To do this in Prolog, it is a common idiom to use a helper predicate, with the same name but additional arguments that carry the extra state.
So, try something like this:
% the public predicate. We seed the visited list here
% with our starting node.
%
% Not to worry if it is an unbound
% variable. It will become bound/unbound as necessary.
traverse(A,B) :- traverse(A,B,[A]).
traverse(A,B,V) :- % We can get from A to B, if...
link(A,B), % - A and B are directly connected, and
\+ member(B,V) % - we haven't already visited B
. % - easy!
traverse(A,B,V) :- % Otherwise, we can get from A to B, if...
link(A,X), % - we can get to some intermediate node X,
\+ member(X,V) % - that we have not yet visited, and
traverse(X,B,[X|V]) % - we can get from X to B (adding X to the visited list
.

Run Dijkstra among all the pair of cities as (source, destination) and store the distances as facts

I have a data given in the form of an adjacency matrix signifying the edges, out of which I was able to create a edges.pl file containing all the edges between the cities. For reference see the image,
In the edges.pl file I have facts of the form edge(agartala, ahmedabad, 3305), edge(ahmedabad, agartala, 3305) to create a bidirectional graph.
There are 47 cities in total.
Now I want to create another file, where I want to create facts that give shortest distance between each pair of cities. That is, something like a 47x47 matrix where each city on row is a source and each city on column is a destination.
Basically, I want to implement loops so that I can run Dijkstra on each pair of cities and store dynamic facts like,
distance(city1, city2, shortest_distance).
I don't understand how to run these nested loops on these cities.
Since you want to find the shortest paths for all pairs of cities, isn't the Floyd-Warshall algorithm what you should be using instead of Dijkstra's? I will use Floyd-Warshall in this answer. What both algorithms have in common is that they need to make updates to some data structure. I will use the Prolog database for this, since you want to assert some dynamic facts anyway. However, the solution will be very "non-logical".
I will be using the following input graph from the Floyd-Warshall Wikipedia page:
node(1).
node(2).
node(3).
node(4).
edge(1, 3, -2).
edge(2, 1, 4).
edge(2, 3, 3).
edge(3, 4, 2).
edge(4, 2, -1).
As a commenter mentioned, a technique you can use here are failure-driven loops.
Here is what a failure-driven loop looks like:
visit_each_node :-
node(Node),
fail.
This doesn't seem to do anything:
?- visit_each_node.
false.
And indeed, logically it just fails. But procedurally it visits each node, it just doesn't do anything with it.
You can do things inside failure-driven loops, but only non-logical things like I/O, or modifications of the Prolog database. For example:
print_each_node :-
node(Node),
write('visiting '),
write(Node),
nl,
fail.
This will visit a node, print it, and come to the failure. The failure will force it to backtrack to find another node and print it. Then it will fail again, find another node, and so on, until all nodes have been visited, and finally the query fails:
?- print_each_node.
visiting 1
visiting 2
visiting 3
visiting 4
false.
We will usually want our loops to do something and then succeed. For this, we can just add another clause that succeeds:
print_each_node_and_succeed :-
node(Node),
write('visiting '),
write(Node),
nl,
fail.
print_each_node_and_succeed :-
% when we get here, all nodes have been visited
true.
This will do all of what I described above. Then, after the first clause has definitely failed, it will execute the second clause and will succeed:
?- print_each_node_and_succeed.
visiting 1
visiting 2
visiting 3
visiting 4
true.
In general, a failure-driven loop will consist of: (a) some goals that generate some data, (b) some goals that consume that data non-logically, (c) a fail, all in one clause, and (d) a second clause that succeeds:
generic_loop :-
% generate
some_x(X),
some_y(Y),
% consume
do_something_non_logical_with_x_and_y(X, Y),
% loop back
fail.
generic_loop :-
% nothing more to do
true.
Now, for the Floyd-Warshall algorithm. We'll populate the following dynamic predicate, using from_to_set_distance to encapsulate removing any old stored distance between two cities and storing a new one:
:- dynamic from_to_distance/3.
from_to_set_distance(From, To, Distance) :-
retractall(from_to_distance(From, To, _OldDistance)),
asserta(from_to_distance(From, To, Distance)).
The first step of the algorithm is to initialize all distances from given edges. This must visit all pairs of cities and do something non-logical, namely, update the Prolog database. A job for a failure-driven loop!
initialize_distances :-
retractall(from_to_distance(_From, _To, _Distance)),
node(U),
node(V),
( U = V
-> from_to_set_distance(U, U, 0)
; edge(U, V, Distance)
-> from_to_set_distance(U, V, Distance)
; Infinity = 999999,
from_to_set_distance(U, V, Infinity) ),
% failure-driven loop
fail.
initialize_distances :-
% when we get here, all pairs of nodes have been initialized
true.
The second step is to visit all triples of cities and do something non-logical: Update the stored distance if we found a shorter path than the one we had stored before. Again, a job for a failure-driven loop!
compute_pairwise_distances :-
node(K),
node(I),
node(J),
from_to_distance(I, J, DistIJ),
from_to_distance(I, K, DistIK),
from_to_distance(K, J, DistKJ),
( DistIJ > DistIK + DistKJ
-> DistIKJ is DistIK + DistKJ,
from_to_set_distance(I, J, DistIKJ)
; % nothing to do
true ),
% failure-driven loop
fail.
compute_pairwise_distances :-
% when we get here, all triples of nodes have been visited and all
% pairwise distances computed
true.
The entire Floyd-Warshall algorithm first does the initialization, then the computation of all pairwise distances:
floyd_warshall :-
initialize_distances,
compute_pairwise_distances.
When we run this, it will not produce anything visible:
?- floyd_warshall.
true.
But the database will have been updated. To see all the stored distances, we can visit all of them and do something non-logical, namely, print them. A job for... you guessed it: a failure-driven loop!
?- from_to_distance(From, To, Distance), write(from_to_distance(From, To, Distance)), nl, fail.
from_to_distance(3,2,1)
from_to_distance(3,1,5)
from_to_distance(1,2,-1)
from_to_distance(2,4,4)
from_to_distance(1,4,0)
from_to_distance(4,3,1)
from_to_distance(4,1,3)
from_to_distance(2,3,2)
from_to_distance(4,4,0)
from_to_distance(4,2,-1)
from_to_distance(3,4,2)
from_to_distance(3,3,0)
from_to_distance(2,2,0)
from_to_distance(2,1,4)
from_to_distance(1,3,-2)
from_to_distance(1,1,0)
false.

Solving Tower of Hanoi declaratively (Prolog)

My professor gave this as an example of Prolog. It is a program that solves the Tower of Hanoi puzzle, where you have to move a stack of disks to another peg by moving one disk after the other, without putting a bigger disk on top of a smaller disk.
Now, I don't like that program. I was told Prolog was meant for declarative programming. I don't want to program how to solve the problem, I want to write down using Prolog what the problem is. Then let Prolog solve it.
My effort so far can be found below. There are two types of lists I employ, a sequence of actions is represented like this: [[1,2],[3,1]]; this would be "move the top disk from peg 1 to peg 2, move the disk from peg 3 to peg 1". My second type of list is a state, for example, if there are three pegs [[1,2,3], [], []] would mean that there are three disks on the first peg. Smaller disks have smaller numbers, so the front of the inner list is the top of a stack.
% A sequence of actions (first argument) is a solution if it leads
% from the begin state (second argument) to the End state (third argument).
solution([], X, X).
solution([[FromIdx | ToIdx] | T], Begin, End) :-
moved(FromIdx, ToIdx, Begin, X),
solution(T, X, End).
% moved is true when Result is the resulting state after moving
% a disk from FromIdx to ToIdx starting at state Start
moved(FromIdx, ToIdx, Start, Result) :-
allowedMove(FromIdx, ToIdx, Start),
nth1(FromIdx, Start, [Disk|OtherDisks]),
nth1(ToIdx, Start, ToStack),
nth1(FromIdx, Result, OtherDisks),
nth1(ToIdx, Result, [Disk|ToStack]).
allowedMove(FromIdx, ToIdx, State) :-
number(FromIdx), number(ToIdx),
nth1(FromIdx, State, [FromDisk|_]),
nth1(ToIdx, State, [ToDisk|_]),
ToDisk > FromDisk.
allowedMove(_, ToIdx, State) :- nth1(ToIdx, State, []).
The above program seems to work, but it is too slow for everything reasonably complex. Asking it to solve the classic Tower of Hanoi problem, moving three disks from the first peg to the third and last, would go like this:
?- solution(Seq, [[1,2,3], [], []], [[], [], [1,2,3]]).
I would like to make some modifications to the program so that it works for this query. How would I go about doing that? When profiling I can see that nth1 uses a lot of time, should I get rid of it? Something that bothers me is that moved is completely deterministic and should only have one result. How can I speed up this bottleneck?
The Prolog solution to Hanoi one typically finds looks something like this. The solution writes the moves out to the screen as it encounters them and doesn't collect the moves in a list:
move_one(P1, P2) :-
format("Move disk from ~k to ~k", [P1, P2]), nl.
move(1, P1, P2, _) :-
move_one(P1, P2).
move(N, P1, P2, P3) :-
N > 1,
N1 is N - 1,
move(N1, P1, P3, P2),
move(1, P1, P2, P3),
move(N1, P3, P2, P1).
hanoi(N) :-
move(N, left, center, right).
This could be modified to collect the moves in a list instead by adding a list argument throughout and using append/3:
move(0, _, _, _, []).
move(N, P1, P2, P3, Moves) :-
N > 0,
N1 is N - 1,
move(N1, P1, P3, P2, M1),
append(M1, [P1-to-P2], M2),
move(N1, P3, P2, P1, M3),
append(M2, M3, Moves).
hanoi(N, Moves) :-
move(N, left, center, right, Moves).
We were able to make the base case simpler without the write. The append/3 does the job, but it's a bit clunky. Also, the is/2 in particular makes it non-relational.
By using a DCG and CLP(FD), the append/3 can be eliminated and it can be made more relational. Here's what I'd call an initial "naive" approach, and it is also more readable:
hanoi_dcg(N, Moves) :-
N in 0..1000,
phrase(move(N, left, center, right), Moves).
move(0, _, _, _) --> [].
move(N, P1, P2, P3) -->
{ N #> 0, N #= N1 + 1 },
move(N1, P1, P3, P2),
[P1-to-P2],
move(N1, P3, P2, P1).
This results in:
| ?- hanoi_dcg(3, Moves).
Moves = [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center] ? a
no
| ?- hanoi_dcg(N, [left-to-center,left-to-right,center-to-right,left-to-center,right-to-left,right-to-center,left-to-center]).
N = 3 ? ;
(205 ms) no
| ?-
Although it's relational, it does have a couple of issues:
Useless choice points in "both directions"
Termination issues unless constrained with something like N in 0..1000
I sense there's a way around these two issues, but haven't worked that out yet. (I'm sure if some smarter Prologers than I, such as #mat, #false, or #repeat see this, they'll have a good answer right off.)
I looked at your solution and here is some thought I had about it:
When you move, what you're doing is take from one tower and put on another.
There is a SWI-Predicate that replaces an element in a list, select/4. But you also want to have the index where you replaced it. so lets rewrite it a little, and call it switch_nth1, because it doesn't have to do much with select anymore.
% switch_nth1(Element, FromList, Replacement, ToList, Index1)
switch_nth1(Elem, [Elem|L], Repl, [Repl|L], 1).
switch_nth1(Elem, [A|B], D, [A|E], M) :-
switch_nth1(Elem, B, D, E, N),
M is N+1.
Since we're operating on List of Lists, we'll need two switch_nth1 calls: one to replace the Tower we take from, and one to put it on the new tower.
A move predicate could look like this (sorry I changed the arguments a little). (It should be called allowed_move because it doesn't do moves that aren't allowed).
move((FromX - ToX), BeginState, NewState):-
% take a disk from one tower
switch_nth1([Disk| FromTowerRest], BeginState, FromTowerRest, DiskMissing, FromX),
% put the disk on another tower.
switch_nth1(ToTower, DiskMissing, [Disk|ToTower], NewState, ToX),
% there are two ways how the ToTower can look like:
(ToTower = []; % it's empty
ToTower = [DiskBelow | _], % it already has some elements on it.
DiskBelow > Disk).
If you plug that into your solution you sadly run into some termination issues, since noone said that a state that already has been reached shouldn't be a right step on the way. Thus, we need to keep track where we already were and disallow continuation when a known state is reached.
solution(A,B,C):-solution_(A,B,C,[B]).
solution_([], X, X,_).
solution_([Move | R], BeginState, EndState, KnownStates):-
move(Move, BeginState, IntermediateState),
\+ memberchk(IntermediateState, KnownStates), % don't go further, we've been here.
solution_(R, IntermediateState, EndState, [IntermediateState | KnownStates]).
That said, this solution still is very imperative – there should be nicer solutions out there, where you really take advantage of recursion.
By "declarative" I'll assume you mean something close to the old slogan of "in Prolog, to write down a question is to have the answer to it". Let Prolog discover the answer instead of me just coding in Prolog the answer that I had to find out on my own.
Simply defining a legal_move predicate, stating the initial and final condition and running a standard search of whatever variety, leads to extremely very inefficient solution that will backtrack a whole lot.
Making a computer derive the efficient solution here seems a very hard problem to me. For us humans though, with just a little bit of thinking the solution is obvious, cutting away all the redundancy too, making any comparisons and checking the legality of positions completely unnecessary -- the solution is efficient and every move is legal by construction.
If we can move N = M + K disks, we can move M of them just the same - the other two pegs are empty, and we pretend the lower K disks aren't there.
But having moved the M disks, we're faced with the remaining K. Wherever the M disks went, we can't move any of the K there, because by construction the K disks are all "larger" than any of the M ("larger" simply because they were beneath them initially on the source peg).
But the third peg is empty. It is easy to move one disk there. Wouldn't it be just peachy if K were equal 1? Having moved the remaining K = 1 disk to the empty target peg, we again can pretend it isn't there (because it's the "largest") and move the M disks on top of it.
The vital addition: since M disks are to be moved to target in the second phase, initially they are to be moved into the spare.
This all means that if we knew how to move M disks, we could easily move M + 1. Induction, recursion, DONE!
If you knew all this already, apologies for the load of verbiage. The code:
hanoi(Disks, Moves):-
phrase( hanoi(Disks, [source,target,spare]), Moves).
hanoi( Disks, [S,T,R]) -->
{ append( M, [One], Disks) },
hanoi( M, [S,R,T]),
[ moving( One, from(S), to(T)) ],
hanoi( M, [R,T,S]).
hanoi( [], _) --> [ ].
Testing:
4 ?- hanoi([1,2,3], _X), maplist( writeln, _X).
moving(1,from(source),to(target))
moving(2,from(source),to(spare))
moving(1,from(target),to(spare))
moving(3,from(source),to(target))
moving(1,from(spare),to(source))
moving(2,from(spare),to(target))
moving(1,from(source),to(target)) ;
false.

Route goes infinite loop prolog

Just begin for prolog and have a practice for route question
train(a,b).
train(b,a).
train(b,c).
train(c,b).
route(X,Y,[]) :-
train(X,Y)
; train(Y,X).
route(X,Y,[H|T]) :-
route(X,H,[]),
route(H,Y,T).
by doing this route/3 The first rule give two direct connected places an empty set states that there is a route. Second rule states the case where there are intermediate places to reach from one to another. but when I query this and I got a loop route.
Someone said to have a helper predicate visited_route/4 to keep track of the places already visited, but don't know how this way works. Hints or example would be help.
The problem with your current solution is that the Prolog solver generates infinite tracks like [a,b,a,b,a,b,a...] never reaching the end.
You may want to do, is to exclude cases, where X, Y, or H is a member of T (this may be the visited_route/4 predicate). This way, you won't ever pass the same node twice.
Edit
I've sat down and freshened my Prolog knowledge a little bit, creating such code, which seems to work:
train(a,b).
%train(b,a). Your predicate is symmetric, you don't need to specify both directions
train(b,c).
%train(c,b).
train(c,d).
train(c,e).
train(d,f).
train(e,f).
visited_route(X, Y, [], V) :-
( train(X,Y) ; train(Y,X) ),
not(member(Y, V)).
visited_route(X, Y, [H | T], V) :-
visited_route(X, H, [], [X | V]),
visited_route(H, Y, T, [X | V]).
route(X,Y,R) :-
visited_route(X, Y, R, []).
Visited route has an additional list containing all nodes visited on a way from X to Y (not counting Y). When solver finds a way leading from X to Y in first visited_route predicate, it then checks if the route doesn't go through already visited node, and discards the candidate if so.

Prolog backtracks and loses all values

I have a few prolog predicates which calculate the cost of given cities. The process begins with a command like: best_route([std, lhr, bud, dse], 2013-5-5, X).
best_route(Cities, StartDate, Cost):-
begin_routing(Cities, StartDate, Cost, []).
begin_routing(Cities, StartDate, Cost, CostList):-
route(Cities, StartDate, CostList),
min_list(CostList, Cost).
route(Cities, StartDate, Costing):-
% stop if all cities have been covered once.
length(Cities, Stop),
length(Costing, Stop);
[Origin, Dest|_] = Cities,
flights(Origin, Dest, StartDate, Costing, Cities, [Cities, Origin, StartDate]).
Using the trace function in SWI-Prolog, I found that once the route predicate - length(Costing, Stop) is satisfied i.e., length of Costing List is equal to Stop. Prolog instead of stopping there, and proceeding with min_list(CostList, Cost), instead backtracks until CostLost loses all its values again. Once it finishes that, it goes to min_list when the list is [].
I am not sure why this might be happening. Any help is appreciated.
EDIT:
flights(..):-
% Code omitted.
get_next_date(OriginalDate, NextDate),
route(Cities, NextDate, [DayCost|Costing]).
% where DayCost is a simple integer calculated before this is added to the current Costing list
Towards the end, the last correct call is route([std, lhr, bud, dse], 2013-5-6, [329, 499, 323, 311]).
It seems that the intention of CostList is to record the costs of different routes and then to select the one with the smallest cost. However, you initialize CostList as [], and while the recursion is building CostList you do not provide means of communicating it back when the recursion returns. A possible solution would be to add a new argument FinalCostList that is being simply passed through the recursion until the termination clause. Alternatively, you can use difference lists.
To illustrate this point, consider the following example:
p :- q([]).
q(X) :- go(X), !, q([a|X]).
q(X) :- stop(X).
with some mutually exclusive go and stop. The desired outcome (q with all as as long as go) is computed but not returned. A better solution would be
p(Y) :- q([],Y).
q(X,Y) :- go(X), !, q([a|X],Y).
q(X,X) :- stop(X).
As said above difference lists can also be used.

Resources