3/*************************************************************************************
    4 * shortest_paths.pl
    5 *
    6 * 17/4/00, Neil Smith
    7 *
    8 * Uses Dijkstra's algorithm for finding the shortest paths between nodes on a graph
    9 * Will work on both directed and undirected graphs
   10 *
   11 * shortest_paths(+Start, +AdjacencyPred, -Paths)
   12 *   true if Paths is the set of all shortest paths, starting at Start, on the graph
   13 *   defined by AdjacenyPred
   14 *
   15 * all_pairs_shortest_paths(AdjacencyPred, -Paths)
   16 *   true if Paths is the set of all shortest paths in the graph defined by AdjacenyPred
   17 *
   18 * Paths are defined as a list of 4-tuples: 
   19 *       path(Start, End, Cost, Nodes)
   20 *   where Nodes is the list of nodes on the path, in reverse order, including the Start
   21 *   and End
   22 * 
   23 * Note that the graphs are not defined here: instead, they must be passed a predicate that
   24 * is used with call/4: 
   25 *       call(+AdjacenyPred, ?Node1, ?Node2, ?Cost)
   26 * AdjacenyPred should enumerate through all directly adjacent nodes in the graph.  
   27 * It should be able to generate all neighbours of a given Node1 (call(+, +, ?, ?)),
   28 * and all all nodes in a graph (call(+, -, ?, ?)).
   29 * 
   30 *************************************************************************************/
   31
   32:- module(shortest_paths,
   33      [ shortest_paths/3,
   34	all_pairs_shortest_paths/2
   35      ]).   36
   37
   38:- ensure_loaded((utils_higher_order)).		% for filter/3, call/4, foldl/4
   39%:- ensure_loaded((utils_oset)).	% for insert_merge/4
   40:- ensure_loaded((utils_set)).		% for select/3
   41
   42
   43shortest_paths(From, Adjacency, Paths):-
   44	shortest_paths([path(From, From, 0, [From])], Adjacency, [], Paths).
   45
   46% shortest_paths(OpenNodes, Adjacency, ClosedNodes0, ClosedNodes).
   47% each 'node' is the best-so-far path (closed nodes are the best possible),
   48%   a tuple of
   49%      path(Start, End, Cost, [Vertex])
   50%   where [Vertex] is the path (in reverse order) from Start to End with Cost
   51% OpenNodes are kept in sorted order by Cost
   52
   53shortest_paths([], _, Paths, Paths).
   54shortest_paths([path(Start, Current, Cost, Path)|OpenNodes0], Adjacency, ShortestPaths0, ShortestPaths):-
   55	one (	setof(EdgeCost - Neighbour, call(Adjacency, Current, Neighbour, EdgeCost), CostedNeighbours0)
   56	    ;	CostedNeighbours0 = []  ),
   57	filter(CostedNeighbours0, [_ - X]^(\+ member(path(Start, X, _, _), ShortestPaths0)), CostedNeighbours),
   58	relax(CostedNeighbours, Start, Current, Cost, Path, OpenNodes0, OpenNodes),
   59	shortest_paths(OpenNodes, Adjacency, [path(Start, Current, Cost, Path)|ShortestPaths0], ShortestPaths).
   60
   61
   62relax([], _, _, _, _, Open, Open).
   63relax([Cost - Neighbour | CostedNeighbours], Start, Current, PathCost, Path, OpenNodes0, OpenNodes):-
   64	NewPathCost is PathCost + Cost,
   65	(	select(path(Start, Neighbour, OtherCost, _OtherPath), OpenNodes0, RemainingOpen)
   66	->	(	NewPathCost < OtherCost
   67			->	insert_merge(RemainingOpen, path(Start, Neighbour, NewPathCost, [Neighbour|Path]), 
   68					compare_paths_by_cost, OpenNodes1)
   69			;	OpenNodes1 = OpenNodes0	)
   70	;	insert_merge(OpenNodes0, path(Start, Neighbour, NewPathCost, [Neighbour|Path]), 
   71			compare_paths_by_cost, OpenNodes1)	),
   72	relax(CostedNeighbours, Start, Current, PathCost, Path, OpenNodes1, OpenNodes).
   73
   74
   75compare_paths_by_cost(Rel, path(_, _, Cost1, _), path(_, _, Cost2, _)):- 
   76	compare(Rel, Cost1, Cost2).
   77
   78
   79all_pairs_shortest_paths(Adjacency, AllPaths):-
   80	setof(Node, Node2^Cost^call(Adjacency, Node, Node2, Cost), Nodes),
   81	foldl(Nodes, 
   82		[ExistingPaths, Node, Paths]^
   83			(shortest_paths([path(Node, Node, 0, [Node])], Adjacency, ExistingPaths, Paths)), 
   84		[], 
   85		AllPaths)