How to find the unique shortest path for a weighted directed graph with SWI Prolog?

Question

This is an extension of what I did in Prolog class. In class, I was asked to write a predicate path(X, Y, N) which returns true if and only there is a path from node X to node Y with length N. What is given is the list of directed edges with corresponding weights, e.g. edge(a, b, 3) and edge(c, d, 10).

The given problem is pretty straightforward (only some recursion and base cases). However, I thought that maybe I could extend this a little further. Given that the simple directed graph input may contain cycles and contains only non-negative weights, what is the length of the unique shortest path from given nodes A and B. (By unique, I mean that this predicate should return false if more than one shortest path exists from A to B).

Here is an example of the database which contains a cycle (a, b, c, e, a).

edge(a, b, 1).
edge(b, c, 2).
edge(c, d, 1).
edge(b, d, 4).
edge(c, e, 1).
edge(e, a, 10).
edge(e, d, 6).

I thought that to satisfy the unique condition, I thought that I should augment the original path/3 predicate to also contain the path information as a list (so that I could compare the path uniqueness later). This new augmentation is reflected in the new path/4 predicate.

path(X, X, 0, []).
path(X, Y, N, [Y]) :- edge(X, Y, N).
path(X, Y, N, [Z|T]) :- edge(X, Z, N1), N2 is N - N1, N2 > 0, path(Z, Y, N2, T).

path(X, Y, N) :- path(X, Y, N, _).

As of this code, I already found a problem: if I try to unify the predicate with path(a, b, N, Z), this will not work because N will not be able to unify with N2 is N - N1. However, if I change this part to N is N1 + N2, this will still not work because N2 is still not unified. If I change the whole predicate line to:

path(X, Y, N, [Z|T]) :- edge(X, Z, N1), path(Z, Y, N2, T), N is N1 + N2.

This will then run endlessly because the number of paths are possibly infinite because the graph may contain loops (which I want to try to keep it that way as a challenge).

As for the shortestpath/3 predicate, I cannot find all paths and check whether all the paths are longer because the number of paths may be infinite due to having a cycle. Instead, I tried to find any paths which have length between 0 and the given N; if no path exists, then this is definitely the shortest path.

countdown(N, N).
countdown(N, X) :- N1 is N - 1, N1 >= 0, countdown(N1, X).

shortestpath(A, B, N) :- path(A, B, N), \+((countdown(N, N1), N > N1, path(A, B, N1))).

However this doesn't address the N given as a variable (because the countdown function wouldn't work), let alone the unique constraint.

So my question is, is there a way to make this question work or is it actually impossible to do so? If there is such a solution, please kindly provide it here (or if you think this is a "homework" question, please at least guide me in the correct direction).

Constraints:

• I don't want to use any built-in predicates. Only 'simple' or 'core' predicates such as \+, is, +, for example. var, nonvar, asserta and similar predicates are also somewhat acceptable (since there is no alternative which achieves the same functionality).

• I want it to be as general as possible; that is, any arguments for the predicate should be able to give as a variable. (or at least have the last argument of shortestpath/3, which is the length of the shortest path, a variable).

---

I have looked through the following questions already and it doesn't answers my situation:

