1/***************************************************************************** 2 * This file is part of the Prolog Development Tool (PDT) 3 * 4 * Author: G�nter Kniesel (among others) 5 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start 6 * Mail: pdt@lists.iai.uni-bonn.de 7 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn 8 * 9 * All rights reserved. This program is made available under the terms 10 * of the Eclipse Public License v1.0 which accompanies this distribution, 11 * and is available at http://www.eclipse.org/legal/epl-v10.html 12 * 13 ****************************************************************************/ 14 15/* 16 * This file implements generic graph algorithms in Prolog. 17 * - Tarjan's O(M+N) computation of strongly connected components (SCCs) 18 * extended to deal also with nested SCCs. Nested SCCs are collapsed 19 * into a single one. 20 * - Depth first path search (also O(M+N)) 21 * 22 * To use the algorithms in the context of module M do the following: 23 * - import this module into M via ":-use_module(THISMODULENAME)." 24 * - define the graph on which the algorithms should operate by 25 * providing in M clauses for the predicates 26 * - graph_node(Node) 27 * - graph_edge(FromNode,ToNode) 28 * By adhering to this convention, different modules can work on different 29 * locally defined graphs without interfering. 30 * DO not even think of patching 31 * Autor: G�nter Kniesel 32 * Date: September 26, 2005 33 * Date: October 2, 2009: Made "public" predicates module transparent 34 */ 35:- module('condor.graph.cycle.scc', 36 [ strongly_connected/1 % Arg1 = List of node lists representing SCCs 37 , dfs/3 % Called locally in metapredicates 38 , node/1 % Called locally in metapredicates 39 , edge/2 % Called locally in metapredicates 40 ] ). 41 42 43 44 45 46/* 47 * Global data structures for depth first traversal and SCC. 48 */ 49:- dynamic discovery_time/2. % args = node, time 50:- dynamic finishing_time/2. % args = node, time 51:- dynamic global_time/1. 52:- dynamic scc_counter/1. 53:- dynamic current_scc_nr/1. 54:- dynamic scc_nr_for/2. 55:- dynamic graph_orientation/1. 56 57 58 59/* 60 * Define graph structure based on predicates graph_edge/2 61 * and graph_node/1 to be defined in the calling module. 62 */ 63:- module_transparent node/1. 64node(N) :- 65 context_module(M), 66 M:graph_node(N). 67 68:- module_transparent edge/2. 69edge(N1,N2) :- 70 context_module(M), 71 ( graph_orientation(forward) 72 -> M:graph_edge(N1,N2) 73 ; M:graph_edge(N2,N1) 74 ). 75 76 77/* 78 * For the graph defined by node/1 and edge/2 calculate the 79 * strongly connected components (SCCs) using Tarjan's algorithm: 80 * 1. Perform a depth first toplogical sort that 81 * assigns start and finishing times to the nodes. 82 * 2. Order nodes by reverse finishing time. 83 * 3. Inverse the direction of graph edges. 84 * 4. Perform a depth first topological sort of the reversed 85 * graph processing the nodes in the order of reverse 86 * finishing time determined in step 2. 87 * 5. Each path determined in this second toposort is a SCC. 88 */ 89:- module_transparent( strongly_connected/1 ). 90 91strongly_connected(SortedUniqueSCCs) :- 92 clean, % Initialize local data for first DF traversal 93 visit_all_nodes_randomly(_NumberedPaths), 94 % show_internals, 95 sort_by_reverse_finishing_times(Nodes), 96 clean, % Reinitialize local data for second DF traversal 97 % Must come AFTER sort_by_reverse_finishing_times! 98 set_graph_orientation(reverse), % invert graph edges 99 visit_all_nodes_ordered(Nodes,NumberedSccCandidatess), 100 % show_internals, 101 combine_nested_cycles(NumberedSccCandidatess,NumberedSCCs), 102 findall(Unique, 103 ( member((_,Path),NumberedSCCs), 104 sort(Path,Sorted), 105 removeDuplicates(Sorted,Unique) 106 ), 107 SortedUniqueSCCs), 108 true. 109 110 111 112combine_nested_cycles(SccCandidates,SCCs):- 113 length(SccCandidates,L), 114 scc_counter(L), 115 !, 116 SccCandidates = SCCs. 117combine_nested_cycles(SccCandidates,SCCs):- 118 % findall( (Cnt,Path1), scc_candidate(Cnt,Path1), All), 119 patch(SccCandidates,SCCs).
125patch( [],[] ). 126patch( [(Nr,List1)|Tail],Patch) :- 127 member_remove_first((Nr,List2),Tail,Rest), 128 !, 129 append(List2,List1,L21), 130 patch( [(Nr,L21)|Rest],Patch). 131patch( [Elem|Tail],[Elem|Patch]) :- 132 patch( Tail,Patch).
138member_remove_first(Elem,[Elem|Rest],Rest) :- !. 139member_remove_first(Elem,[H|Tail],[H|Rest]):- 140 member_remove_first(Elem,Tail,Rest). 141 142/* 143 * Topological sorting based on depth first search returns a list 144 * of depths first paths through the graph, starting randomly. 145 * This variant is used in the first phase of Tarjan's algorithm 146 * for computing strongly connected components. 147 */ 148:- module_transparent( visit_all_nodes_randomly/1 ). 149 150visit_all_nodes_randomly(Paths) :- 151 findall((Cnt,Path), ( % dfs_for_node(Cnt,Path) 152 node(N), dfs(N,Cnt,Path) 153 ), Paths). 154 155 156 157/* 158 * Topological sorting based on depth first search returns a list 159 * of depths first paths through the graph, proceessing the nodes 160 * of the graph in the order indicated by NodeList. 161 * This variant is used in the first phase of Tarjan's algorithm 162 * for computing strongly connected components. When used that 163 * way the computed list of paths corresponds to the set of 164 * strongly connected components of the graph. 165 */ 166:- module_transparent( visit_all_nodes_ordered/2 ). 167visit_all_nodes_ordered(NodeList,Paths) :- 168 findall((Cnt,Path), ( % dfs_for_node_from_list(NodeList,Cnt,Path) 169 member(N,NodeList),dfs(N,Cnt,Path) 170 ), Paths). 171 172 173:- module_transparent( dfs_for_node/2 ). 174:- module_transparent( dfs_for_node_from_list/3 ). 175dfs_for_node( Cnt,Path) :- node(N), dfs(N,Cnt,Path). 176dfs_for_node_from_list(NodeList,Cnt,Path) :- member(N,NodeList),dfs(N,Cnt,Path). 177 178 179:- module_transparent( dfs/3 ). 180dfs(N,Cnt,Path) :- 181 visit_first_node(N,Path), % Increments scc_counter only once 182 clause('condor.graph.cycle.scc':scc_counter(Cnt),_). % New value for every FIRST node! 183 184:- module_transparent( visit_first_node/2 ). 185visit_first_node(N,Path) :- 186 not('condor.graph.cycle.scc':visited(N)), 187 set_time(N, discovery_time), % assert discovery_time(N,...) 188 increment_scc_counter, 189 visit_neighbours(N,Path). 190 191/* 192 * Depth first traversal starting at node N returns path Path. 193 */ 194:- module_transparent( visit_node/2 ). 195visit_node(N,Path) :- 196 not('condor.graph.cycle.scc':visited(N)), 197 set_time(N, discovery_time), % assert discovery_time(N,...) 198 visit_neighbours(N,Path). 199 200 201/* 202 * A node has already been visited if its discovery time is set. 203 * The node might still be visited ('grey' node) or its visit might 204 * already be finished ('black' node). Use finished/1 to find out 205 * the difference. 206 */ 207visited(N) :- 208 discovery_time(N,_), 209 !. 210 211 212/* 213 * Visit one neighbour at one time. Visit them all upon backtracking. 214 * Uses the graph_edge/2 definition from the calling context module. 215 */ 216:- module_transparent( visit_neighbours/2 ). 217 218visit_neighbours(N,Path) :- % no unvisited neighbours 219 dead_end(N), 220 !, 221 Path = [N], 222 set_time(N, finishing_time). % assert finishing_time(N,...) 223visit_neighbours(N,Path) :- % visit all unvisited neighbours 224 context_module(M), 225 M:edge(N,Other), % ... by backtracking over M:edge/2 226 not( 'condor.graph.cycle.scc':visited(Other) ), 227 Path = [N|Rest], 228 visit_node(Other,Rest). 229visit_neighbours(N,_) :- % all neighbours visited 230 set_time(N, finishing_time), % assert finishing_time(N,...) 231 fail. 232 233 234/* 235 * The node N either has no neighbours at all or it has only 236 * visited ones. 237 */ 238:- module_transparent dead_end/1. 239 240dead_end(N) :- 241 not( edge(N,_) ), 242 !. 243dead_end(N) :- 244 forall( edge(N,N2), 'condor.graph.cycle.scc':visited(N2) ). 245 246 247 248/* 249 * Sort nodes in reverse finishing time assigned by first 250 * toposort pass through the graph. 251 */ 252sort_by_reverse_finishing_times(Nodes) :- 253 findall( (Time,N), finishing_time(N,Time), All), 254 sort(All,Sorted), 255 reverse(Sorted,Rev), 256 findall( Node, member((_,Node), Rev), Nodes). 257 258/* 259test(sort_by_reverse_finishing_times(Nodes),Expected) :- 260 sort_by_reverse_finishing_times(Nodes), 261 Expected = [a,b,e,d,c,f]. 262 263finishing_time(a, 18). 264finishing_time(b, 17). 265finishing_time(c, 6). 266finishing_time(d, 7). 267finishing_time(e, 8). 268finishing_time(f, 3). 269*/ 270 271 272/* --------- Helper Predicates -------------------------- */ 273 274 275/* 276 * Show snapshot of helper data structures. 277 */ 278show_internals :- 279 listing_if_defined(discovery_time), 280 listing_if_defined(finishing_time), 281 listing_if_defined(global_time), 282 listing_if_defined(scc_counter), 283 listing_if_defined(graph_orientation). 284 285 286/* 287 * (Re)Initialize helper data structures. 288 */ 289clean :- 290 retractall(discovery_time(_,_)), 291 retractall(finishing_time(_,_)), 292 reset_time, 293 reset_scc_counter, 294 set_graph_orientation(forward). 295 296 297/* 298 * Assert discovery_time(N,currentTime) or finishing_time(N,currentTime) 299 * and increment currentTime. 300 */ 301set_time(N, Which) :- 302 retract(global_time(T)), 303 T1 is T+1, 304 assert(global_time(T1)), 305 Fact =.. [Which, N, T], % discovery_time(N,T) or finishing_time(N,T) 306 assert(Fact).
312reset_time :-
313 retractall(global_time(_)),
314 assert(global_time(1)). 321reset_scc_counter :- 322 set_scc_counter(0). 323 324set_scc_counter(New) :- 325 retractall(scc_counter(_)), 326 assert(scc_counter(New)). 327 % format('asserted scc_counter(~a).~n',[New]). 328 329increment_scc_counter :- 330 retract(scc_counter(Old)), 331 New is Old+1, 332 assert(scc_counter(New)). 333 % format('asserted scc_counter(~a).~n',[New]). 334 335 336 337/* 338 * Set graph orientation. Legal values are 'forward' and 339 * 'reverse'. (Actually, anything different from 'forward' 340 * is treated as 'reverse'. This flag controls the direction 341 * of arcs in the graph. In the second phase it allows to 342 * virtually invert the arcs without physically copying the 343 * graph. 344 */ 345set_graph_orientation(X) :- 346 retractall(graph_orientation(_)), 347 assert(graph_orientation(X))