[m-dev.] for review: graph.m additions (pathing)
doug.auclair at logicaltypes.com
doug.auclair at logicaltypes.com
Sun Apr 30 17:16:12 AEST 2006
Dear all,
I've enclosed a diff -u of some additions I've made to
graph.m that I would like you to review, and, if acceptable,
add to the standard library.
The gist of the additions are as follows.
1. On top of the regular, undirected, path/4 predicate,
I've added a searching strategy and a new path/5 predicate
that uses it to give the user some control over how the next
path is obtained.
2. I use the information in the arcs of the graph, as
well as the nodes, so, sometimes it is important to me
how I arrived at node2 from node1. Therefore, I've added
func successors_with_arcs/2 to give me the arcs to the
successor nodes.
3. One of my primary uses of graphs is finding a path from
node1 to nodeN, but not just any jrandom path: I'm looking
for the "best" path. So I've added best_path/5 that gives
an answer very quickly as compared to what I could do with
module graph as it was written (I've clocked 100x speed
improvement consistently on a highly cyclic graph of 63 nodes
and 174 arcs). best_path/5 allows the user to default on
what "best" means (reductively: least number of arcs travelled),
or to define a cost function over the graph for each arc
(with the supposition that the arc is more than just unit).
The additions are below; these additions do not modify the
old graph functionality.
Sincerely,
Doug Auclair
-----
--- graph.m 2006-04-30 02:33:58.000000000 -0400
+++ doug_graph.m 2006-04-30 02:43:36.000000000 -0400
@@ -4,7 +4,7 @@
% Copyright (C) 1994-1999, 2003, 2005-2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
%
% File: graph.m.
% Main author: conway.
@@ -14,13 +14,14 @@
% stores information of type N in the nodes, and information of type A
% in the arcs.
%
-%------------------------------------------------------------------------------%
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- module graph.
:- interface.
:- import_module list.
+:- import_module map.
:- import_module set.
:- import_module unit.
@@ -118,7 +119,10 @@
is det.
:- func graph.successors(graph(N, A), node(N)) = set(node(N)).
- % graph.nodes(Graph, Nodes) binds Nodes to the set of nodes in Graph.
+:- func graph.successors_with_arcs(graph(N, A), node(N))
+ = map(arc(A), node(N)).
+
+ % graph.nodes(Graph, Nodes) binds Nodes to the set of nodes in Graph.
%
:- pred graph.nodes(graph(N, A)::in, set(node(N))::out) is det.
:- func graph.nodes(graph(N, A)) = set(node(N)).
@@ -159,25 +163,68 @@
% from the node Start to the node End in Graph that goes through
% the sequence of arcs Arcs.
% The algorithm will return paths containing at most one cycle.
- %
+
:- pred graph.path(graph(N, A), node(N), node(N), list(arc(A))).
:- mode graph.path(in, in, in, out) is nondet.
:- mode graph.path(in, in, out, out) is nondet.
-%------------------------------------------------------------------------------%
-%------------------------------------------------------------------------------%
+ % provides a facade to different search strategies (aggressive
+ % verses passive (being cyclical or noncyclical))
+
+:- pred graph.path(search_strategy, graph(N, A), node(N),
+ node(N), list(arc(A))).
+:- mode graph.path(in, in, in, in, out) is nondet.
+:- mode graph.path(in, in, in, out, out) is nondet.
+
+:- type graph.search_strategy
+ ---> aggressive; passive(cycling).
+
+:- type graph.cycling ---> no_cycles; at_most_one_cycle.
+
+ % '"best"_path'/5 currently takes the brute-force approach --
+ % it arbitrarily picks the first path, and then uses its
+ % associated cost as a starting point to find, eventually, the
+ % least expensive path. The default is unit cost per arc.
+
+ % It should be noted in passing that, operationally, this
+ % '"best"_path'/5 is more than 100 times faster than a naive
+ % approach on a graph of 63 nodes and 174 arcs because it
+ % prunes away failing paths inline (as opposed to eliminating
+ % a failing path after it's fully realized).
+
+:- pred best_path(search_heuristic(N, A), graph(N, A), node(N),
+ node(N), list(arc(A))).
+:- mode best_path(in, in, in, in, out) is nondet.
+:- mode best_path(in, in, in, out, out) is nondet.
+
+% :- type cost_fn == some [N, A] (func(graph(N, A), arc(A)) = int).
+:- mode cost_fn_in == in(func(in, in) = out is det).
+
+ % The search_heuristic gives a way to look for the best path
+ % (aggressive or one of the passive approaches) and a function
+ % that computes the cost of traversing each arc of the path
+ % (the default cost function is that each arc has unit cost).
+
+:- type search_heuristic(N, A)
+ ---> search_heuristic(search_strategy, (func(graph(N, A), arc(A)) = int))
+ ; default_cost_search_heuristic(search_strategy).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- implementation.
+:- import_module assoc_list.
:- import_module counter.
:- import_module int.
:- import_module list.
-:- import_module map.
+:- import_module pair.
:- import_module require.
+:- import_module string.
:- use_module solutions.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
:- type graph(N, A)
---> graph(
@@ -197,7 +244,7 @@
:- type arc_info(N, A)
---> arc_info(node(N), node(N), A).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.init(Graph) :-
Graph = graph(counter.init(0), counter.init(0), Nodes, Arcs, Edges),
@@ -205,7 +252,7 @@
map.init(Arcs),
map.init(Edges).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.set_node(!.G, NInfo, node(N), !:G) :-
NS0 = !.G ^ node_supply,
@@ -245,19 +292,16 @@
map.set(Edges0, node(N), EdgeSet, Edges),
!:G = !.G ^ edge_map := Edges.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.search_node(Graph, NodeInfo, Node) :-
NodeTable = Graph ^ node_map,
map.member(NodeTable, Node, NodeInfo).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.find_matching_nodes(Graph, NodeInfo, NodeSet) :-
NodeTable = Graph ^ node_map,
-% SolnGoal = lambda([Node::out] is nondet,
-% map.member(NodeTable, Node, NodeInfo)),
-% solutions(SolnGoal, NodeList),
solutions.solutions(graph.select_node(NodeTable, NodeInfo), NodeList),
set.sorted_list_to_set(NodeList, NodeSet).
@@ -266,25 +310,27 @@
graph.select_node(NodeTable, NodeInfo, Node) :-
map.member(NodeTable, Node, NodeInfo).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.node_contents(G, N, I) :-
map.lookup(G ^ node_map, N, I).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.successors(G, N, Ss) :-
- map.lookup(G ^ edge_map, N, E),
- map.values(E, SsList),
+ map.values(successors_with_arcs(G, N), SsList),
set.list_to_set(SsList, Ss).
-%------------------------------------------------------------------------------%
+graph.successors_with_arcs(G, N) = SnAs :-
+ map.lookup(G ^ edge_map, N, SnAs).
+
+%---------------------------------------------------------------------------%
graph.nodes(G, Ns) :-
map.keys(G ^ node_map, Ns1),
set.list_to_set(Ns1, Ns).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.set_edge(!.G, Start, End, Info, Arc, !:G) :-
AS0 = !.G ^ arc_supply,
@@ -302,13 +348,14 @@
map.set(Es0, Start, EdgeMap, Es),
!:G = !.G ^ edge_map := Es.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.det_insert_edge(!.G, Start, End, Info, Arc, !:G) :-
( graph.insert_edge(!.G, Start, End, Info, ArcPrime, !:G) ->
Arc = ArcPrime
;
- error("graph.det_insert_edge: this edge is already in the graph.")
+ error("graph.det_insert_edge: this edge is already in "
+ ++ "the graph.")
).
graph.insert_edge(!.G, Start, End, Info, Arc, !:G) :-
@@ -327,38 +374,160 @@
map.set(Es0, Start, EdgeMap, Es),
!:G = !.G ^ edge_map := Es.
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
graph.arc_contents(G, N, S, E, A) :-
map.lookup(G ^ arc_map, N, I),
I = arc_info(S, E, A).
-%------------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
-graph.path(G, S, E, Path) :-
- graph.path_2(G, S, E, [], Path).
-
-:- pred graph.path_2(graph(N, A), node(N), node(N),
- list(node(N)), list(arc(A))).
-:- mode graph.path_2(in, in, in, in, out) is nondet.
-:- mode graph.path_2(in, in, out, in, out) is nondet.
-
-graph.path_2(G, S, E, Nodes0, Path) :-
- Es = G ^ edge_map,
- map.lookup(Es, S, Arcs),
- (
- map.member(Arcs, A, E),
- \+ list.member(E, Nodes0),
+ % passive_search/5 takes the purely declarative approach to
+ % locating a path from some (ground) Start to an eventual
+ % (ground or free) End. It ignores any operational realities,
+ % so it can take a bit of time to discover a path for anything
+ % other than simple graphs ... on the other hand, the
+ % algorithm is straightforward and easy to comprehend.
+
+:- pred passive_search(map(node(N), map(arc(A), node(N))), node(N), node(N),
+ list(node(N)), list(arc(A))).
+:- mode passive_search(in, in, in, in, out) is nondet.
+:- mode passive_search(in, in, out, in, out) is nondet.
+
+passive_search(Map, S, E, Nodes0, Path) :-
+ map.lookup(Map, S, Arcs),
+ (map.member(Arcs, A, E),
+% \+ list.member(E, Nodes0), % DMA: superfluous
Path = [A]
;
map.member(Arcs, A, N),
\+ list.member(N, Nodes0),
- graph.path_2(G, N, E, [N | Nodes0], Path0),
- Path = [A | Path0]
- ).
+ passive_search(Map, N, E, [N | Nodes0], Path0),
+ Path = [A | Path0]).
+
+ % aggressive_search/4 takes a more directed approach to
+ % finding a path from Start to End (actually, back from End to
+ % Start): instead of picking any arbitrary next node, it
+ % (aggressively) attempts to link to Start at every turn.
+
+:- pred aggressive_search(graph(N, A), node(N), list(node(N)), list(arc(A))).
+:- mode aggressive_search(in, in, in(non_empty_list), out) is nondet.
+
+aggressive_search(Graph, From, Nodes@[Node|_Nodes], Path) :-
+ From = Node ->
+ cons_path(Graph, Nodes, [], Path)
+ ;
+ (member(From, successors(Graph, Node)) ->
+ cons_path(Graph, [From|Nodes], [], Path)
+ ;
+ member(Pre, successors(Graph, Node)),
+ not member(Pre, Nodes),
+ aggressive_search(Graph, From, [Pre|Nodes], Path)).
+
+:- pred cons_path(graph(N, A), list(node(N)), list(arc(A)), list(arc(A))).
+:- mode cons_path(in, in(non_empty_list), in, out) is det.
+
+cons_path(Graph, [A|Nodes], !Arcs) :-
+ [B|Rest] = Nodes,
+ successors_with_arcs(Graph, A) = Map,
+ search(reverse_members(to_assoc_list(Map)), B, Arc) ->
+ cons(Arc, !Arcs),
+ (Rest = [] -> reverse(!Arcs); cons_path(Graph, Nodes, !Arcs))
+ ;
+ error("Cannot reconstruct path from nodes collected!\n"
+ ++ string([A|Nodes])).
+
+graph.path(G, S, E, Path) :-
+ passive_search(G ^ edge_map, S, E, [], Path).
+
+graph.path(passive(at_most_one_cycle), Graph, From, To, Ans) :-
+ passive_search(Graph ^ edge_map, From, To, [], Ans).
+graph.path(passive(no_cycles), Graph, From, To, Ans) :-
+ passive_search(Graph ^ edge_map, From, To, [From], Ans).
+graph.path(aggressive, Graph, From, To, Ans) :-
+ freeze(From, To, Graph),
+ aggressive_search(Graph, From, [To], Ans).
+
+best_path(Huey, Graph, From, To, Ans) :-
+ Searcher = heuristic_strategy(Huey),
+ path(Searcher, Graph, From, To, Guess),
+ CostFn = transit_cost_fn(Huey),
+ TotalCost
+ = foldl((func(X, Y) = Z :- Z = CostFn(Graph, X) + Y), Guess, 0),
+ get_shortest_path(Searcher, CostFn, Graph, From, To,
+ TotalCost, Guess, Ans).
+
+:- func heuristic_strategy(search_heuristic(N, A)) = search_strategy.
+heuristic_strategy(search_heuristic(Strat, _)) = Strat.
+heuristic_strategy(default_cost_search_heuristic(Strat)) = Strat.
+
+:- func transit_cost_fn(search_heuristic(N, A)) = (func(graph(N, A),
+ arc(A)) = int).
+transit_cost_fn(search_heuristic(_, Fn)) = Fn.
+transit_cost_fn(default_cost_search_heuristic(_)) = (func(_, _) = 1).
+
+:- pred get_shortest_path(search_strategy,
+ (func(graph(N, A), arc(A)) = int), graph(N, A),
+ node(N), node(N), int, list(arc(A)), list(arc(A))).
+:- mode get_shortest_path(in, cost_fn_in, in, in, in, in, in, out) is nondet.
+
+get_shortest_path(Searcher, CostFn, Map, From, To, Cost, Guess, Ans) :-
+ path(Searcher, CostFn, Map, From, dying_at(Cost),
+ [To], NewGuess, 0, NewCost) ->
+ get_shortest_path(Searcher, CostFn, Map, From, To,
+ NewCost, NewGuess, Ans)
+ ;
+ Ans = Guess.
+
+:- type swan ---> dying_at(int).
+
+:- pred path(search_strategy, (func(graph(N, A), arc(A)) = int),
+ graph(N, A), node(N), swan, list(node(N)), list(arc(A)),
+ int, int).
+:- mode path(in, cost_fn_in, in, in, in, in(non_empty_list),
+ out, in, out) is nondet.
+
+path(Search, CostFn, Graph, From, dying_at(Max),
+ Nodes@[Mid|_], Ans, CostIn, CostOut) :-
+ CostIn < Max - 1,
+ (From = Mid ->
+ cons_path(Graph, Nodes, [], Ans),
+ CostIn = CostOut
+ ;
+ a_successor(Search, successors_with_arcs(Graph, Mid),
+ From, Node, Arc),
+ not member(Node, Nodes),
+ CostTmp = CostIn + CostFn(Graph, Arc),
+ path(Search, CostFn, Graph, From, dying_at(Max),
+ [Node|Nodes], Ans, CostTmp, CostOut)).
+
+:- pred a_successor(search_strategy::in, map(arc(A), node(N))::in,
+ node(N)::in, node(N)::out, arc(A)::out) is nondet.
+
+a_successor(aggressive, Map, From, Next, Arc) :-
+ Nodelist = reverse_members(to_assoc_list(Map)),
+ (search(Nodelist, From, McDo) ->
+ Next = From,
+ Arc = McDo
+ ;
+ member(Next - Arc, Nodelist)).
+
+a_successor(passive(_), Map, _From, Next, Arc) :-
+ member(Map, Arc, Next).
+
+:- pred freeze(node(N), node(N), graph(N, A)).
+:- mode freeze(in, in, in) is semidet.
+:- mode freeze(in, out, in) is nondet.
+
+freeze(From::in, To::in, _::in) :- not From = To.
+freeze(From::in, To::out, Graph::in) :-
+ delete(nodes(Graph), From, RestNodes),
+ member(To, RestNodes).
+
+:- pragma promise_equivalent_clauses(freeze/3).
-%-----------------------------------------------------------------------------%
-%-----------------------------------------------------------------------------%
+%--------------------------------------------------------------------------%
+%--------------------------------------------------------------------------%
% Ralph Becket <rwab1 at cl.cam.ac.uk> 29/04/99
% Functional forms added.
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list