• Find the shortest path between two nodes in a graph in Prolog (Doesn't address weighted edges and also uses complex predicates (e.g. path/4).

• search all paths and the shortest path for a graph - Prolog (Doesn't address graphs with cycles).

• Find the shortest path between two nodes in a graph in (Prolog) and display the result as array (Doesn't address weighted edges).

Please feel free to point me to any other question that address my question.

Answer 1

It's nice to get a question inspired by homework rather than just actual homework! Let's start from your predicate and see if we can beat it into submission, and then we can talk about some alternate approaches.

First I'm starting from a simplified predicate from yours:

path(X, Y, N, [X-Y]) :- edge(X, Y, N).
path(X, Z, N, [X-Y|T]) :-
    edge(X, Y, N0),
    path(Y, Z, N1, T),
    N is N0 + N1.

The main difference here is that I'm just generate the paths and then computing the lengths. I'm not doing any subtraction here. It's common in Prolog to start from the simplest generate-and-test approach and then refine either the generator or the test or both until you are happy, so this is just a very simple generator. I'm keeping both source and destination nodes in the path sequence for now just to help me visualize what's going on, and with it you see immediately the problem with cycles:

?- path(a, e, N, T).
N = 4,
T = [a-b, b-c, c-e] ;
N = 18,
T = [a-b, b-c, c-e, e-a, a-b, b-c, c-e] ;
N = 32,
T = [a-b, b-c, c-e, e-a, a-b, b-c, c-e, e-a, ... - ...|...] .

I don't think we are with your sample graph, but we could be suffering a bit here from Prolog's depth-first search: as long as there's no failure, Prolog has no reason to back up and try another path. And you see the cycles right there. If it used breadth-first search instead, you'd be fairly sure the first solution is the shortest simply because by advancing everything one step, you never get caught in a rabbit hole before generating your first solution. Dijkstra's algorithm (thanks for the reminder @JakobLovern) skirts the problem by coloring visited nodes and not counting them more than once.

It is possible to control the search behavior by creating a metainterpreter, which isn't as bad as it sounds but is more work than adjusting the search to account for cycles, which is I think what most people do in this circumstance with a graph, so let's try that first:

path(X, Y, N, Path) :- path(X, Y, N, [], Path).

path(X, Y, N, Seen, [X]) :-
    \+ memberchk(X, Seen),
    edge(X, Y, N).
path(X, Z, N, Seen, [X|T]) :-
    \+ memberchk(X, Seen),
    edge(X, Y, N0),
    path(Y, Z, N1, [X|Seen], T),
    \+ memberchk(X, T),
    N is N0 + N1.

Adding the Seen parameter and using \+ memberchk/2 to avoid adding things to the path that are already in the path is not really an uncommon thing to do. memberchk/2 is not ISO, but it's a very common predicate. You could implement it yourself like this (please don't!):

memberchk(X, L) :- once(member(X, L)).
member(X, [X|_]).
member(X, [_|Xs]) :- member(X, Xs).

I think it's worth noting that memberchk/2 + lists equals basically sets as used in Dijkstra's algorithm. This is like in in Python; it would be kind of insane to try and do anything real in Prolog without at least member/2.

These changes make path/4 avoid cycles, so you can now find all the solutions without any spurious ones. Note: I have not made your graph acyclic. I have simply made path/4 aware of cycles.

Note we get multiple solutions:

?- path(a, d, X, Y).
X = 5,
Y = [a, b] ;
X = 4,
Y = [a, b, c] ;
X = 10,
Y = [a, b, c, e] ;
false.

There is a nice library, aggregate which is helpful for situations like this. But, you asked for no spurious libraries. :)

Let's just get the shortest path:

uniq_shortest_path(X, Y, MinCost, Path) :-
    path(X, Y, MinCost, Path), 
    \+ (path(X, Y, LowerCost, OtherPath), 
        OtherPath \= Path, 
        LowerCost =< MinCost).

What this literally says is that Path is the unique shortest path between X and Y (happening to have cost MinCost) if and only if there is no other path with a cost less than or equal to our cost. Trying it out:

?- uniq_shortest_path(a, d, MinCost, Path).
MinCost = 4,
Path = [a, b, c] ;

This trick isn't cheap; it's likely that it works by comparing all the solutions to each other. But it does work, without any additional shenanigans.

A significant improvement would probably come by just getting all the solutions, sorting on cost and then ensuring that the first two do not have the same cost before reporting the cost and path of the first one.

A greater improvement could probably be found by implementing Dijkstra's algorithm directly, or possibly by trying to make a breadth-first metainterpreter. Doing an iterative-deepening approach would probably work, but I doubt it would perform better, since it would often have to do and re-do all the work leading up to a result that gets pruned for being too expensive.

Anyway, I hope this helps! Stay excited about Prolog!