1% BEGIN LICENSE BLOCK 2% Version: CMPL 1.1 3% 4% The contents of this file are subject to the Cisco-style Mozilla Public 5% License Version 1.1 (the "License"); you may not use this file except 6% in compliance with the License. You may obtain a copy of the License 7% at www.eclipse-clp.org/license. 8% 9% Software distributed under the License is distributed on an "AS IS" 10% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See 11% the License for the specific language governing rights and limitations 12% under the License. 13% 14% The Original Code is The GRASPER Constraint Solver for ECLiPSe. 15% The Initial Developer of the Original Code is Ruben Duarte Viegas. 16% Portions created by the Initial Developer are Copyright (C) 2007. 17% All Rights Reserved. 18% 19% Contributor(s): Ruben Duarte Viegas <rviegas@di.fct.unl.pt>. 20% 21% Alternatively, the contents of this file may be used under the terms of 22% either of the GNU General Public License Version 2 or later (the "GPL"), 23% or the GNU Lesser General Public License Version 2.1 or later (the "LGPL"), 24% in which case the provisions of the GPL or the LGPL are applicable instead 25% of those above. If you wish to allow use of your version of this file only 26% under the terms of either the GPL or the LGPL, and not to allow others to 27% use your version of this file under the terms of the MPL, indicate your 28% decision by deleting the provisions above and replace them with the notice 29% and other provisions required by the GPL or the LGPL. If you do not delete 30% the provisions above, a recipient may use your version of this file under 31% the terms of any one of the MPL, the GPL or the LGPL. 32% END LICENSE BLOCK 33 34%%% 35% 36% GRASPER 37% GRAph constraint Satisfaction Problem solveR 38% 39%%% 40 41:- module(grasper). 42 43:- comment(categories, ["Constraints"]). 44:- comment(summary, "Finite Graphs Constraints Library"). 45:- comment(author, "Ruben Duarte Viegas, CENTRIA"). 46:- comment(status, prototype). 47:- comment(date, "$DATE$"). 48:- comment(desc,html("<P> 49 Graph-based constraint programming can be declaratively used for path 50 and circuit finding problems, to routing, scheduling and allocation 51 problems, among others. CP(Graph) was proposed by G. Dooms et al. 52 as a general approach to solve graph-based constraint problems. It 53 provides a key set of basic constraints which represent the 54 framework's core, and higher level constraints for solving path 55 finding and optimization problems, and to enforce graph properties. 56 </P><P> 57 The GRASPER (GRAph constraint Satisfaction Problem solvER) library 58 is an alternative framework for graph-based constraint solving 59 based on Cardinal, a finite sets constraint solver with extra 60 inferences developed in Universidade Nova de Lisboa. It provides 61 a set of basic constraints which represent the core of our 62 framework and functionality for directed graphs, graph weighting, 63 graph matching, graph path optimization problems and some of the 64 most common graph properties. 65 </P><P> 66 More information in this 67 <A HREF=\"http://www.springerlink.com/content/553x1733661l6k31/fulltext.pdf\">background paper</A>. 68 </P> 69")). 70:- comment(see_also, [library(cardinal)]). 71 72%%% 73% 74% Imports 75% 76%%% 77 78:- lib(fd). 79:- lib(ordset). 80:- lib(cardinal). 81:- lib(hash). 82 83%%% 84% 85% Exports 86% 87%%% 88 89:- export dirgraph/3. 90:- export undirgraph/3. 91:- export getVertexSet/2. 92:- export getEdgeSet/2. 93:- export order/2. 94:- export size/2. 95 96:- export weight/3. 97:- export predecessors/3. 98:- export successors/3. 99:- export reachables/3. 100 101:- export symmetric/1. 102:- export asymmetric/1. 103:- export connected/1. 104:- export strongly_connected/1. 105:- export weakly_connected/1. 106:- export path/3. 107%:- export cycle/3. 108 109:- export subgraph/2. 110:- export induced_subgraph/2. 111:- export underlying_graph/2. 112:- export oriented_graph/2. 113:- export reverse_graph/2. 114:- export complementary_graph/2. 115 116:- export graph_labeling/1. 117:- export graph_labeling/3. 118 119:- export export_graph/2. 120:- export hash_add_all/2. 121:- export kill_susps/1. 122:- export terminate_susps/2. 123 124:- comment(induced_subgraph/2, hidden). 125:- comment(hash_add_all/2, hidden). 126:- comment(kill_susps/1, hidden). 127:- comment(terminate_susps/2, hidden). 128 129:- comment( 130 dirgraph/3, 131 [ 132 amode: dirgraph(-,+,+), 133 args: 134 [ 135 "Graph": "A directed graph.", 136 "VertexSet": "The vertex-set that constitutes Graph.", 137 "EdgeSet": "The edge-set that constitutes Graph." 138 ], 139 summary: "Directed graph constructor.", 140 desc: html("Creates Graph as a directed graph variable composed by the vertexes in VertexSet and the edges in EdgeSet."), 141 fail_if: 142 "Fails 143 if VertexSet is not a set variable, 144 if EdgeSet is not a set variable or 145 if EdgeSet cannot be contained in (VertexSet x VertexSet). 146 ", 147 eg: 148 " 149?- E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E). 150No. 151 152?- V`::[]..[1,2,3], dirgraph(G,V,E). 153No. 154 155?- V`::[]..[1,2,3], E`::[[4,5]]..[[1,2],[2,3],[3,1],[4,5]], dirgraph(G,V,E). 156No. 157 158?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E). 159V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _543, fd:[0..3]}, _435, _436, _437, [], [], ['SUSP-_2315-susp'], ['SUSP-_1925-dead'])} 160E = E{cardinal([[]:0, [[1, 2], [2, 3], [3, 1]]:3], Card{cardinal : _728, fd:[0..3]}, _620, _621, _622, [], ['SUSP-_2325-susp'], [], ['SUSP-_1641-dead'])} 161G = dirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _543, fd:[0..3]}, _435, _436, _437, [], [], ['SUSP-_2315-susp'], ['SUSP-_1925-dead'])}, E{cardinal([[]:0, [[1, 2], [2, 3], [3, 1]]:3], Card{cardinal : _728, fd:[0..3]}, _620, _621, _622, [], ['SUSP-_2325-susp'], [], ['SUSP-_1641-dead'])}) 162 163?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1],[4,5]], dirgraph(G,V,E). 164V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _573, fd:[0..3]}, _465, _466, _467, [], [], ['SUSP-_2391-susp'], ['SUSP-_2001-dead'])} 165E = E{cardinal([[]:0, [[1, 2], [2, 3], [3, 1]]:3], Card{cardinal : _766, fd:[0..3]}, _658, _659, _660, [], ['SUSP-_2401-susp'], [], ['SUSP-_1717-dead'])} 166G = dirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _573, fd:[0..3]}, _465, _466, _467, [], [], ['SUSP-_2391-susp'], ['SUSP-_2001-dead'])}, E{cardinal([[]:0, [[1, 2], [2, 3], [3, 1]]:3], Card{cardinal : _766, fd:[0..3]}, _658, _659, _660, [], ['SUSP-_2401-susp'], [], ['SUSP-_1717-dead'])}) 167 168?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E). 169V = V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _573, fd:[2, 3]}, _465, _466, _467, [], [], ['SUSP-_2363-susp'], ['SUSP-_1987-dead'])} 170E = E{cardinal([[[1, 2]]:1, [[2, 3], [3, 1]]:3], Card{cardinal : _763, fd:[1..3]}, _655, _656, _657, [], ['SUSP-_2373-susp'], [], ['SUSP-_1681-dead'])} 171G = dirgraph(V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _573, fd:[2, 3]}, _465, _466, _467, [], [], ['SUSP-_2363-susp'], ['SUSP-_1987-dead'])}, E{cardinal([[[1, 2]]:1, [[2, 3], [3, 1]]:3], Card{cardinal : _763, fd:[1..3]}, _655, _656, _657, [], ['SUSP-_2373-susp'], [], ['SUSP-_1681-dead'])}) 172 " 173 ] 174). 175 176dirgraph(dirgraph(VertexSet, EdgeSet), VertexSet, EdgeSet) :- 177 glb_poss(VertexSet, GLBVertex, PossVertex), 178 glb_poss(EdgeSet, GLBEdge, PossEdge), 179 graph(dirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex, GLBEdge, PossEdge). 180 181:- comment( 182 undirgraph/3, 183 [ 184 amode: undirgraph(-,+,+), 185 args: 186 [ 187 "Graph": "An undirected graph.", 188 "VertexSet": "The vertex-set that constitutes Graph.", 189 "EdgeSet": "The edge-set that constitutes Graph." 190 ], 191 summary: "Unirected graph constructor.", 192 desc: html("Creates Graph as an undirected graph variable composed by the vertexes in VertexSet and the edges in EdgeSet."), 193 fail_if: 194 "Fails 195 if VertexSet is not a set variable, 196 if EdgeSet is not a set variable or 197 if EdgeSet can not be contained in (VertexSet x VertexSet). 198 ", 199 eg: 200 " 201?- E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E). 202No. 203 204?- V`::[]..[1,2,3], undirgraph(G,V,E). 205No. 206 207?- V`::[]..[1,2,3], E`::[[4,5]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2],[4,5],[5,4]], undirgraph(G,V,E). 208No. 209 210?- V`::[]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E). 211V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _633, fd:[0..3]}, _525, _526, _527, [], [], ['SUSP-_2546-susp'], ['SUSP-_2156-dead'])} 212E = E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _842, fd:[0..6]}, _734, _735, _736, [], ['SUSP-_2556-susp'], [], ['SUSP-_1872-dead'])} 213G = undirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _633, fd:[0..3]}, _525, _526, _527, [], [], ['SUSP-_2546-susp'], ['SUSP-_2156-dead'])}, E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _842, fd:[0..6]}, _734, _735, _736, [], ['SUSP-_2556-susp'], [], ['SUSP-_1872-dead'])}) 214 215?- V`::[]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2],[4,5],[5,4]], undirgraph(G,V,E). 216V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _693, fd:[0..3]}, _585, _586, _587, [], [], ['SUSP-_2692-susp'], ['SUSP-_2302-dead'])} 217E = E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _918, fd:[0..6]}, _810, _811, _812, [], ['SUSP-_2702-susp'], [], ['SUSP-_2018-dead'])} 218G = undirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _693, fd:[0..3]}, _585, _586, _587, [], [], ['SUSP-_2692-susp'], ['SUSP-_2302-dead'])}, E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _918, fd:[0..6]}, _810, _811, _812, [], ['SUSP-_2702-susp'], [], ['SUSP-_2018-dead'])}) 219 220?- V`::[]..[1,2,3], E`::[[1,2],[2,1]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E). 221V = V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _693, fd:[2, 3]}, _585, _586, _587, [], [], ['SUSP-_3041-susp'], ['SUSP-_2651-dead'])} 222E = E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _917, fd:[2..6]}, _809, _810, _811, [], ['SUSP-_3051-susp'], [], ['SUSP-_1966-dead'])} 223G = undirgraph(V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _693, fd:[2, 3]}, _585, _586, _587, [], [], ['SUSP-_3041-susp'], ['SUSP-_2651-dead'])}, E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _917, fd:[2..6]}, _809, _810, _811, [], ['SUSP-_3051-susp'], [], ['SUSP-_1966-dead'])}) 224 " 225 ] 226). 227 228undirgraph(undirgraph(VertexSet, EdgeSet), VertexSet, EdgeSet) :- 229 symmetricEdges(EdgeSet), 230 glb_poss(VertexSet, GLBVertex, PossVertex), 231 glb_poss(EdgeSet, GLBEdge, PossEdge), 232 graph(undirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex, GLBEdge, PossEdge). 233 234:- comment( 235 symmetric/1, 236 [ 237 amode: symmetric(+), 238 args: 239 [ 240 "Graph": "A graph." 241 ], 242 summary: "Ensures Graph is symmetric", 243 desc: html("Ensures that for every edge (x,y) added to the Graph the symmetric edge (y,x) is also added.<br /> 244 Ensures that for every edge (x,y) removed from the Graph the symmetric edge (y,x) is also removed."), 245 fail_if: 246 "Fails 247 if Graph is not a graph variable or 248 if Graph can not be enforced to be symmetric. 249 ", 250 eg: 251 " 252?- symmetric(G). 253No. 254 255?- V`::[]..[1,2,3], E`::[[2,3]]..[[1,2],[1,3],[2,1],[2,3],[3,1]], dirgraph(G,V,E), symmetric(G). 256No. 257 258?- V`::[]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), symmetric(G). 259V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _628, fd:[0..3]}, _520, _521, _522, [], [], ['SUSP-_2494-susp'], ['SUSP-_2104-dead'])} 260E = E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [3, 1]]:4], Card{cardinal : _829, fd:[0..4]}, _721, _722, _723, [], ['SUSP-_3338-susp', 'SUSP-_2504-susp'], ['SUSP-_3347-susp'], ['SUSP-_3248-dead'])} 261G = dirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _628, fd:[0..3]}, _520, _521, _522, [], [], ['SUSP-_2494-susp'], ['SUSP-_2104-dead'])}, E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [3, 1]]:4], Card{cardinal : _829, fd:[0..4]}, _721, _722, _723, [], ['SUSP-_3338-susp', 'SUSP-_2504-susp'], ['SUSP-_3347-susp'], ['SUSP-_3248-dead'])}) 262 263?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), symmetric(G). 264V = V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _688, fd:[2, 3]}, _580, _581, _582, [], [], ['SUSP-_3503-dead', 'SUSP-_2633-susp'], ['SUSP-_3584-dead'])} 265E = E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _902, fd:[2..6]}, _794, _795, _796, [], ['SUSP-_4193-susp', 'SUSP-_2643-susp'], ['SUSP-_4202-susp'], ['SUSP-_4109-dead'])} 266G = dirgraph(V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _688, fd:[2, 3]}, _580, _581, _582, [], [], ['SUSP-_3503-dead', 'SUSP-_2633-susp'], ['SUSP-_3584-dead'])}, E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _902, fd:[2..6]}, _794, _795, _796, [], ['SUSP-_4193-susp', 'SUSP-_2643-susp'], ['SUSP-_4202-susp'], ['SUSP-_4109-dead'])}) 267 268?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1]], dirgraph(G,V,E), symmetric(G). 269V = V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _658, fd:[2, 3]}, _550, _551, _552, [], [], ['SUSP-_3426-dead', 'SUSP-_2556-susp'], ['SUSP-_3507-dead'])} 270E = E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [3, 1]]:4], Card{cardinal : _864, fd:[2..4]}, _756, _757, _758, [], ['SUSP-_4162-susp', 'SUSP-_2566-susp'], ['SUSP-_4171-susp'], ['SUSP-_4052-dead'])} 271G = dirgraph(V{cardinal([[1, 2]:2, [3]:3], Card{cardinal : _658, fd:[2, 3]}, _550, _551, _552, [], [], ['SUSP-_3426-dead', 'SUSP-_2556-susp'], ['SUSP-_3507-dead'])}, E{cardinal([[[1, 2], [2, 1]]:2, [[1, 3], [3, 1]]:4], Card{cardinal : _864, fd:[2..4]}, _756, _757, _758, [], ['SUSP-_4162-susp', 'SUSP-_2566-susp'], ['SUSP-_4171-susp'], ['SUSP-_4052-dead'])}) 272 " 273 ] 274). 275 276symmetric(Graph) :- 277 var(Graph),!,fail. 278symmetric(dirgraph(_,EdgeSet)) :- 279 symmetricEdges(EdgeSet). 280symmetric(undirgraph(_,_)). 281 282symmetricEdges(EdgeSet) :- 283 add_edge_add_sym_edge(EdgeSet), 284 rem_edge_rem_sym_edge(EdgeSet), 285 286 suspend(add_edge_add_sym_edge(EdgeSet), 5, EdgeSet->cardinal:glb, GLBSusp), 287 suspend(rem_edge_rem_sym_edge(EdgeSet), 5, EdgeSet->cardinal:lub, LUBSusp), 288 terminate_susps(kill_susps([GLBSusp, LUBSusp]), [EdgeSet]). 289 290%%% 291% - In a symmetric graph, if an edge is added then its symmetric edge must also be added 292% - O(m) 293%%% 294 295:- demon add_edge_add_sym_edge/1. 296 297add_edge_add_sym_edge(EdgeSet) :- 298 glb(EdgeSet, GLBEdge), 299 findall([Y,X], member([X,Y], GLBEdge), SubEdgeSet), 300 SubEdgeSet `< EdgeSet. 301 302%%% 303% - In a symmetric graph, if an edge is removed then its symmetric edge must also be removed 304% - O(m) 305%%% 306 307:- demon rem_edge_rem_sym_edge/1. 308 309rem_edge_rem_sym_edge(EdgeSet) :- 310 lub(EdgeSet, LUBEdge), 311 hash_create(EdgeHash), 312 hash_add_all(EdgeHash, LUBEdge), 313 findall([X,Y], (member([X,Y], LUBEdge), \+hash_contains(EdgeHash,[Y,X])), NotPossEdges), 314 EdgeSet `$ NotPossEdges. 315 316:- comment( 317 asymmetric/1, 318 [ 319 amode: asymmetric(+), 320 args: 321 [ 322 "Graph": "A graph." 323 ], 324 summary: "Ensures Graph is asymmetric", 325 desc: html("Ensures that for every edge (x,y) added to the Graph the symmetric edge (y,x) is removed."), 326 resat: "?", 327 fail_if: 328 "Fails 329 if Graph is not a graph variable or 330 if Graph can not be enforced to be asymmetric. 331 ", 332 eg: 333 " 334?- asymmetric(G). 335No. 336 337?- V`::[]..[1,2,3], E`::[[2,3],[3,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), asymmetric(G). 338No. 339 340?- V`::[]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), asymmetric(G). 341V = V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _658, fd:[0..3]}, _550, _551, _552, [], [], ['SUSP-_2571-susp'], ['SUSP-_2181-dead'])} 342E = E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _867, fd:[0..6]}, _759, _760, _761, [], ['SUSP-_3006-susp', 'SUSP-_2581-susp'], [], ['SUSP-_2882-dead'])} 343G = dirgraph(V{cardinal([[]:0, [1, 2, 3]:3], Card{cardinal : _658, fd:[0..3]}, _550, _551, _552, [], [], ['SUSP-_2571-susp'], ['SUSP-_2181-dead'])}, E{cardinal([[]:0, [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]:6], Card{cardinal : _867, fd:[0..6]}, _759, _760, _761, [], ['SUSP-_3006-susp', 'SUSP-_2581-susp'], [], ['SUSP-_2882-dead'])}) 344 345?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), asymmetric(G). 346V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _688, fd : [2, 3]}, _580, _581, _582, [], [], ['SUSP-_2633-susp'], ['SUSP-_2243-dead'])} 347E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 3], [3, 1], [3, 2]] : 5], Card{cardinal : _902, fd : [1 .. 5]}, _794, _795, _796, [], ['SUSP-_3117-susp', 'SUSP-_2643-susp'], [], ['SUSP-_2970-dead'])} 348G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _688, fd : [2, 3]}, _580, _581, _582, [], [], ['SUSP-_2633-susp'], ['SUSP-_2243-dead'])}, E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 3], [3, 1], [3, 2]] : 5], Card{cardinal : _902, fd : [1 .. 5]}, _794, _795, _796, [], ['SUSP-_3117-susp', 'SUSP-_2643-susp'], [], ['SUSP-_2970-dead'])}) 349 350?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1]], dirgraph(G,V,E), asymmetric(G). 351V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _658, fd : [2, 3]}, _550, _551, _552, [], [], ['SUSP-_2556-susp'], ['SUSP-_2166-dead'])} 352E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 3], [3, 1]] : 4], Card{cardinal : _864, fd : [1 .. 4]}, _756, _757, _758, [], ['SUSP-_3040-susp', 'SUSP-_2566-susp'], [], ['SUSP-_2893-dead'])} 353G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _658, fd : [2, 3]}, _550, _551, _552, [], [], ['SUSP-_2556-susp'], ['SUSP-_2166-dead'])}, E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 3], [3, 1]] : 4], Card{cardinal : _864, fd : [1 .. 4]}, _756, _757, _758, [], ['SUSP-_3040-susp', 'SUSP-_2566-susp'], [], ['SUSP-_2893-dead'])}) 354 " 355 ] 356). 357 358asymmetric(G) :- 359 var(G),!,fail. 360asymmetric(dirgraph(_,EdgeSet)) :- 361 asymmetricEdges(EdgeSet). 362 363asymmetricEdges(EdgeSet) :- 364 add_edge_rem_sym_edge(EdgeSet), 365 366 suspend(add_edge_rem_sym_edge(EdgeSet), 5, EdgeSet->cardinal:glb, GLBSusp), 367 terminate_susps(kill_susps([GLBSusp]), [EdgeSet]). 368 369%%% 370% - In an asymmetric graph, if an edge is added then its symmetric edge must be removed 371% - O(m) 372%%% 373 374:- demon add_edge_rem_sym_edge/1. 375 376add_edge_rem_sym_edge(EdgeSet) :- 377 glb(EdgeSet, GLBEdge), 378 findall([Y,X], member([X,Y], GLBEdge), NotPossEdges), 379 NotPossEdges `$ EdgeSet. 380 381graph(dirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex, GLBEdge, PossEdge) :- 382 setVertexSet(dirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex), 383 setEdgeSet(dirgraph(VertexSet, EdgeSet), GLBEdge, PossEdge), 384 graph_aux(VertexSet, EdgeSet). 385graph(undirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex, GLBEdge, PossEdge) :- 386 setVertexSet(undirgraph(VertexSet, EdgeSet), GLBVertex, PossVertex), 387 setEdgeSet(undirgraph(VertexSet, EdgeSet), GLBEdge, PossEdge), 388 graph_aux(VertexSet, EdgeSet). 389 390graph_aux(VertexSet, EdgeSet) :- 391 rem_vertex_rem_edges(VertexSet, EdgeSet), 392 add_edge_add_vertices(VertexSet, EdgeSet), 393 394 cardinality(VertexSet, VertexCard), 395 cardinality(EdgeSet, EdgeCard), 396 EdgeCard #<= (VertexCard * VertexCard), 397 suspend(rem_vertex_rem_edges(VertexSet, EdgeSet), 4, VertexSet->cardinal:lub, VSusp), 398 suspend(add_edge_add_vertices(VertexSet, EdgeSet), 4, EdgeSet->cardinal:glb, ESusp), 399 terminate_susps(kill_susps([VSusp,ESusp]), [VertexSet,EdgeSet]). 400 401%%% 402% - The removal of a vertex imposes the removal of every edge which is incident on it 403% - O(m + n) 404%%% 405 406:- demon rem_vertex_rem_edges/2. 407 408rem_vertex_rem_edges(VertexSet, EdgeSet) :- 409 lub(VertexSet, LUBVertex), 410 hash_create(VertexHash), 411 hash_add_all(VertexHash, LUBVertex), 412 lub(EdgeSet, LUBEdge), 413 findall([X,Y], (member([X,Y], LUBEdge), hash_contains(VertexHash,X), hash_contains(VertexHash,Y)), PossEdges), 414 EdgeSet `< PossEdges. 415 416%%% 417% - The addition of an edge imposes the addition of every vertex on which the edge is incident 418% - O(m + n) 419%%% 420 421:- demon add_edge_add_vertices/2. 422 423add_edge_add_vertices(VertexSet, EdgeSet) :- 424 glb(EdgeSet, GLBEdge), 425 all_union(GLBEdge, SubVertexSet), 426 SubVertexSet `< VertexSet. 427 428:- comment( 429 getVertexSet/2, 430 [ 431 amode: getVertexSet(+,?), 432 args: 433 [ 434 "Graph": "A graph.", 435 "VertexSet": "Graph's vertex-set." 436 ], 437 summary: "Obtains a graph's vertex-set.", 438 desc: html("Obtains a graph's vertex-set."), 439 fail_if: 440 "Fails 441 if Graph is not a graph variable or 442 if VertexSet can not be matched with Graph's vertex-set. 443 ", 444 eg: 445 " 446?- getVertexSet(G,V). 447No. 448 449?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getVertexSet(G,[2,3]). 450No. 451 452?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getVertexSet(G,V_1). 453V = V_1{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])} 454E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])} 455G = dirgraph(V_1{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])}, E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])}) 456V_1 = V_1{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])} 457 458?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getVertexSet(G,[1,2]). 459V = [1, 2] 460E = E{cardinal([[[1, 2]] : 1, [[2, 1]] : 2], Card{cardinal : _962, fd : [1, 2]}, _854, _855, _856, [], ['SUSP-_3006-dead', 'SUSP-_2703-susp'], [], ['SUSP-_3312-dead'])} 461G = dirgraph([1, 2], E{cardinal([[[1, 2]] : 1, [[2, 1]] : 2], Card{cardinal : _962, fd : [1, 2]}, _854, _855, _856, [], ['SUSP-_3006-dead', 'SUSP-_2703-susp'], [], ['SUSP-_3312-dead'])}) 462 463?- V`::[]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), V_1`::[]..[1,2], getVertexSet(G,V_1). 464V = V{cardinal([[] : 0, [1, 2] : 2], Card{cardinal : _730, fd : [0 .. 2]}, Min1, Max1, Union2, [], [], ['SUSP-_2643-susp'], [])} 465E = E{cardinal([[] : 0, [[1, 2], [2, 1]] : 2], Card{cardinal : _939, fd : [0 .. 2]}, _831, _832, _833, [], ['SUSP-_3239-dead', 'SUSP-_2653-susp'], [], ['SUSP-_3547-dead'])} 466G = dirgraph(V{cardinal([[] : 0, [1, 2] : 2], Card{cardinal : _730, fd : [0 .. 2]}, Min1, Max1, Union2, [], [], ['SUSP-_2643-susp'], [])}, E{cardinal([[] : 0, [[1, 2], [2, 1]] : 2], Card{cardinal : _939, fd : [0 .. 2]}, _831, _832, _833, [], ['SUSP-_3239-dead', 'SUSP-_2653-susp'], [], ['SUSP-_3547-dead'])}) 467V_1 = V{cardinal([[] : 0, [1, 2] : 2], Card{cardinal : _730, fd : [0 .. 2]}, Min1, Max1, Union2, [], [], ['SUSP-_2643-susp'], [])} 468 " 469 ] 470). 471 472getVertexSet(Graph,_) :- 473 var(Graph),!,fail. 474getVertexSet(dirgraph(VertexSet, _), VertexSet). 475getVertexSet(undirgraph(VertexSet, _), VertexSet). 476 477setVertexSet(Graph, GLBVertex, PossVertex) :- 478 getVertexSet(Graph, VertexSet), 479 VertexSet`::GLBVertex..PossVertex. 480 481:- comment( 482 getEdgeSet/2, 483 [ 484 amode: getEdgeSet(+,?), 485 args: 486 [ 487 "Graph": "A graph.", 488 "EdgeSet": "Graph's edge-set." 489 ], 490 summary: "Obtains a graph's edge-set.", 491 desc: html("Obtains a graph's edge-set."), 492 fail_if: 493 "Fails 494 if Graph is not a graph variable or 495 if EdgeSet can not be matched with Graph's edge-set. 496 ", 497 eg: 498 " 499?- getEdgeSet(G,E). 500No. 501 502?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getEdgeSet(G,[[2,3],[3,2]]). 503No. 504 505?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getEdgeSet(G,E_1). 506V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])} 507E = E_1{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])} 508G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])}, E_1{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])}) 509E_1 = E_1{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])} 510 511?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), getEdgeSet(G,[[1,2],[2,3],[3,1]]). 512V = [1, 2, 3] 513E = [[1, 2], [2, 3], [3, 1]] 514G = dirgraph([1, 2, 3], [[1, 2], [2, 3], [3, 1]]) 515 516?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), E_1`::[]..[[1,2],[2,3],[3,1]], getEdgeSet(G,E_1). 517V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _830, fd : [2, 3]}, _722, _723, _724, [], [], ['SUSP-_2775-susp'], ['SUSP-_2385-dead'])} 518E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _1044, fd : [1 .. 3]}, Min1, Max1, Union2, [], ['SUSP-_2785-susp'], [], [])} 519G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _830, fd : [2, 3]}, _722, _723, _724, [], [], ['SUSP-_2775-susp'], ['SUSP-_2385-dead'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _1044, fd : [1 .. 3]}, Min1, Max1, Union2, [], ['SUSP-_2785-susp'], [], [])}) 520E_1 = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _1044, fd : [1 .. 3]}, Min1, Max1, Union2, [], ['SUSP-_2785-susp'], [], [])} 521 " 522 ] 523). 524 525getEdgeSet(Graph, _) :- 526 var(Graph),!,fail. 527getEdgeSet(dirgraph(_, EdgeSet), EdgeSet). 528getEdgeSet(undirgraph(_, EdgeSet), EdgeSet). 529 530setEdgeSet(Graph, GLBEdge, PossEdge) :- 531 getEdgeSet(Graph, EdgeSet), 532 EdgeSet`::GLBEdge+PossEdge. 533 534:- comment( 535 order/2, 536 [ 537 amode: order(+,?), 538 args: 539 [ 540 "Graph": "A graph.", 541 "Order": "The order of the graph." 542 ], 543 summary: "Obtains a graph's order.", 544 desc: html("Determines the number of vertices composing a graph variable."), 545 fail_if: 546 "Fails 547 if Graph is not a graph variable or 548 if Graph can not be constrained to have a vertex-set with a cardinality delimited by Order. 549 ", 550 eg: 551 " 552?- order(Graph,Order). 553No. 554 555?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), order(G,0). 556No. 557 558?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), order(G,4). 559No. 560 561?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), order(G,Order). 562V = V{cardinal([[1, 2] : 2, [3] : 3], Order{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])} 563E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])} 564G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Order{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])}, E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])}) 565Order = Order{cardinal : _700, fd : [2, 3]} 566 567?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), order(G,2). 568V = [1, 2] 569E = E{cardinal([[[1, 2]] : 1, [[2, 1]] : 2], Card{cardinal : _909, fd : [1, 2]}, _801, _802, _803, [], ['SUSP-_2957-dead', 'SUSP-_2650-susp'], [], ['SUSP-_3263-dead'])} 570G = dirgraph([1, 2], E{cardinal([[[1, 2]] : 1, [[2, 1]] : 2], Card{cardinal : _909, fd : [1, 2]}, _801, _802, _803, [], ['SUSP-_2957-dead', 'SUSP-_2650-susp'], [], ['SUSP-_3263-dead'])}) 571 572?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), order(G,3). 573V = [1, 2, 3] 574E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _909, fd : [1 .. 6]}, _801, _802, _803, [], ['SUSP-_2650-susp'], [], ['SUSP-_1944-dead'])} 575G = dirgraph([1, 2, 3], E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _909, fd : [1 .. 6]}, _801, _802, _803, [], ['SUSP-_2650-susp'], [], ['SUSP-_1944-dead'])}) 576 " 577 ] 578). 579 580order(Graph, _) :- 581 var(Graph),!,fail. 582order(dirgraph(VertexSet,_), Order) :- 583 cardinality(VertexSet, Order). 584order(undirgraph(VertexSet,_), Order) :- 585 cardinality(VertexSet, Order). 586 587:- comment( 588 size/2, 589 [ 590 amode: size(+,?), 591 args: 592 [ 593 "Graph": "A graph.", 594 "Size": "The size of the graph." 595 ], 596 summary: "Obtains a graph's size.", 597 desc: html("Determines the number of edges composing a graph variable."), 598 fail_if: 599 "Fails 600 if Graph is not a graph variable or 601 if Graph can not be constrained to have an edge-set with a cardinality delimited by Size. 602 ", 603 eg: 604 " 605?- size(Graph,Size). 606No. 607 608?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), size(G,0). 609No. 610 611?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), size(G,7). 612No. 613 614?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), size(G,Size). 615V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])} 616E = E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Size{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])} 617G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_2645-susp'], ['SUSP-_2255-dead'])}, E{cardinal([[[1, 2]] : 1, [[1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] : 6], Size{cardinal : _914, fd : [1 .. 6]}, _806, _807, _808, [], ['SUSP-_2655-susp'], [], ['SUSP-_1949-dead'])}) 618Size = Size{cardinal : _914, fd : [1 .. 6]} 619 620?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E), size(G,Size). 621V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_3898-susp'], ['SUSP-_3508-dead'])} 622E = E{cardinal([[[1, 2], [2, 1]] : 2, [[1, 3], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [2 .. 6]}, _806, _807, _808, [], ['SUSP-_3908-susp', 'SUSP-_1758-susp'], ['SUSP-_1767-susp'], ['SUSP-_2823-dead'])} 623G = undirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _700, fd : [2, 3]}, _592, _593, _594, [], [], ['SUSP-_3898-susp'], ['SUSP-_3508-dead'])}, E{cardinal([[[1, 2], [2, 1]] : 2, [[1, 3], [2, 3], [3, 1], [3, 2]] : 6], Card{cardinal : _914, fd : [2 .. 6]}, _806, _807, _808, [], ['SUSP-_3908-susp', 'SUSP-_1758-susp'], ['SUSP-_1767-susp'], ['SUSP-_2823-dead'])}) 624Size = _4017{cardinal : _4022, fd : [1 .. 3]} 625 626?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), size(G,1). 627V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _695, fd : [2, 3]}, _587, _588, _589, [], [], ['SUSP-_2640-susp'], ['SUSP-_2250-dead'])} 628E = [[1, 2]] 629G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _695, fd : [2, 3]}, _587, _588, _589, [], [], ['SUSP-_2640-susp'], ['SUSP-_2250-dead'])}, [[1, 2]]) 630 631?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E), size(G,1). 632V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _695, fd : [2, 3]}, _587, _588, _589, [], [], ['SUSP-_3893-susp'], ['SUSP-_3503-dead'])} 633E = [[1, 2], [2, 1]] 634G = undirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _695, fd : [2, 3]}, _587, _588, _589, [], [], ['SUSP-_3893-susp'], ['SUSP-_3503-dead'])}, [[1, 2], [2, 1]]) 635 636?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(G,V,E), size(G,6). 637V = [1, 2, 3] 638E = [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] 639G = dirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]) 640 641?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E), size(G,3). 642V = [1, 2, 3] 643E = [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] 644G = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]) 645 " 646 ] 647). 648 649size(Graph, _) :- 650 var(Graph),!,fail. 651size(dirgraph(_,EdgeSet), Size) :- 652 cardinality(EdgeSet, Size). 653size(undirgraph(_,EdgeSet), Size) :- 654 cardinality(EdgeSet, Card), 655 Size #= Card / 2. 656 657:- comment( 658 subgraph/2, 659 [ 660 amode: subgraph(?,+), 661 args: 662 [ 663 "SubGraph": "A subgraph of Graph.", 664 "Graph": "A graph." 665 ], 666 summary: "Constraints SubGraph to be a subgraph of Graph.", 667 desc: html("Constraints SubGraph to be a subgraph of Graph."), 668 fail_if: 669 "Fails 670 if Graph is not a graph variable or 671 if SubGraph can not be constrained to be contained in Graph. 672 ", 673 eg: 674 " 675?- subgraph(SG,G). 676No. 677 678?- V`::[]..[1,2,3], SE`::[[4,5]]..[[1,2],[2,3],[3,1],[4,5]], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(SG,V,SE), dirgraph(G,V,E), subgraph(SG,G). 679No. 680 681?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), subgraph(SG,G). 682V = V{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _580, fd : [0 .. 3]}, _472, _473, _474, [], [], ['SUSP-_2766-susp', 'SUSP-_2352-susp'], ['SUSP-_2926-susp'])} 683E = E{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _765, fd : [0 .. 3]}, _657, _658, _659, [], ['SUSP-_2362-susp'], ['SUSP-_3323-susp'], ['SUSP-_3483-susp'])} 684G = dirgraph(V{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _580, fd : [0 .. 3]}, _472, _473, _474, [], [], ['SUSP-_2766-susp', 'SUSP-_2352-susp'], ['SUSP-_2926-susp'])}, E{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _765, fd : [0 .. 3]}, _657, _658, _659, [], ['SUSP-_2362-susp'], ['SUSP-_3323-susp'], ['SUSP-_3483-susp'])}) 685SG = dirgraph(SubVertexSet{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _2576, fd : [0 .. 3]}, _2468, _2469, _2470, [], ['SUSP-_2648-susp'], ['SUSP-_5069-susp'], ['SUSP-_4679-dead', 'SUSP-_2926-susp'])}, SubEdgeSet{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _3133, fd : [0 .. 3]}, _3025, _3026, _3027, [], ['SUSP-_5079-susp', 'SUSP-_3205-susp'], [], ['SUSP-_4395-dead', 'SUSP-_3483-susp'])}) 686 687?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), subgraph(SG,G), getVertexSet(G,VSet), 1 `-@ VSet. 688V = VSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _645, fd : [0 .. 2]}, _537, _538, _539, [], [], ['SUSP-_2831-susp', 'SUSP-_2417-susp'], ['SUSP-_2991-susp'])} 689E = E{cardinal([[] : 0, [[2, 3]] : 1], Card{cardinal : _830, fd : [0, 1]}, _722, _723, _724, [], ['SUSP-_6162-dead', 'SUSP-_2427-susp'], ['SUSP-_3388-susp'], ['SUSP-_6513-dead', 'SUSP-_3548-susp'])} 690G = dirgraph(VSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _645, fd : [0 .. 2]}, _537, _538, _539, [], [], ['SUSP-_2831-susp', 'SUSP-_2417-susp'], ['SUSP-_2991-susp'])}, E{cardinal([[] : 0, [[2, 3]] : 1], Card{cardinal : _830, fd : [0, 1]}, _722, _723, _724, [], ['SUSP-_6162-dead', 'SUSP-_2427-susp'], ['SUSP-_3388-susp'], ['SUSP-_6513-dead', 'SUSP-_3548-susp'])}) 691SG = dirgraph(SubVertexSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _2641, fd : [0 .. 2]}, _2533, _2534, _2535, [], ['SUSP-_2713-susp'], ['SUSP-_5134-susp'], ['SUSP-_4744-dead', 'SUSP-_2991-susp'])}, SubEdgeSet{cardinal([[] : 0, [[2, 3]] : 1], Card{cardinal : _3198, fd : [0, 1]}, _3090, _3091, _3092, [], ['SUSP-_5697-dead', 'SUSP-_5144-susp', 'SUSP-_3270-susp'], [], ['SUSP-_5949-dead', 'SUSP-_3548-susp'])}) 692VSet = VSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _645, fd : [0 .. 2]}, _537, _538, _539, [], [], ['SUSP-_2831-susp', 'SUSP-_2417-susp'], ['SUSP-_2991-susp'])} 693 694?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), subgraph(SG,G), getVertexSet(SG,VSet), 1 `-@ VSet. 695V = V{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _645, fd : [0 .. 3]}, _537, _538, _539, [], [], ['SUSP-_2831-susp', 'SUSP-_2417-susp'], ['SUSP-_2991-susp'])} 696E = E{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _830, fd : [0 .. 3]}, _722, _723, _724, [], ['SUSP-_2427-susp'], ['SUSP-_3388-susp'], ['SUSP-_3548-susp'])} 697G = dirgraph(V{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _645, fd : [0 .. 3]}, _537, _538, _539, [], [], ['SUSP-_2831-susp', 'SUSP-_2417-susp'], ['SUSP-_2991-susp'])}, E{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _830, fd : [0 .. 3]}, _722, _723, _724, [], ['SUSP-_2427-susp'], ['SUSP-_3388-susp'], ['SUSP-_3548-susp'])}) 698SG = dirgraph(VSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _2641, fd : [0 .. 2]}, _2533, _2534, _2535, [], ['SUSP-_2713-susp'], ['SUSP-_5134-susp'], ['SUSP-_4744-dead', 'SUSP-_2991-susp'])}, SubEdgeSet{cardinal([[] : 0, [[2, 3]] : 1], Card{cardinal : _3198, fd : [0, 1]}, _3090, _3091, _3092, [], ['SUSP-_5481-dead', 'SUSP-_5144-susp', 'SUSP-_3270-susp'], [], ['SUSP-_5733-dead', 'SUSP-_3548-susp'])}) 699VSet = VSet{cardinal([[] : 0, [2, 3] : 2], Card{cardinal : _2641, fd : [0 .. 2]}, _2533, _2534, _2535, [], ['SUSP-_2713-susp'], ['SUSP-_5134-susp'], ['SUSP-_4744-dead', 'SUSP-_2991-susp'])} 700 701?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), subgraph(SG,G), getEdgeSet(G,ESet), [1,2] `@ ESet. 702V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _665, fd : [2, 3]}, _557, _558, _559, [], [], ['SUSP-_5574-dead', 'SUSP-_2851-susp', 'SUSP-_2437-susp'], ['SUSP-_5655-dead', 'SUSP-_3011-susp'])} 703E = ESet{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _850, fd : [1 .. 3]}, _742, _743, _744, [], ['SUSP-_2447-susp'], ['SUSP-_3408-susp'], ['SUSP-_3568-susp'])} 704G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _665, fd : [2, 3]}, _557, _558, _559, [], [], ['SUSP-_5574-dead', 'SUSP-_2851-susp', 'SUSP-_2437-susp'], ['SUSP-_5655-dead', 'SUSP-_3011-susp'])}, ESet{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _850, fd : [1 .. 3]}, _742, _743, _744, [], ['SUSP-_2447-susp'], ['SUSP-_3408-susp'], ['SUSP-_3568-susp'])}) 705SG = dirgraph(SubVertexSet{cardinal([[] : 0, [1, 2, 3] : 3], Card{cardinal : _2661, fd : [0 .. 3]}, _2553, _2554, _2555, [], ['SUSP-_2733-susp'], ['SUSP-_5154-susp'], ['SUSP-_4764-dead', 'SUSP-_3011-susp'])}, SubEdgeSet{cardinal([[] : 0, [[1, 2], [2, 3], [3, 1]] : 3], Card{cardinal : _3218, fd : [0 .. 3]}, _3110, _3111, _3112, [], ['SUSP-_5164-susp', 'SUSP-_3290-susp'], [], ['SUSP-_4480-dead', 'SUSP-_3568-susp'])}) 706ESet = ESet{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _850, fd : [1 .. 3]}, _742, _743, _744, [], ['SUSP-_2447-susp'], ['SUSP-_3408-susp'], ['SUSP-_3568-susp'])} 707 708?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), subgraph(SG,G), getEdgeSet(SG,ESet), [1,2] `@ ESet. 709V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _665, fd : [2, 3]}, _557, _558, _559, [], [], ['SUSP-_5768-dead', 'SUSP-_2851-susp', 'SUSP-_2437-susp'], ['SUSP-_5849-dead', 'SUSP-_3011-susp'])} 710E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _850, fd : [1 .. 3]}, _742, _743, _744, [], ['SUSP-_2447-susp'], ['SUSP-_3408-susp'], ['SUSP-_3568-susp'])} 711G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _665, fd : [2, 3]}, _557, _558, _559, [], [], ['SUSP-_5768-dead', 'SUSP-_2851-susp', 'SUSP-_2437-susp'], ['SUSP-_5849-dead', 'SUSP-_3011-susp'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _850, fd : [1 .. 3]}, _742, _743, _744, [], ['SUSP-_2447-susp'], ['SUSP-_3408-susp'], ['SUSP-_3568-susp'])}) 712SG = dirgraph(SubVertexSet{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _2661, fd : [2, 3]}, _2553, _2554, _2555, [], ['SUSP-_2733-susp'], ['SUSP-_6246-dead', 'SUSP-_5154-susp'], ['SUSP-_6327-dead', 'SUSP-_3011-susp'])}, ESet{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _3218, fd : [1 .. 3]}, _3110, _3111, _3112, [], ['SUSP-_5164-susp', 'SUSP-_3290-susp'], [], ['SUSP-_4480-dead', 'SUSP-_3568-susp'])}) 713ESet = ESet{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _3218, fd : [1 .. 3]}, _3110, _3111, _3112, [], ['SUSP-_5164-susp', 'SUSP-_3290-susp'], [], ['SUSP-_4480-dead', 'SUSP-_3568-susp'])} 714 " 715 ] 716). 717 718subgraph(_, Graph) :- 719 var(Graph),!,fail. 720subgraph(SubGraph, dirgraph(VertexSet, EdgeSet)) :- 721 SubVertexSet `< VertexSet, 722 SubEdgeSet `< EdgeSet, 723 dirgraph(SubGraph, SubVertexSet, SubEdgeSet). 724subgraph(SubGraph, undirgraph(VertexSet, EdgeSet)) :- 725 SubVertexSet `< VertexSet, 726 SubEdgeSet `< EdgeSet, 727 undirgraph(SubGraph, SubVertexSet, SubEdgeSet). 728 729induced_subgraph(SubGraph, Graph) :- 730 subgraph(SubGraph, Graph), 731 getVertexSet(SubGraph, SubNodes), 732 getEdgeSet(SubGraph, SubArcs), 733 getEdgeSet(Graph, Arcs), 734 735 add_node_add_all_arcs(SubNodes, Arcs, SubArcs), 736 737 suspend(add_node_add_all_arcs(SubNodes, Arcs, SubArcs), 5, SubNodes->cardinal:glb, NodesSusp), 738 suspend(add_node_add_all_arcs(SubNodes, Arcs, SubArcs), 5, Arcs->cardinal:glb, ArcsSusp), 739 terminate_susps(kill_susps([NodesSusp,ArcsSusp]), [SubNodes,Arcs]). 740 741%%% 742% - Adding a node to an induced subgraph makes all arcs in the original graph that are incident on nodes already in the induced subgraph's glb to be added to the induced graph 743% - O(m_2 + n_1) 744%%% 745 746:- demon add_node_add_all_arcs/3. 747 748add_node_add_all_arcs(Nodes, Arcs, InducedArcs) :- 749 glb(Nodes, GLBNodes), 750 hash_create(NodesHash), 751 hash_add_all(NodesHash, GLBNodes), 752 glb(Arcs, GLBArcs), 753 findall([X,Y], (member([X,Y], GLBArcs), hash_contains(NodesHash,X), hash_contains(NodesHash,Y)), SubArcs), 754 SubArcs `< InducedArcs. 755 756:- comment( 757 weight/3, 758 [ 759 amode: weight(+,+,?), 760 args: 761 [ 762 "Graph": "A graph.", 763 "WeightHash": "An hashtable an hashtable matching some elements (vertex or edge) of Graph to a positive weight. An unweighed element will be considered to have weight 0.", 764 "Weight": "The sum of the graph's vertices' and edges' weights." 765 ], 766 summary: "Calculates the Weight of Graph given a WeightHash.", 767 desc: html("Calculates the Weight of Graph given a WeightHash."), 768 fail_if: 769 "Fails 770 if Graph is not a graph variable, 771 if Weight is not an hash variable (lib(hash)) with positive integer weights or 772 if Graph can not be constrained to have a weight delimited by Weight. 773 ", 774 eg: 775 " 776?- weight(G,WH,W). 777No. 778 779?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), weight(G,WH,W). 780instantiation fault in term_hash(1, -1, Size, _2486) 781Abort 782 783?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), hash_create(WH), hash_add(WH,1,1), hash_add(WH,2,1), hash_add(WH,3,1), hash_add(WH,[1,2],1), hash_add(WH,[2,3],1), hash_add(WH,[3,1],1), weight(G,WH,0). 784No. 785 786?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), hash_create(WH), hash_add(WH,1,1), hash_add(WH,2,1), hash_add(WH,3,1), hash_add(WH,[1,2],1), hash_add(WH,[2,3],1), hash_add(WH,[3,1],1), weight(G,WH,7). 787No. 788 789?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), hash_create(WH), hash_add(WH,1,1), hash_add(WH,2,1), hash_add(WH,3,1), hash_add(WH,[1,2],1), hash_add(WH,[2,3],1), hash_add(WH,[3,1],1), weight(G,WH,W). 790V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _941, fd : [2, 3]}, _833, _834, _835, [], ['SUSP-_3104-susp'], ['SUSP-_3130-susp', 'SUSP-_2731-susp'], ['SUSP-_2355-dead'])} 791E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _1131, fd : [1 .. 3]}, _1023, _1024, _1025, [], ['SUSP-_3117-susp', 'SUSP-_2741-susp'], ['SUSP-_3143-susp'], ['SUSP-_2049-dead'])} 792G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _941, fd : [2, 3]}, _833, _834, _835, [], ['SUSP-_3104-susp'], ['SUSP-_3130-susp', 'SUSP-_2731-susp'], ['SUSP-_2355-dead'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1]] : 3], Card{cardinal : _1131, fd : [1 .. 3]}, _1023, _1024, _1025, [], ['SUSP-_3117-susp', 'SUSP-_2741-susp'], ['SUSP-_3143-susp'], ['SUSP-_2049-dead'])}) 793WH = hash(4, 6, [[3, 1] -> 1, [2, 3] -> 1, 1 -> 1, 2 -> 1, [1, 2] -> 1, 3 -> 1]) 794W = W{cardinal : _3033, fd : [3 .. 6]} 795 796?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), hash_create(WH), hash_add(WH,1,1), hash_add(WH,2,1), hash_add(WH,3,1), hash_add(WH,[1,2],1), hash_add(WH,[2,3],1), hash_add(WH,[3,1],1), weight(G,WH,3). 797V = [1, 2] 798E = [[1, 2]] 799G = dirgraph([1, 2], [[1, 2]]) 800WH = hash(4, 6, [[3, 1] -> 1, [2, 3] -> 1, 1 -> 1, 2 -> 1, [1, 2] -> 1, 3 -> 1]) 801 802?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), hash_create(WH), hash_add(WH,1,1), hash_add(WH,2,1), hash_add(WH,3,1), hash_add(WH,[1,2],1), hash_add(WH,[2,3],1), hash_add(WH,[3,1],1), weight(G,WH,6). 803V = [1, 2, 3] 804E = [[1, 2], [2, 3], [3, 1]] 805G = dirgraph([1, 2, 3], [[1, 2], [2, 3], [3, 1]]) 806WH = hash(4, 6, [[3, 1] -> 1, [2, 3] -> 1, 1 -> 1, 2 -> 1, [1, 2] -> 1, 3 -> 1]) 807 " 808 ] 809). 810 811weight(Graph, _, _) :- 812 var(Graph),!,fail. 813weight(dirgraph(VertexSet, EdgeSet), WeightHash, Weight) :- 814 my_weight_aux(VertexSet, EdgeSet, WeightHash, Weight). 815weight(undirgraph(VertexSet, EdgeSet), WeightHash, Weight) :- 816 my_weight_aux(VertexSet, EdgeSet, WeightHash, Weight). 817 818my_weight_aux(VertexSet, EdgeSet, WeightHash, Weight) :- 819 glb_poss(VertexSet, GLBVertex, PossVertex), 820 glb_poss(EdgeSet, GLBEdge, PossEdge), 821 set_weight(GLBVertex, GLBEdge, WeightHash, MinWeight), 822 set_weight(PossVertex, PossEdge, WeightHash, IncWeight), 823 MaxWeight is MinWeight + IncWeight, 824 825 (var(Weight) -> 826 Weight #>= MinWeight, Weight #<= MaxWeight; 827 ( 828 Weight #>= MinWeight, Weight #<= MaxWeight, 829 change_weight_change_graph(Weight, VertexSet, EdgeSet, WeightHash) 830 ) 831 ), 832 833 suspend(change_weight_change_graph(Weight, VertexSet, EdgeSet, WeightHash), 3, Weight->fd:min, WeightmSusp), 834 suspend(change_weight_change_graph(Weight, VertexSet, EdgeSet, WeightHash), 3, Weight->fd:max, WeightMSusp), 835 suspend(change_graph_change_weight(VertexSet, EdgeSet, WeightHash, glb, Weight), 3, VertexSet->cardinal:glb, GraphGVSusp), 836 suspend(change_graph_change_weight(VertexSet, EdgeSet, WeightHash, glb, Weight), 3, EdgeSet->cardinal:glb, GraphGESusp), 837 suspend(change_graph_change_weight(VertexSet, EdgeSet, WeightHash, lub, Weight), 3, VertexSet->cardinal:lub, GraphLVSusp), 838 suspend(change_graph_change_weight(VertexSet, EdgeSet, WeightHash, lub, Weight), 3, EdgeSet->cardinal:lub, GraphLESusp), 839 terminate_susps(kill_susps([WeightmSusp,WeightMSusp,GraphGVSusp,GraphGESusp,GraphLVSusp,GraphLESusp]), [Weight,VertexSet,EdgeSet]). 840 841set_weight(VertexSet, EdgeSet, WeightHash, Weight) :- 842 set_weight_aux(VertexSet, WeightHash, 0, NodesWeight), 843 set_weight_aux(EdgeSet, WeightHash, NodesWeight, Weight). 844 845set_weight_aux([], _, Weight, Weight). 846set_weight_aux([Elem|Elems], WeightHash, AcumWeight, Weight) :- 847 (hash_find(WeightHash, Elem, ElemWeight); ElemWeight = 0),!, 848 NewAcumWeight is AcumWeight + ElemWeight, 849 set_weight_aux(Elems, WeightHash, NewAcumWeight, Weight). 850 851%%% 852% - When the weight is changed the vertex-set and the edge-set may be updated 853% O(m + n) 854%%% 855 856:- demon change_weight_change_graph/4. 857 858change_weight_change_graph(Weight, VertexSet, EdgeSet, WeightHash) :- 859 mindomain(Weight, Min), 860 maxdomain(Weight, Max), 861 glb_poss(VertexSet, GLBVertex, PossVertex), 862 glb_poss(EdgeSet, GLBEdge, PossEdge), 863 set_weight(GLBVertex, GLBEdge, WeightHash, MinWeight), 864 set_weight(PossVertex, PossEdge, WeightHash, IncWeight), 865 MaxWeight is MinWeight + IncWeight, 866 check(VertexSet, WeightHash, MinWeight, MaxWeight, Min, Max), 867 check(EdgeSet, WeightHash, MinWeight, MaxWeight, Min, Max). 868 869check(ElemSet, WeightHash, MinWeight, MaxWeight, Min, Max) :- 870 poss(ElemSet, PossElem), 871 check(PossElem, WeightHash, MinWeight, MaxWeight, Min, Max, [], AddList, [], RemList), 872 AddList `< ElemSet, 873 RemList `$ ElemSet. 874 875check([], _, _, _, _, _, AddList, AddList, RemList, RemList). 876check([Elem|Elems], WeightHash, MinWeight, MaxWeight, Min, Max, AcumAddList, AddList, AcumRemList, RemList) :- 877 (hash_find(WeightHash, Elem, ElemWeight); ElemWeight = 0),!, 878 NewMinWeight is MinWeight + ElemWeight, 879 NewMaxWeight is MaxWeight - ElemWeight, 880 (NewMinWeight > Max -> 881 ( 882 NAcumAddList = AcumAddList, 883 NAcumRemList = [Elem|AcumRemList] 884 ); 885 (NewMaxWeight < Min -> 886 ( 887 NAcumAddList = [Elem|AcumAddList], 888 NAcumRemList = AcumRemList 889 ); 890 ( 891 NAcumAddList = AcumAddList, 892 NAcumRemList = AcumRemList 893 ) 894 ) 895 ), 896 check(Elems, WeightHash, MinWeight, MaxWeight, Min, Max, NAcumAddList, AddList, NAcumRemList, RemList). 897 898%%% 899% - When the graph is changed the weight must be updated 900% - O(m + n) 901%%% 902 903:- demon change_graph_change_weight/5. 904 905change_graph_change_weight(VertexSet, EdgeSet, WeightHash, Type, Weight) :- 906 (Type = glb -> 907 ( 908 glb(VertexSet, GLBVertex), 909 glb(EdgeSet, GLBEdge), 910 set_weight(GLBVertex, GLBEdge, WeightHash, MinWeight), 911 Weight #>= MinWeight 912 ); 913 ( 914 lub(VertexSet, LUBVertex), 915 lub(EdgeSet, LUBEdge), 916 set_weight(LUBVertex, LUBEdge, WeightHash, MaxWeight), 917 Weight #<= MaxWeight 918 ) 919 ). 920 921:- comment( 922 predecessors/3, 923 [ 924 amode: predecessors(+,+,?), 925 args: 926 [ 927 "Graph": "A graph.", 928 "Vertex": "A vertex of Graph.", 929 "PredSet": "Set of predecessors of Vertex in Graph." 930 ], 931 summary: "Determines the predecessor-set of a vertex in a graph.", 932 desc: html("Determines the predecessor-set of a vertex in a graph."), 933 fail_if: 934 "Fails 935 if Graph is not a graph variable, 936 if Vertex does not belong to Graph\'s vertex-set or 937 if Graph can not be constrained to have the vertices in PredSet as predecessors of Vertex. 938 ", 939 eg: 940 " 941?- predecessors(G,V,Preds). 942No. 943 944?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), predecessors(G,4,Preds). 945No. 946 947?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), predecessors(G,2,[1,3,4]). 948No. 949 950?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), predecessors(G,2,Preds). 951V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2921-susp', 'SUSP-_2484-susp'], ['SUSP-_3073-susp'])} 952E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3506-susp', 'SUSP-_2494-susp'], ['SUSP-_3518-susp'], ['SUSP-_1802-dead'])} 953G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2921-susp', 'SUSP-_2484-susp'], ['SUSP-_3073-susp'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3506-susp', 'SUSP-_2494-susp'], ['SUSP-_3518-susp'], ['SUSP-_1802-dead'])}) 954Preds = Preds{cardinal([[1] : 1, [3] : 2], PredCard{cardinal : _2731, fd : [1, 2]}, _2623, _2624, _2625, [], ['SUSP-_3530-susp', 'SUSP-_2803-susp'], ['SUSP-_3542-susp'], ['SUSP-_3073-susp'])} 955 956?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), predecessors(G,2,[1]). 957V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _652, fd : [2, 3]}, _544, _545, _546, [], [], ['SUSP-_2798-dead', 'SUSP-_2489-susp'], ['SUSP-_2879-dead'])} 958E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _850, fd : [1 .. 4]}, _742, _743, _744, [], ['SUSP-_2939-susp', 'SUSP-_2499-susp'], ['SUSP-_2951-susp'], ['SUSP-_1807-dead'])} 959G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _652, fd : [2, 3]}, _544, _545, _546, [], [], ['SUSP-_2798-dead', 'SUSP-_2489-susp'], ['SUSP-_2879-dead'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _850, fd : [1 .. 4]}, _742, _743, _744, [], ['SUSP-_2939-susp', 'SUSP-_2499-susp'], ['SUSP-_2951-susp'], ['SUSP-_1807-dead'])}) 960 961?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), predecessors(G,2,[1,3]). 962V = [1, 2, 3] 963E = E{cardinal([[[1, 2], [3, 2]]:2, [[2, 3], [3, 1]]:4], Card{cardinal : _860, fd:[2..4]}, _752, _753, _754, [], ['SUSP-_4324-susp', 'SUSP-_2509-susp'], ['SUSP-_4336-susp'], ['SUSP-_4141-dead'])} 964G = dirgraph([1, 2, 3], E{cardinal([[[1, 2], [3, 2]]:2, [[2, 3], [3, 1]]:4], Card{cardinal : _860, fd:[2..4]}, _752, _753, _754, [], ['SUSP-_4324-susp', 'SUSP-_2509-susp'], ['SUSP-_4336-susp'], ['SUSP-_4141-dead'])}) 965 " 966 ] 967). 968 969predecessors(Graph, _, _) :- 970 var(Graph),!,fail. 971predecessors(dirgraph(VertexSet,EdgeSet), Vertex, PredSet) :- 972 preds_aux(VertexSet, EdgeSet, Vertex, PredSet). 973predecessors(undirgraph(VertexSet,EdgeSet), Vertex, PredSet) :- 974 preds_aux(VertexSet, EdgeSet, Vertex, PredSet). 975 976preds_aux(VertexSet, _, Vertex, _) :- 977 lub(VertexSet, LUBVertex), 978 \+ord_memberchk(Vertex,LUBVertex), 979 !,fail. 980preds_aux(VertexSet, EdgeSet, Vertex, PredSet) :- 981 glb_poss(EdgeSet, GLBEdge, PossEdge), 982 findall(PredVertex, member([PredVertex, Vertex], GLBEdge), GLBPred), 983 findall(PredVertex, member([PredVertex, Vertex], PossEdge), PossPred), 984 985 (var(PredSet) -> 986 ( 987 PredSet`::GLBPred+PossPred, 988 PredSet `< VertexSet 989 ); 990 ( 991 PredSet`::GLBPred+PossPred, 992 PredSet `< VertexSet, 993 add_elem_add_arc(Vertex, preds, EdgeSet, PredSet), 994 rem_elem_rem_arc(Vertex, preds, EdgeSet, PredSet) 995 ) 996 ), 997 998 cardinality(PredSet, PredCard), 999 cardinality(EdgeSet, EdgeCard), 1000 PredCard #<= EdgeCard, 1001 1002 suspend(add_arc_add_elem(Vertex, preds, EdgeSet, PredSet), 9, EdgeSet->cardinal:glb, EGLBSusp), 1003 suspend(rem_arc_rem_elem(Vertex, preds, EdgeSet, PredSet), 9, EdgeSet->cardinal:lub, ELUBSusp), 1004 suspend(add_elem_add_arc(Vertex, preds, EdgeSet, PredSet), 9, PredSet->cardinal:glb, PGLBSusp), 1005 suspend(rem_elem_rem_arc(Vertex, preds, EdgeSet, PredSet), 9, PredSet->cardinal:lub, PLUBSusp), 1006 terminate_susps(kill_susps([EGLBSusp,ELUBSusp,PGLBSusp,PLUBSusp]), [EdgeSet,PredSet]). 1007 1008:- comment( 1009 successors/3, 1010 [ 1011 amode: successors(+,+,?), 1012 args: 1013 [ 1014 "Graph": "A graph.", 1015 "Vertex": "A vertex of Graph.", 1016 "SuccSet": "Set of successors of Vertex in Graph." 1017 ], 1018 summary: "Determines the successor-set of a vertex in a graph.", 1019 desc: html("Determines the successor-set of a vertex in a graph."), 1020 fail_if: 1021 "Fails 1022 if Graph is not a graph variable, 1023 if Vertex does not belong to Graph\'s vertex-set or 1024 if Graph can not be constrained to have the vertices in SuccSet as successors of Vertex. 1025 ", 1026 eg: 1027 " 1028?- successors(G,V,Succs). 1029No. 1030 1031?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), successors(G,4,Succs). 1032No. 1033 1034?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), successors(G,3,[1,3,4]). 1035No. 1036 1037?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), successors(G,3,Succs). 1038V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2921-susp', 'SUSP-_2484-susp'], ['SUSP-_3073-susp'])} 1039E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3359-susp', 'SUSP-_2494-susp'], ['SUSP-_3371-susp'], ['SUSP-_1802-dead'])} 1040G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2921-susp', 'SUSP-_2484-susp'], ['SUSP-_3073-susp'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3359-susp', 'SUSP-_2494-susp'], ['SUSP-_3371-susp'], ['SUSP-_1802-dead'])}) 1041Succs = Succs{cardinal([[] : 0, [1, 2] : 2], SuccCard{cardinal : _2731, fd : [0 .. 2]}, _2623, _2624, _2625, [], ['SUSP-_3383-susp', 'SUSP-_2803-susp'], ['SUSP-_3395-susp'], ['SUSP-_3073-susp'])} 1042 1043?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), successors(G,3,[1]). 1044V = [1, 2, 3] 1045E = E{cardinal([[[1, 2], [3, 1]]:2, [[2, 3]]:3], Card{cardinal : _850, fd:[2, 3]}, _742, _743, _744, [], ['SUSP-_4597-susp', 'SUSP-_2499-susp'], ['SUSP-_4609-susp'], ['SUSP-_4406-dead'])} 1046G = dirgraph([1, 2, 3], E{cardinal([[[1, 2], [3, 1]]:2, [[2, 3]]:3], Card{cardinal : _850, fd:[2, 3]}, _742, _743, _744, [], ['SUSP-_4597-susp', 'SUSP-_2499-susp'], ['SUSP-_4609-susp'], ['SUSP-_4406-dead'])}) 1047 1048?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), successors(G,3,[1,2]). 1049V = [1, 2, 3] 1050E = E{cardinal([[[1, 2], [3, 1], [3, 2]]:3, [[2, 3]]:4], Card{cardinal : _860, fd:[3, 4]}, _752, _753, _754, [], ['SUSP-_5007-susp', 'SUSP-_2509-susp'], ['SUSP-_5019-susp'], ['SUSP-_4830-dead'])} 1051G = dirgraph([1, 2, 3], E{cardinal([[[1, 2], [3, 1], [3, 2]]:3, [[2, 3]]:4], Card{cardinal : _860, fd:[3, 4]}, _752, _753, _754, [], ['SUSP-_5007-susp', 'SUSP-_2509-susp'], ['SUSP-_5019-susp'], ['SUSP-_4830-dead'])}) " 1052 ] 1053). 1054 1055successors(Graph, _, _) :- 1056 var(Graph),!,fail. 1057successors(dirgraph(VertexSet, EdgeSet), Vertex, SuccSet) :- 1058 succs_aux(VertexSet, EdgeSet, Vertex, SuccSet). 1059successors(undirgraph(VertexSet, EdgeSet), Vertex, SuccSet) :- 1060 succs_aux(VertexSet, EdgeSet, Vertex, SuccSet). 1061 1062succs_aux(VertexSet, _, Vertex, _) :- 1063 lub(VertexSet, LUBVertex), 1064 \+ord_memberchk(Vertex,LUBVertex), 1065 !,fail. 1066succs_aux(VertexSet, EdgeSet, Vertex, SuccSet) :- 1067 glb_poss(EdgeSet, GLBEdge, PossEdge), 1068 findall(SuccVertex, member([Vertex, SuccVertex], GLBEdge), GLBSucc), 1069 findall(SuccVertex, member([Vertex, SuccVertex], PossEdge), PossSucc), 1070 1071 (var(SuccSet) -> 1072 ( 1073 SuccSet`::GLBSucc+PossSucc, 1074 SuccSet `< VertexSet 1075 ); 1076 ( 1077 SuccSet`::GLBSucc+PossSucc, 1078 SuccSet `< VertexSet, 1079 add_elem_add_arc(Vertex, succs, EdgeSet, SuccSet), 1080 rem_elem_rem_arc(Vertex, succs, EdgeSet, SuccSet) 1081 ) 1082 ), 1083 1084 cardinality(SuccSet, SuccCard), 1085 cardinality(EdgeSet, EdgeCard), 1086 SuccCard #<= EdgeCard, 1087 1088 suspend(add_arc_add_elem(Vertex, succs, EdgeSet, SuccSet), 9, EdgeSet->cardinal:glb, EGLBSusp), 1089 suspend(rem_arc_rem_elem(Vertex, succs, EdgeSet, SuccSet), 9, EdgeSet->cardinal:lub, ELUBSusp), 1090 suspend(add_elem_add_arc(Vertex, succs, EdgeSet, SuccSet), 9, SuccSet->cardinal:glb, SGLBSusp), 1091 suspend(rem_elem_rem_arc(Vertex, succs, EdgeSet, SuccSet), 9, SuccSet->cardinal:lub, SLUBSusp), 1092 terminate_susps(kill_susps([EGLBSusp,ELUBSusp,SGLBSusp,SLUBSusp]), [EdgeSet,SuccSet]). 1093 1094%%% 1095% - The indication of a precedence between X and Y imposes the addition of the edge (X,Y) to the graph 1096% - The indication of a sucession between Y and X imposes the addition of the edge (X,Y) to the graph 1097% - O(m + n) 1098%%% 1099 1100:- demon add_elem_add_arc/4. 1101 1102add_elem_add_arc(Vertex, Type, EdgeSet, List) :- 1103 glb(List, GLBList), 1104 (Type == preds -> 1105 findall([Pred,Vertex], member(Pred, GLBList), SubEdgeSet); 1106 findall([Vertex,Succ], member(Succ, GLBList), SubEdgeSet) 1107 ), 1108 SubEdgeSet `< EdgeSet. 1109 1110%%% 1111% - The indication of a non-precedence between X and Y imposes the removal of the edge (X,Y) from the graph 1112% - The indication of a non-succession between Y and X imposes the removal of the edge (X,Y) from the graph 1113% - O(m + n) 1114%%% 1115 1116:- demon rem_elem_rem_arc/4. 1117 1118rem_elem_rem_arc(Vertex, Type, EdgeSet, List) :- 1119 lub(List, LUBList), 1120 hash_create(ListHash), 1121 hash_add_all(ListHash, LUBList), 1122 lub(EdgeSet, LUBEdge), 1123 (Type == preds -> 1124 findall([Pred,Vertex], (member([Pred,Vertex], LUBEdge), \+hash_contains(ListHash,Pred)), NotPossEdges); 1125 findall([Vertex,Succ], (member([Vertex,Succ], LUBEdge), \+hash_contains(ListHash,Succ)), NotPossEdges) 1126 ), 1127 NotPossEdges `$ EdgeSet. 1128 1129%%% 1130% - The indication of the occurence of the arc (X,Y) in the graph imposes the addition of X to the predecessors of Y 1131% - The indication of the occurence of the arc (X,Y) in the graph imposes the addition of Y to the successors of X 1132% - O(m + n) 1133%%% 1134 1135:- demon add_arc_add_elem/4. 1136 1137add_arc_add_elem(Vertex, Type, EdgeSet, List) :- 1138 glb(EdgeSet, GLBEdge), 1139 (Type = preds -> 1140 findall(Pred, member([Pred,Vertex], GLBEdge), SubList); 1141 findall(Succ, member([Vertex,Succ], GLBEdge), SubList)), 1142 SubList `< List. 1143 1144%%% 1145% - The indication of the non-occurence of the arc (X,Y) in the graph imposes the removal of X from the predecessors of Y 1146% - The indication of the non-occurence of the arc (X,Y) in the graph imposes the removal of Y from the successors of X 1147% - % O(m + n) 1148%%% 1149 1150:- demon rem_arc_rem_elem/4. 1151 1152rem_arc_rem_elem(Vertex, Type, EdgeSet, List) :- 1153 lub(EdgeSet, LUBEdge), 1154 (Type == preds -> 1155 findall(Pred, member([Pred,Vertex], LUBEdge), PossList); 1156 findall(Succ, member([Vertex,Succ], LUBEdge), PossList)), 1157 List `< PossList. 1158 1159:- comment( 1160 reachables/3, 1161 [ 1162 amode: reachables(+,+,?), 1163 args: 1164 [ 1165 "Graph": "A graph.", 1166 "SourceVertex": "A vertex of Graph.", 1167 "ReachSet": "Set of vertices reachable from SourceVertex in Graph." 1168 ], 1169 summary: "Determines the reachables-set of a vertex in a graph.", 1170 desc: html("Determines the reachables-set of a vertex in a graph."), 1171 fail_if: 1172 "Fails 1173 if Graph is not a graph variable, 1174 if SourceVertex does not belong to Graph\'s vertex-set or 1175 if Graph can not be constrained to have the vertices in ReachSet reachable from Vertex. 1176 ", 1177 eg: 1178 " 1179?- reachables(G,V,Reachs). 1180No. 1181 1182?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), reachables(G,4,Reachs). 1183No. 1184 1185?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), reachables(G,3,[1,3,4]). 1186No. 1187 1188?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), reachables(G,3,Reachs). 1189V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2484-susp'], ['SUSP-_2108-dead'])} 1190E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3145-susp', 'SUSP-_2494-susp'], ['SUSP-_3133-susp'], ['SUSP-_1802-dead'])} 1191G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _647, fd : [2, 3]}, _539, _540, _541, [], [], ['SUSP-_2484-susp'], ['SUSP-_2108-dead'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 1], [3, 2]] : 4], Card{cardinal : _845, fd : [1 .. 4]}, _737, _738, _739, [], ['SUSP-_3145-susp', 'SUSP-_2494-susp'], ['SUSP-_3133-susp'], ['SUSP-_1802-dead'])}) 1192Reachs = Reachs{cardinal([[3] : 1, [1, 2] : 3], Card{cardinal : _3086, fd : [1 .. 3]}, _2978, _2979, _2980, [], ['SUSP-_3121-susp'], ['SUSP-_3110-susp'], [])} 1193 1194?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), reachables(G,3,Reachs), 1 `@ Reachs. 1195V = [1, 2, 3] 1196E = E{cardinal([[[1, 2], [3, 1]] : 2, [[2, 3], [3, 2]] : 4], Card{cardinal : _873, fd : [2 .. 4]}, _765, _766, _767, [], ['SUSP-_3173-susp', 'SUSP-_2522-susp'], ['SUSP-_5570-dead', 'SUSP-_3161-susp'], ['SUSP-_5651-dead'])} 1197G = dirgraph([1, 2, 3], E{cardinal([[[1, 2], [3, 1]] : 2, [[2, 3], [3, 2]] : 4], Card{cardinal : _873, fd : [2 .. 4]}, _765, _766, _767, [], ['SUSP-_3173-susp', 'SUSP-_2522-susp'], ['SUSP-_5570-dead', 'SUSP-_3161-susp'], ['SUSP-_5651-dead'])}) 1198Reachs = [1, 2, 3] 1199 1200?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1],[3,2]], dirgraph(G,V,E), reachables(G,3,Reachs), 1 `-@ Reachs. 1201V = V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _675, fd : [2, 3]}, _567, _568, _569, [], [], ['SUSP-_2512-susp'], ['SUSP-_2136-dead'])} 1202E = E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 2]] : 3], Card{cardinal : _873, fd : [1 .. 3]}, _765, _766, _767, [], ['SUSP-_3480-dead', 'SUSP-_3173-susp', 'SUSP-_2522-susp'], ['SUSP-_3161-susp'], ['SUSP-_3665-dead'])} 1203G = dirgraph(V{cardinal([[1, 2] : 2, [3] : 3], Card{cardinal : _675, fd : [2, 3]}, _567, _568, _569, [], [], ['SUSP-_2512-susp'], ['SUSP-_2136-dead'])}, E{cardinal([[[1, 2]] : 1, [[2, 3], [3, 2]] : 3], Card{cardinal : _873, fd : [1 .. 3]}, _765, _766, _767, [], ['SUSP-_3480-dead', 'SUSP-_3173-susp', 'SUSP-_2522-susp'], ['SUSP-_3161-susp'], ['SUSP-_3665-dead'])}) 1204Reachs = Reachs{cardinal([[3] : 1, [2] : 2], Card{cardinal : _3114, fd : [1, 2]}, _3006, _3007, _3008, [], ['SUSP-_4091-dead', 'SUSP-_3149-susp'], ['SUSP-_3138-susp'], ['SUSP-_4317-dead'])} 1205 " 1206 ] 1207). 1208 1209reachables(Graph, _, _) :- 1210 var(Graph),!,fail. 1211reachables(dirgraph(VertexSet,EdgeSet), SourceVertex, ReachSet) :- 1212 reachables_aux(VertexSet, EdgeSet, SourceVertex, ReachSet). 1213reachables(undirgraph(VertexSet,EdgeSet), SourceVertex, ReachSet) :- 1214 reachables_aux(VertexSet, EdgeSet, SourceVertex, ReachSet). 1215 1216reachables_aux(VertexSet, _, SourceVertex, _) :- 1217 lub(VertexSet, LUBVertex), 1218 \+ord_memberchk(SourceVertex,LUBVertex), 1219 !,fail. 1220reachables_aux(VertexSet, EdgeSet, SourceVertex, ReachSet) :- 1221 lub(VertexSet, GLBVertex, _, LUBVertex), 1222 lub(EdgeSet, GLBEdge, _, LUBEdge), 1223 reach(GLBVertex, GLBEdge, SourceVertex, GLBReachSet), 1224 reach(LUBVertex, LUBEdge, SourceVertex, LUBReachSet), 1225 ReachSet`::GLBReachSet..LUBReachSet, 1226 ((ground(ReachSet), ground(EdgeSet)) -> 1227 true; 1228 (suspend(rem_reach_vertex_rem_edge(SourceVertex, EdgeSet, ReachSet), 10, ReachSet->cardinal:lub, RLUBSusp), 1229 suspend(add_reach_vertex_add_edge(SourceVertex, EdgeSet, ReachSet), 10, ReachSet->cardinal:glb, RGLBSusp), 1230 suspend(rem_edge_rem_reach_vertex(SourceVertex, VertexSet, EdgeSet, ReachSet), 10, EdgeSet->cardinal:lub, ELUBSusp), 1231 suspend(add_edge_add_reach_vertex(SourceVertex, VertexSet, EdgeSet, ReachSet), 10, EdgeSet->cardinal:glb, EGLBSusp), 1232 terminate_susps(kill_susps([RGLBSusp,RLUBSusp,EGLBSusp,ELUBSusp]), [ReachSet,EdgeSet]) 1233 ) 1234 ). 1235 1236reach(_, Arcs, Source, OrdReachNodes) :- 1237 hash_create(HashNodes), 1238 arc_list_to_adj_hash(Arcs, HashArcs), 1239 reach_aux([Source], HashNodes, HashArcs, [], ReachNodes), 1240 list_to_ord_set(ReachNodes, OrdReachNodes). 1241 1242reach_aux([], _, _, ReachNodes, ReachNodes). 1243reach_aux([Node|Nodes], HashNodes, HashArcs, AcumReachs, ReachNodes) :- 1244 (hash_contains(HashNodes, Node) -> 1245 (NewNodes = Nodes, NewAcumReachs = AcumReachs); 1246 ( 1247 ( 1248 hash_get(HashArcs, Node, NextNodes); NextNodes = []),!, 1249 append(NextNodes, Nodes, NewNodes), 1250 NewAcumReachs = [Node|AcumReachs], 1251 hash_add(HashNodes, Node, x) 1252 ) 1253 ), 1254 reach_aux(NewNodes, HashNodes, HashArcs, NewAcumReachs, ReachNodes). 1255 1256%%% 1257% - If Y is not reachable from X then the edge (X,Y) cannot occur in the graph 1258% - O(m + n) 1259%%% 1260 1261:- demon rem_reach_vertex_rem_edge/3. 1262 1263rem_reach_vertex_rem_edge(SourceVertex, EdgeSet, ReachSet) :- 1264 lub(ReachSet, LUBReach), 1265 hash_create(ReachHash), 1266 hash_add_all(ReachHash, LUBReach), 1267 lub(EdgeSet, LUBEdge), 1268 findall([SourceVertex,Succ], (member([SourceVertex,Succ], LUBEdge), \+hash_contains(ReachHash, Succ)), NotPossEdges), 1269 NotPossEdges `$ EdgeSet. 1270 1271%%% 1272% - The addition of a reachable vertex may impose the addition of an edge to the graph 1273% - O(m + n) 1274%%% 1275 1276:- demon add_reach_vertex_add_edge/3. 1277 1278add_reach_vertex_add_edge(SourceVertex, EdgeSet, ReachSet) :- 1279 lub(ReachSet, GLBReach, _, LUBReach), 1280 findall([SourceVertex,Vertex], member(Vertex,GLBReach), Edges), 1281 hash_create(EdgeHash), 1282 hash_add_all(EdgeHash,Edges), 1283 hash_create(ReachHash), 1284 hash_add_all(ReachHash,LUBReach), 1285 lub(EdgeSet, LUBEdgeSet), 1286 prune_edges(LUBEdgeSet,SourceVertex,EdgeHash,ReachHash), 1287 hash_list(EdgeHash,SubEdgeSet,_), 1288 SubEdgeSet `< EdgeSet. 1289 1290prune_edges([], _, _, _). 1291prune_edges([[X,Y]|Edges],SourceVertex,EdgeHash,ReachHash) :- 1292 ( 1293 (hash_contains(ReachHash,X),X \== SourceVertex, hash_contains(ReachHash,Y),hash_contains(EdgeHash,[SourceVertex,Y])) -> 1294 hash_remove(EdgeHash,[SourceVertex,Y],_); 1295 true 1296 ), 1297 prune_edges(Edges,SourceVertex,EdgeHash,ReachHash). 1298 1299%%% 1300% - The addition of an edge may impose the addition of several vertices to a reachables-set 1301% - O(n * (m + n)) 1302%%% 1303 1304:- demon add_edge_add_reach_vertex/4. 1305 1306add_edge_add_reach_vertex(SourceVertex, VertexSet, EdgeSet, ReachSet) :- 1307 glb(VertexSet, GLBVertex), 1308 glb(EdgeSet, GLBEdge), 1309 reach(GLBVertex, GLBEdge, SourceVertex, SubReachSet), 1310 SubReachSet `< ReachSet. 1311 1312%%% 1313% - The removal of an edge may impose the removal of several vertices from a reachables-set 1314% - O(n * (m + n)) 1315%%% 1316 1317:- demon rem_edge_rem_reach_vertex/4. 1318 1319rem_edge_rem_reach_vertex(SourceVertex, VertexSet, EdgeSet, ReachSet) :- 1320 lub(VertexSet, LUBVertex), 1321 lub(EdgeSet, LUBEdge), 1322 reach(LUBVertex, LUBEdge, SourceVertex, PossReachSet), 1323 ReachSet `< PossReachSet. 1324 1325:- comment( 1326 connected/1, 1327 [ 1328 amode: connected(+), 1329 args: 1330 [ 1331 "Graph": "A graph." 1332 ], 1333 summary: "Guarantees that an undirected graph Graph is connected.", 1334 desc: html("Guarantees that an undirected graph Graph is connected, i.e., that each vertex is reachable from any other one."), 1335 fail_if: 1336 "Fails 1337 if Graph is not an undirected graph variable or 1338 if Graph can not be constrained to be connected. 1339 ", 1340 eg: 1341 " 1342?- connected(G). 1343No. 1344 1345?- V`::[1,2]..[1,2,3,4], E`::[]..[[1,3],[2,4],[3,1],[4,2]], undirgraph(G,V,E), connected(G). 1346No. 1347 1348?- V`::[1,2]..[1,2,3], E`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], undirgraph(G,V,E), connected(G), graph_labeling(G). 1349V = [1, 2] 1350E = [[1, 2], [2, 1]] 1351G = undirgraph([1, 2], [[1, 2], [2, 1]]) 1352Yes ? ; 1353 1354V = [1, 2, 3] 1355E = [[1, 3], [2, 3], [3, 1], [3, 2]] 1356G = undirgraph([1, 2, 3], [[1, 3], [2, 3], [3, 1], [3, 2]]) 1357Yes ? ; 1358 1359V = [1, 2, 3] 1360E = [[1, 2], [2, 1], [2, 3], [3, 2]] 1361G = undirgraph([1, 2, 3], [[1, 2], [2, 1], [2, 3], [3, 2]]) 1362Yes ? ; 1363 1364V = [1, 2, 3] 1365E = [[1, 2], [1, 3], [2, 1], [3, 1]] 1366G = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [3, 1]]) 1367Yes ? ; 1368 1369V = [1, 2, 3] 1370E = [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]] 1371G = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]) 1372Yes 1373 " 1374 ] 1375). 1376 1377connected(Graph) :- 1378 var(Graph),!,fail. 1379connected(undirgraph(VertexSet,EdgeSet)) :- 1380 strongly_connected_aux(VertexSet,EdgeSet). 1381 1382:- comment( 1383 strongly_connected/1, 1384 [ 1385 amode: strongly_connected(+), 1386 args: 1387 [ 1388 "Graph": "A graph." 1389 ], 1390 summary: "Guarantees that a directed graph Graph is strongly connected.", 1391 desc: html("Guarantees that a directed graph Graph is strongly connected, i.e., that each vertex is reachable from any other one."), 1392 fail_if: 1393 "Fails 1394 if Graph is not a directed graph variable or 1395 if Graph can not be constrained to be strongly connected. 1396 ", 1397 eg: 1398 " 1399?- strongly_connected(G). 1400No. 1401 1402?- V`::[1,2]..[1,2,3,4], E`::[]..[[1,3],[2,4],[4,1],[4,3]], dirgraph(G,V,E), strongly_connected(G). 1403No. 1404 1405?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), strongly_connected(G), graph_labeling(G). 1406V = [] 1407E = [] 1408G = dirgraph([], []) 1409Yes ? ; 1410 1411V = [3] 1412E = [] 1413G = dirgraph([3], []) 1414Yes ? ; 1415 1416V = [2] 1417E = [] 1418G = dirgraph([2], []) 1419Yes ? ; 1420 1421V = [1] 1422E = [] 1423G = dirgraph([1], []) 1424Yes ? ; 1425 1426V = [1, 2] 1427E = [[1, 2], [2, 1]] 1428G = dirgraph([1, 2], [[1, 2], [2, 1]]) 1429Yes 1430 " 1431 ] 1432). 1433 1434strongly_connected(Graph) :- 1435 var(Graph),!,fail. 1436strongly_connected(dirgraph(VertexSet,EdgeSet)) :- 1437 strongly_connected_aux(VertexSet, EdgeSet). 1438 1439strongly_connected_aux(VertexSet, EdgeSet) :- 1440 glb(VertexSet, GLBVertex), 1441 hash_create(ReachHash), 1442 glb_strongly_connected(VertexSet, EdgeSet, GLBVertex, ReachHash), 1443 suspend(add_vertex_add_reach_vertices(VertexSet, EdgeSet, ReachHash), 10, VertexSet->cardinal:glb, Susp), 1444 terminate_susps(kill_susps([Susp]), [VertexSet]). 1445 1446glb_strongly_connected(_, _, [], _). 1447glb_strongly_connected(VertexSet, EdgeSet, [Vertex|NextVertices], ReachHash) :- 1448 reachables_aux(VertexSet, EdgeSet, Vertex, ReachSet), 1449 ReachSet `= VertexSet, 1450 hash_add(ReachHash, Vertex, ReachSet), 1451 glb_strongly_connected(VertexSet, EdgeSet, NextVertices, ReachHash). 1452 1453%%% 1454% - In a connected graph, adding a vertex to the graph imposes that that vertex must be reachable from all the other vertices and reach all the other vertices 1455% - O(n^2 * (m + n)) 1456%%% 1457 1458:- demon add_vertex_add_reach_vertices/3. 1459 1460add_vertex_add_reach_vertices(VertexSet, EdgeSet, ReachHash) :- 1461 glb(VertexSet, GLBVertex), 1462 findall(Vertex, (member(Vertex, GLBVertex), \+hash_contains(ReachHash, Vertex)), NewVertices), 1463 glb_strongly_connected(VertexSet, EdgeSet, NewVertices, ReachHash). 1464 1465:- comment( 1466 weakly_connected/1, 1467 [ 1468 amode: weakly_connected(+), 1469 args: 1470 [ 1471 "Graph": "A graph." 1472 ], 1473 summary: "Guarantees that a directed graph Graph is weakly connected.", 1474 desc: html("Guarantees that a directed graph Graph is weakly connected, i.e., that each vertex is reachable from any other one in the underlying graph of Graph."), 1475 fail_if: 1476 "Fails 1477 if Graph is not a directed graph variable or 1478 if Graph can not be constrained to be strongly connected. 1479 ", 1480 eg: 1481 " 1482?- weakly_connected(G). 1483No. 1484 1485?- V`::[1,2]..[1,2,3,4], E`::[]..[[1,3],[2,4],[3,1],[4,2]], dirgraph(G,V,E), weakly_connected(G). 1486No. 1487 1488?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), weakly_connected(G), graph_labeling(G). 1489V = [] 1490E = [] 1491G = dirgraph([], []) 1492Yes ? ; 1493 1494V = [3] 1495E = [] 1496G = dirgraph([3], []) 1497Yes ? ; 1498 1499V = [2] 1500E = [] 1501G = dirgraph([2], []) 1502Yes ? ; 1503 1504V = [1] 1505E = [] 1506G = dirgraph([1], []) 1507Yes ? ; 1508 1509V = [1, 2] 1510E = [[2, 1]] 1511G = dirgraph([1, 2], [[2, 1]]) 1512Yes ? ; 1513 1514V = [1, 2] 1515E = [[1, 2]] 1516G = dirgraph([1, 2], [[1, 2]]) 1517Yes ? ; 1518 1519V = [1, 2] 1520E = [[1, 2], [2, 1]] 1521G = dirgraph([1, 2], [[1, 2], [2, 1]]) 1522Yes 1523 " 1524 ] 1525). 1526 1527weakly_connected(Graph) :- 1528 var(Graph),!,fail. 1529weakly_connected(dirgraph(VertexSet,EdgeSet)) :- 1530 underlying_graph(dirgraph(VertexSet,EdgeSet),undirgraph(UndirVertexSet,UndirEdgeSet)), 1531 strongly_connected_aux(UndirVertexSet, UndirEdgeSet). 1532 1533:- comment( 1534 path/3, 1535 [ 1536 amode: path(+,+,+), 1537 args: 1538 [ 1539 "Graph": "A graph.", 1540 "OriginVertex": "Initial vertex in the path between OriginVertex and TerminusVertex in Graph.", 1541 "TerminusVertex": "Final vertex in the path between OriginVertex and TerminusVertex in Graph." 1542 ], 1543 summary: "Ensures Graph represents a path between OriginVertex and TerminusVertex in Graph.", 1544 desc: html("Ensures Graph represents a path between OriginVertex and TerminusVertex in Graph."), 1545 fail_if: 1546 "Fails 1547 if Graph is not a graph variable, 1548 if OriginVertex does not belong to Graph\'s vertex-set, 1549 if TerminusVertex does not belong to Graph\'s vertex-set or 1550 if Graph can not be constrained to define a path between OriginVertex and TerminusVertex. 1551 ", 1552 eg: 1553 " 1554?- path(G,Origin,Terminus). 1555No. 1556 1557?- V`::[]..[1,2,3,4], E`::[]..[[1,2],[1,3],[1,4],[2,4],[3,4]], dirgraph(G,V,E), path(G, 1, 5). 1558No. 1559 1560?- V`::[]..[1,2,3,4], E`::[]..[[1,2],[1,3],[1,4],[2,4],[3,4]], dirgraph(G,V,E), path(G, 5, 1). 1561No. 1562 1563?- V`::[]..[1,2,3,4], E`::[]..[[1,2],[1,3],[1,4],[2,4],[3,4]], dirgraph(G,V,E), path(G, 4, 1). 1564No. 1565 1566?- V`::[]..[1,2,3,4], E`::[]..[[1,2],[1,3],[1,4],[2,4],[3,4]], dirgraph(G,V,E), path(G, 1, 4), graph_labeling(G). 1567V = [1, 4] 1568E = [[1, 4]] 1569G = dirgraph([1, 4], [[1, 4]]) 1570Yes ? ; 1571 1572V = [1, 3, 4] 1573E = [[1, 3], [3, 4]] 1574G = dirgraph([1, 3, 4], [[1, 3], [3, 4]]) 1575Yes ? ; 1576 1577V = [1, 2, 4] 1578E = [[1, 2], [2, 4]] 1579G = dirgraph([1, 2, 4], [[1, 2], [2, 4]]) 1580Yes 1581 1582?- V`::[]..[1,2,3,4], E`::[]..[[1,2],[1,3],[1,4],[2,1],[2,4],[3,1],[3,4],[4,1],[4,2],[4,3]], undirgraph(G,V,E), path(G, 1, 4), graph_labeling(G). 1583V = [1, 3, 4] 1584E = [[1, 3], [3, 1], [3, 4], [4, 3]] 1585G = undirgraph([1, 3, 4], [[1, 3], [3, 1], [3, 4], [4, 3]]) 1586Yes ? ; 1587 1588V = [1, 3, 4] 1589E = [[1, 3], [1, 4], [3, 1], [3, 4], [4, 1], [4, 3]] 1590G = undirgraph([1, 3, 4], [[1, 3], [1, 4], [3, 1], [3, 4], [4, 1], [4, 3]]) 1591Yes ? ; 1592 1593V = [1, 2, 4] 1594E = [[1, 2], [2, 1], [2, 4], [4, 2]] 1595G = undirgraph([1, 2, 4], [[1, 2], [2, 1], [2, 4], [4, 2]]) 1596Yes ? ; 1597 1598V = [1, 2, 4] 1599E = [[1, 2], [1, 4], [2, 1], [2, 4], [4, 1], [4, 2]] 1600G = undirgraph([1, 2, 4], [[1, 2], [1, 4], [2, 1], [2, 4], [4, 1], [4, 2]]) 1601Yes ? ; 1602 1603V = [1, 2, 3, 4] 1604E = [[1, 2], [1, 3], [2, 1], [2, 4], [3, 1], [3, 4], [4, 2], [4, 3]] 1605G = undirgraph([1, 2, 3, 4], [[1, 2], [1, 3], [2, 1], [2, 4], [3, 1], [3, 4], [4, 2], [4, 3]]) 1606Yes 1607 " 1608 ] 1609). 1610 1611path(Graph, _, _) :- 1612 var(Graph),!,fail. 1613path(dirgraph(VertexSet,EdgeSet), OriginVertex, TerminusVertex) :- 1614 quasipath(dirgraph(VertexSet,EdgeSet), OriginVertex, TerminusVertex), 1615 weakly_connected(dirgraph(VertexSet,EdgeSet)). 1616path(undirgraph(VertexSet,EdgeSet), OriginVertex, TerminusVertex) :- 1617 quasipath(undirgraph(VertexSet,EdgeSet), OriginVertex, TerminusVertex), 1618 connected(undirgraph(VertexSet,EdgeSet)). 1619 1620quasipath(dirgraph(VertexSet, EdgeSet), OriginVertex, TerminusVertex) :- 1621 quasipath_aux(VertexSet, EdgeSet, OriginVertex, TerminusVertex, 1). 1622quasipath(undirgraph(VertexSet, EdgeSet), OriginVertex, TerminusVertex) :- 1623 quasipath_aux(VertexSet, EdgeSet, OriginVertex, TerminusVertex, 2). 1624 1625quasipath_aux(VertexSet, EdgeSet, OriginVertex, TerminusVertex, Max) :- 1626 OriginVertex `@ VertexSet, 1627 TerminusVertex `@ VertexSet, 1628 glb_poss(VertexSet, GLBVertex, PossVertex), 1629 hash_create(CardHash), 1630 glb_quasipath(VertexSet, EdgeSet, GLBVertex, OriginVertex, TerminusVertex, 0, Max, CardHash), 1631 poss_quasipath(VertexSet, EdgeSet, PossVertex, OriginVertex, TerminusVertex, 0, Max, CardHash), 1632 cardinality(VertexSet, VertexCard), 1633 cardinality(EdgeSet, EdgeCard), 1634 EdgeCard #>= (Max * (VertexCard - 1)), 1635 EdgeCard #<= (Max * VertexCard), 1636 suspend(add_vertex_inc_card(VertexSet, OriginVertex, TerminusVertex, CardHash), 9, VertexSet->cardinal:glb, VGLBSusp), 1637 suspend(dec_card_rem_vertex(VertexSet, OriginVertex, TerminusVertex, CardHash), 9, EdgeSet->cardinal:lub, ELUBSusp), 1638 terminate_susps(kill_susps([VGLBSusp,ELUBSusp]), [VertexSet,EdgeSet]). 1639 1640glb_quasipath(_, _, [], _, _, _, _, _). 1641glb_quasipath(VertexSet, EdgeSet, [Vertex|NextVertices], OriginVertex, TerminusVertex, Min, Max, CardHash) :- 1642 preds_aux(VertexSet, EdgeSet, Vertex, PredSet), 1643 cardinality(PredSet, PredCard), 1644 succs_aux(VertexSet, EdgeSet, Vertex, SuccSet), 1645 cardinality(SuccSet, SuccCard), 1646 (Vertex = OriginVertex -> 1647 (PredCard #>= Min, PredCard #<= Max, SuccCard #> Min, SuccCard #<= Max, Card = SuccCard); 1648 true 1649 ), 1650 (Vertex = TerminusVertex -> 1651 (PredCard #> Min, PredCard #<= Max, SuccCard #>= Min, SuccCard #<= Max, Card = PredCard); 1652 true 1653 ), 1654 (Vertex \= OriginVertex, Vertex \= TerminusVertex -> 1655 (PredCard #= Max, SuccCard #= Max, Card = Max); 1656 true 1657 ), 1658 hash_add(CardHash, Vertex, Card), 1659 glb_quasipath(VertexSet, EdgeSet, NextVertices, OriginVertex, TerminusVertex, Min, Max, CardHash). 1660 1661poss_quasipath(VertexSet, EdgeSet, VertexList, OriginVertex, TerminusVertex, Min, Max, CardHash) :- 1662 poss_quasipath_aux(VertexSet, EdgeSet, VertexList, OriginVertex, TerminusVertex, Min, Max, CardHash, [], AddList, [], RemList), 1663 AddList `< VertexSet, 1664 RemList `$ VertexSet. 1665 1666poss_quasipath_aux(_, _, [], _, _, _, _, _,AddList,AddList,RemList,RemList). 1667poss_quasipath_aux(VertexSet, EdgeSet, [Vertex|NextVertices], OriginVertex, TerminusVertex, Min, Max, CardHash, AcumAddList, AddList, AcumRemList, RemList) :- 1668 preds_aux(VertexSet, EdgeSet, Vertex, PredSet), 1669 cardinality(PredSet, Card), 1670 succs_aux(VertexSet, EdgeSet, Vertex, SuccSet), 1671 cardinality(SuccSet, Card), 1672 Card::[Min,Max], 1673 mindomain(Card, CardMin), 1674 (CardMin > Min -> 1675 (NAcumAddList = [Vertex|AcumAddList], NAcumRemList = AcumRemList, Card = Max); 1676 ( 1677 maxdomain(Card, CardMax), 1678 (CardMax < Max -> 1679 (NAcumRemList = [Vertex|AcumRemList], NAcumAddList = AcumAddList, Card = Min); 1680 (NAcumAddList = AcumAddList, NAcumRemList = AcumRemList) 1681 ) 1682 ) 1683 ), 1684 hash_add(CardHash, Vertex, Card), 1685 poss_quasipath_aux(VertexSet, EdgeSet, NextVertices, OriginVertex, TerminusVertex, Min, Max, CardHash, NAcumAddList, AddList, NAcumRemList, RemList). 1686 1687%%% 1688% - If a vertex is added to a path then it must have exactly the same number of predecessors and sucessors, namely 1 if the graph is directed and 2 if it is undirected 1689% - O(n) 1690%%% 1691 1692:- demon add_vertex_inc_card/4. 1693 1694add_vertex_inc_card(VertexSet, OriginVertex, TerminusVertex, CardHash) :- 1695 glb(VertexSet, GLBVertex), 1696 findall(Vertex, (member(Vertex, GLBVertex), Vertex \= OriginVertex, Vertex \= TerminusVertex), InVertices), 1697 not_isolated(InVertices, CardHash). 1698 1699not_isolated([], _). 1700not_isolated([Elem|Elems], Hash) :- 1701 hash_find(Hash, Elem, Card), 1702 Card #> 0, 1703 not_isolated(Elems, Hash). 1704 1705%%% 1706% - If the cardinality of a list (predecessors or successors) decreases bellow a given number then the corresponding vertex must be removed from the graph 1707% - O(n) 1708%%% 1709 1710:- demon dec_card_rem_vertex/4. 1711 1712dec_card_rem_vertex(VertexSet, _, _, CardHash) :- 1713 lub(VertexSet, LUBVertex), 1714 findall(Vertex, (member(Vertex, LUBVertex), hash_find(CardHash, Vertex, Card), Card \== 0), PossVertexSet), 1715 VertexSet `< PossVertexSet. 1716 1717cycle(Graph, OriginVertex, TerminusVertex) :- 1718 path(Graph, OriginVertex, TerminusVertex), 1719 getEdgeSet(Graph, EdgeSet), 1720 [TerminusVertex,OriginVertex] `@ EdgeSet. 1721 1722:- comment( 1723 underlying_graph/2, 1724 [ 1725 amode: underlying_graph(+,?), 1726 args: 1727 [ 1728 "DirectedGraph": "A directed graph.", 1729 "UndirectedGraph": "The underlying undirected graph of DirectedGraph." 1730 ], 1731 summary: "Obtains an underlying graph of a given directed graph.", 1732 desc: html("Obtains an underlying graph of a given directed graph."), 1733 fail_if: 1734 "Fails 1735 if DirectedGraph is not a directed graph variable or 1736 if DirectedGraph can not be contrained to have UndirectedGraph as its underlying graph (UndirectedGraph is a undirected graph variable). 1737 ", 1738 eg: 1739 " 1740?- underlying_graph(DG,UG). 1741No. 1742 1743?- V`::[]..[1,2,3], DE`::[[3,1]]..[[1,2],[2,3],[3,1]], UE`::[]..[[1,2],[2,1],[2,3],[3,2]], dirgraph(DG,V,DE), undirgraph(UG,V,UE), underlying_graph(DG,UG). 1744No. 1745 1746?- V`::[]..[1,2,3], DE`::[[3,1]]..[[1,2],[2,3],[3,1]], dirgraph(DG,V,DE), underlying_graph(DG,UG), graph_labeling(DG). 1747V = [1, 3] 1748DE = [[3, 1]] 1749DG = dirgraph([1, 3], [[3, 1]]) 1750UG = undirgraph([1, 3], [[1, 3], [3, 1]]) 1751Yes ? ; 1752 1753V = [1, 2, 3] 1754DE = [[3, 1]] 1755DG = dirgraph([1, 2, 3], [[3, 1]]) 1756UG = undirgraph([1, 2, 3], [[1, 3], [3, 1]]) 1757Yes ? ; 1758 1759V = [1, 2, 3] 1760DE = [[2, 3], [3, 1]] 1761DG = dirgraph([1, 2, 3], [[2, 3], [3, 1]]) 1762UG = undirgraph([1, 2, 3], [[1, 3], [2, 3], [3, 1], [3, 2]]) 1763Yes ? ; 1764 1765V = [1, 2, 3] 1766DE = [[1, 2], [3, 1]] 1767DG = dirgraph([1, 2, 3], [[1, 2], [3, 1]]) 1768UG = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [3, 1]]) 1769Yes ? ; 1770 1771V = [1, 2, 3] 1772DE = [[1, 2], [2, 3], [3, 1]] 1773DG = dirgraph([1, 2, 3], [[1, 2], [2, 3], [3, 1]]) 1774UG = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [2, 3], [3, 1], [3, 2]]) 1775Yes 1776 1777?- V`::[]..[1,2,3], DE`::[]..[[1,2],[2,3],[3,1]], UE`::[]..[[1,2],[2,1],[2,3],[3,2]], dirgraph(DG,V,DE), undirgraph(UG,V,UE), underlying_graph(DG,UG), size(DG,Size), Size #> 0, graph_labeling(DG). 1778V = [1, 2] 1779DE = [[1, 2]] 1780UE = [[1, 2], [2, 1]] 1781DG = dirgraph([1, 2], [[1, 2]]) 1782UG = undirgraph([1, 2], [[1, 2], [2, 1]]) 1783Size = 1 1784Yes ? ; 1785 1786V = [1, 2, 3] 1787DE = [[2, 3]] 1788UE = [[2, 3], [3, 2]] 1789DG = dirgraph([1, 2, 3], [[2, 3]]) 1790UG = undirgraph([1, 2, 3], [[2, 3], [3, 2]]) 1791Size = 1 1792Yes ? ; 1793 1794V = [1, 2, 3] 1795DE = [[1, 2]] 1796UE = [[1, 2], [2, 1]] 1797DG = dirgraph([1, 2, 3], [[1, 2]]) 1798UG = undirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1799Size = 1 1800Yes ? ; 1801 1802V = [1, 2, 3] 1803DE = [[1, 2], [2, 3]] 1804UE = [[1, 2], [2, 1], [2, 3], [3, 2]] 1805DG = dirgraph([1, 2, 3], [[1, 2], [2, 3]]) 1806UG = undirgraph([1, 2, 3], [[1, 2], [2, 1], [2, 3], [3, 2]]) 1807Size = 2 1808Yes 1809 " 1810 ] 1811). 1812 1813underlying_graph(Graph, _) :- 1814 var(Graph),!,fail. 1815underlying_graph(dirgraph(VertexSet, DirEdgeSet), undirgraph(VertexSet, UndirEdgeSet)) :- 1816 rem_dir(DirEdgeSet, UndirEdgeSet), 1817 undirgraph(undirgraph(VertexSet, UndirEdgeSet), VertexSet, UndirEdgeSet), 1818 DirEdgeSet `< UndirEdgeSet, 1819 1820 suspend(rem_edge_rem_undir_edge(DirEdgeSet, UndirEdgeSet), 5, DirEdgeSet->cardinal:lub, ELUBSusp), 1821 suspend(add_undir_edge_add_edge(DirEdgeSet, UndirEdgeSet), 5, UndirEdgeSet->cardinal:glb, UEGLBSusp), 1822 terminate_susps(kill_susps([ELUBSusp,UEGLBSusp]), [DirEdgeSet,UndirEdgeSet]). 1823 1824rem_dir(DirEdgeSet, UndirEdgeSet) :- 1825 glb_poss(DirEdgeSet, GLBDirEdge, PossDirEdge), 1826 hash_create(GLBHash), 1827 rem_dir_aux(GLBDirEdge, GLBHash, GLBUndirEdge), 1828 hash_create(PossHash), 1829 rem_dir_aux(PossDirEdge, PossHash, PossUndirEdge), 1830 UndirEdgeSet`::GLBUndirEdge+PossUndirEdge. 1831 1832rem_dir_aux([], _, []) :- !. 1833rem_dir_aux([Elem|Elems], Visited, SymElems) :- 1834 hash_contains(Visited, Elem),!, 1835 rem_dir_aux(Elems, Visited, SymElems). 1836rem_dir_aux([[X,Y]|Elems], Visited, [[X,Y],[Y,X]|SymElems]) :- 1837 \+hash_contains(Visited, [X,Y]),!, 1838 hash_add(Visited, [X,Y], true), 1839 hash_add(Visited, [Y,X], true), 1840 rem_dir_aux(Elems, Visited, SymElems). 1841 1842:- comment( 1843 oriented_graph/2, 1844 [ 1845 amode: oriented_graph(+,?), 1846 args: 1847 [ 1848 "UndirectedGraph": "An undirected graph.", 1849 "DirectedGraph": "The oriented directed graph of UndirectedGraph." 1850 ], 1851 summary: "Obtains an oriented graph of a given undirected graph.", 1852 desc: html("Obtains an oriented graph of a given undirected graph."), 1853 fail_if: 1854 "Fails 1855 if UndirectedGraph is not an undirected graph variable or 1856 if UndirectedGraph can not be contrained to have DirectedGraph as an oriented graph (DirectedGraph is a directed graph variable). 1857 ", 1858 eg: 1859 " 1860?- oriented_graph(UG,DG). 1861No. 1862 1863?- V`::[]..[1,2,3], DE`::[[3,1]]..[[1,2],[2,3],[3,1]], UE`::[]..[[1,2],[2,1],[2,3],[3,2]], dirgraph(DG,V,DE), undirgraph(UG,V,UE), oriented_graph(UG,DG). 1864No. 1865 1866?- undirgraph(UG,[1,2,3],[[1,2],[2,1]]), oriented_graph(UG,DG), graph_labeling(DG). 1867UG = undirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1868DG = dirgraph([1, 2, 3], [[2, 1]]) 1869Yes ? ; 1870 1871UG = undirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1872DG = dirgraph([1, 2, 3], [[1, 2]]) 1873Yes ? ; 1874 1875UG = undirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1876DG = dirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1877Yes 1878 1879?- V`::[]..[1,2,3], DE`::[]..[[1,2],[3,1]], UE`::[]..[[1,2],[1,3],[2,1],[2,3],[3,1],[3,2]], dirgraph(DG,V,DE), undirgraph(UG,V,UE), oriented_graph(UG,DG), size(DG,Size), Size #> 0, graph_labeling(DG). 1880V = [1, 3] 1881DE = [[3, 1]] 1882UE = [[1, 3], [3, 1]] 1883DG = dirgraph([1, 3], [[3, 1]]) 1884UG = undirgraph([1, 3], [[1, 3], [3, 1]]) 1885Size = 1 1886Yes ? ; 1887 1888V = [1, 2] 1889DE = [[1, 2]] 1890UE = [[1, 2], [2, 1]] 1891DG = dirgraph([1, 2], [[1, 2]]) 1892UG = undirgraph([1, 2], [[1, 2], [2, 1]]) 1893Size = 1 1894Yes ? ; 1895 1896V = [1, 2, 3] 1897DE = [[3, 1]] 1898UE = [[1, 3], [3, 1]] 1899DG = dirgraph([1, 2, 3], [[3, 1]]) 1900UG = undirgraph([1, 2, 3], [[1, 3], [3, 1]]) 1901Size = 1 1902Yes ? ; 1903 1904V = [1, 2, 3] 1905DE = [[1, 2]] 1906UE = [[1, 2], [2, 1]] 1907DG = dirgraph([1, 2, 3], [[1, 2]]) 1908UG = undirgraph([1, 2, 3], [[1, 2], [2, 1]]) 1909Size = 1 1910Yes ? ; 1911 1912V = [1, 2, 3] 1913DE = [[1, 2], [3, 1]] 1914UE = [[1, 2], [1, 3], [2, 1], [3, 1]] 1915DG = dirgraph([1, 2, 3], [[1, 2], [3, 1]]) 1916UG = undirgraph([1, 2, 3], [[1, 2], [1, 3], [2, 1], [3, 1]]) 1917Size = 2 1918Yes 1919 " 1920 ] 1921). 1922 1923oriented_graph(Graph, _) :- 1924 var(Graph),!,fail. 1925oriented_graph(undirgraph(VertexSet, UndirEdgeSet), dirgraph(VertexSet, DirEdgeSet)) :- 1926 lub(UndirEdgeSet, LUBUndirEdge), 1927 DirEdgeSet`::[]..LUBUndirEdge, 1928 dirgraph(dirgraph(VertexSet, DirEdgeSet), VertexSet, DirEdgeSet), 1929 DirEdgeSet `< UndirEdgeSet, 1930 1931 rem_edge_rem_undir_edge(DirEdgeSet, UndirEdgeSet), 1932 add_undir_edge_add_edge(DirEdgeSet, UndirEdgeSet), 1933 1934 suspend(rem_edge_rem_undir_edge(DirEdgeSet, UndirEdgeSet), 5, DirEdgeSet->cardinal:lub, ELUBSusp), 1935 suspend(add_undir_edge_add_edge(DirEdgeSet, UndirEdgeSet), 5, UndirEdgeSet->cardinal:glb, UEGLBSusp), 1936 terminate_susps(kill_susps([ELUBSusp,UEGLBSusp]), [DirEdgeSet,UndirEdgeSet]). 1937 1938%%% 1939% - Adding an edge to an underlying graph may add an edge to the original graph 1940% - O(m) 1941%%% 1942 1943:- demon add_undir_edge_add_edge/2. 1944 1945add_undir_edge_add_edge(DirEdgeSet, UndirEdgeSet) :- 1946 glb(UndirEdgeSet, GLBUndirEdge), 1947 lub(DirEdgeSet, LUBEdge), 1948 hash_create(DirEdgeHash), 1949 hash_add_all(DirEdgeHash, LUBEdge), 1950 findall([X,Y], (member([X,Y], GLBUndirEdge), hash_contains(DirEdgeHash, [X,Y]), \+hash_contains(DirEdgeHash, [Y,X])), SubEdgeSet), 1951 SubEdgeSet `< DirEdgeSet. 1952 1953%%% 1954% - Removing an edge from a graph will remove the corresponding edges from the underlying graph 1955% - O(m) 1956%%% 1957 1958:- demon rem_edge_rem_undir_edge/2. 1959 1960rem_edge_rem_undir_edge(DirEdgeSet, UndirEdgeSet) :- 1961 lub(DirEdgeSet, LUBEdge), 1962 rem_dir(LUBEdge, PossEdgeSet), 1963 UndirEdgeSet `< PossEdgeSet. 1964 1965:- comment( 1966 reverse_graph/2, 1967 [ 1968 amode: reverse_graph(+,?), 1969 args: 1970 [ 1971 "Graph": "A graph.", 1972 "ReverseGraph": "The reverse graph of Graph." 1973 ], 1974 summary: "Obtains the reverse graph of a given graph.", 1975 desc: html("Obtains the reverse graph of a given graph."), 1976 fail_if: 1977 "Fails 1978 if Graph is not a graph variable or 1979 if Graph can not be contrained to have ReverseGraph as its reverse graph (ReverseGraph is a graph variable). 1980 ", 1981 eg: 1982 " 1983?- reverse_graph(G,RG). 1984No. 1985 1986?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), dirgraph(RG,V,E), reverse_graph(G,RG). 1987No. 1988 1989?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), reverse_graph(G,RG), size(G,2), graph_labeling(G). 1990V = [1, 2, 3] 1991E = [[2, 3], [3, 1]] 1992G = dirgraph([1, 2, 3], [[2, 3], [3, 1]]) 1993RG = dirgraph([1, 2, 3], [[1, 3], [3, 2]]) 1994Yes ? ; 1995 1996V = [1, 2, 3] 1997E = [[1, 2], [3, 1]] 1998G = dirgraph([1, 2, 3], [[1, 2], [3, 1]]) 1999RG = dirgraph([1, 2, 3], [[1, 3], [2, 1]]) 2000Yes ? ; 2001 2002V = [1, 2, 3] 2003E = [[1, 2], [2, 3]] 2004G = dirgraph([1, 2, 3], [[1, 2], [2, 3]]) 2005RG = dirgraph([1, 2, 3], [[2, 1], [3, 2]]) 2006Yes 2007 2008?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], RE`::[[3,2]]..[[1,3],[2,1],[3,2]], dirgraph(G,V,E), dirgraph(RG,V,RE), reverse_graph(G,RG), graph_labeling(G). 2009V = [1, 2, 3] 2010E = [[1, 2], [2, 3]] 2011RE = [[2, 1], [3, 2]] 2012G = dirgraph([1, 2, 3], [[1, 2], [2, 3]]) 2013RG = dirgraph([1, 2, 3], [[2, 1], [3, 2]]) 2014Yes ? ; 2015 2016V = [1, 2, 3] 2017E = [[1, 2], [2, 3], [3, 1]] 2018RE = [[1, 3], [2, 1], [3, 2]] 2019G = dirgraph([1, 2, 3], [[1, 2], [2, 3], [3, 1]]) 2020RG = dirgraph([1, 2, 3], [[1, 3], [2, 1], [3, 2]]) 2021Yes 2022 " 2023 ] 2024). 2025 2026reverse_graph(Graph, _) :- 2027 var(Graph),!,fail. 2028reverse_graph(dirgraph(VertexSet, EdgeSet), dirgraph(RevVertexSet, RevEdgeSet)) :- 2029 rev_graph_aux(VertexSet, EdgeSet, RevVertexSet, RevEdgeSet). 2030reverse_graph(undirgraph(VertexSet, EdgeSet), undirgraph(VertexSet, EdgeSet)). 2031 2032rev_graph_aux(VertexSet, EdgeSet, VertexSet, RevEdgeSet) :- 2033 glb_poss(EdgeSet, GLBEdge, PossEdge), 2034 findall([Y,X], member([X,Y], GLBEdge), GLBRevEdge), 2035 findall([Y,X], member([X,Y], PossEdge), PossRevEdge), 2036 (var(RevEdgeSet) -> 2037 RevEdgeSet`::GLBRevEdge+PossRevEdge; 2038 ( 2039 RevEdgeSet`::GLBRevEdge+PossRevEdge, 2040 add_edge_add_rev_edge(EdgeSet, RevEdgeSet), 2041 rem_edge_rem_rev_edge(EdgeSet, RevEdgeSet), 2042 add_edge_add_rev_edge(RevEdgeSet, EdgeSet), 2043 rem_edge_rem_rev_edge(RevEdgeSet, EdgeSet) 2044 ) 2045 ), 2046 suspend(add_edge_add_rev_edge(EdgeSet, RevEdgeSet), 5, EdgeSet->cardinal:glb, EGLBSusp), 2047 suspend(rem_edge_rem_rev_edge(EdgeSet, RevEdgeSet), 5, EdgeSet->cardinal:lub, ELUBSusp), 2048 suspend(add_edge_add_rev_edge(RevEdgeSet, EdgeSet), 5, RevEdgeSet->cardinal:glb, REGLBSusp), 2049 suspend(rem_edge_rem_rev_edge(RevEdgeSet, EdgeSet), 5, RevEdgeSet->cardinal:lub, RELUBSusp), 2050 terminate_susps(kill_susps([EGLBSusp, ELUBSusp,REGLBSusp,RELUBSusp]), [EdgeSet,RevEdgeSet]). 2051 2052%%% 2053% - If an edge is added to a graph then its symmetric edge must also be added to the reversed graph 2054% - O(m) 2055%%% 2056 2057:- demon add_edge_add_rev_edge/2. 2058 2059add_edge_add_rev_edge(EdgeSet, RevEdgeSet) :- 2060 glb(EdgeSet, GLBEdge), 2061 findall([Y,X], member([X,Y], GLBEdge), SubEdgeSet), 2062 SubEdgeSet `< RevEdgeSet. 2063 2064%%% 2065% - If an edge is removed from a graph then its symmetric edge must also be removed from the reversed graph 2066% - O(m) 2067%%% 2068 2069:- demon rem_edge_rem_rev_edge/2. 2070 2071rem_edge_rem_rev_edge(EdgeSet, RevEdgeSet) :- 2072 lub(EdgeSet, LUBEdge), 2073 findall([Y,X], member([X,Y], LUBEdge), PossEdge), 2074 RevEdgeSet `< PossEdge. 2075 2076:- comment( 2077 complementary_graph/2, 2078 [ 2079 amode: complementary_graph(+,?), 2080 args: 2081 [ 2082 "Graph": "A graph.", 2083 "ComplementaryGraph": "The complementary graph of Graph." 2084 ], 2085 summary: "Obtains the complementary graph of a given graph.", 2086 desc: html("Obtains the complementary graph of a given graph."), 2087 fail_if: 2088 "Fails 2089 if Graph is not a graph variable or 2090 if Graph can not be constrained to have ComplementaryGraph as its complementary graph (ComplementarGraph is a graph variable). 2091 ", 2092 eg: 2093 " 2094?- complementary_graph(G,CG). 2095No. 2096 2097?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], CE`::[]..[[1,2],[3,2],[1,3]], dirgraph(G,V,E), dirgraph(CG,V,CE), complementary_graph(G,CG). 2098No. 2099 2100?- V`::[]..[1,2,3], E`::[[1,2]]..[[1,2],[2,3],[3,1]], dirgraph(G,V,E), complementary_graph(G,CG), graph_labeling(G). 2101V = [1, 2] 2102E = [[1, 2]] 2103G = dirgraph([1, 2], [[1, 2]]) 2104CG = dirgraph([1, 2], [[1, 1], [2, 1], [2, 2]]) 2105Yes ? ; 2106 2107V = [1, 2, 3] 2108E = [[1, 2]] 2109G = dirgraph([1, 2, 3], [[1, 2]]) 2110CG = dirgraph([1, 2, 3], [[1, 1], [1, 3], [2, 1], [2, 2], [2, 3], [3, 1], [3, 2], [3, 3]]) 2111Yes ? ; 2112 2113V = [1, 2, 3] 2114E = [[1, 2], [3, 1]] 2115G = dirgraph([1, 2, 3], [[1, 2], [3, 1]]) 2116CG = dirgraph([1, 2, 3], [[1, 1], [1, 3], [2, 1], [2, 2], [2, 3], [3, 2], [3, 3]]) 2117Yes ? ; 2118 2119V = [1, 2, 3] 2120E = [[1, 2], [2, 3]] 2121G = dirgraph([1, 2, 3], [[1, 2], [2, 3]]) 2122CG = dirgraph([1, 2, 3], [[1, 1], [1, 3], [2, 1], [2, 2], [3, 1], [3, 2], [3, 3]]) 2123Yes ? ; 2124 2125V = [1, 2, 3] 2126E = [[1, 2], [2, 3], [3, 1]] 2127G = dirgraph([1, 2, 3], [[1, 2], [2, 3], [3, 1]]) 2128CG = dirgraph([1, 2, 3], [[1, 1], [1, 3], [2, 1], [2, 2], [3, 2], [3, 3]]) 2129Yes 2130 2131?- V`::[]..[1,2,3], E`::[]..[[1,2],[2,3],[3,1]], CE`::[[2,3],[3,2]]..[[1,2],[1,3],[2,1],[2,2],[2,3],[3,1],[3,2],[3,3]], dirgraph(G,V,E), dirgraph(CG,V,CE), complementary_graph(G,CG), graph_labeling(G). 2132V = [2, 3] 2133E = [] 2134CE = [[2, 2], [2, 3], [3, 2], [3, 3]] 2135G = dirgraph([2, 3], []) 2136CG = dirgraph([2, 3], [[2, 2], [2, 3], [3, 2], [3, 3]]) 2137Yes 2138 " 2139 ] 2140). 2141 2142complementary_graph(Graph, _) :- 2143 var(Graph),!,fail. 2144complementary_graph(dirgraph(VertexSet,EdgeSet), dirgraph(CompVertexSet,CompEdgeSet)) :- 2145 complement_aux(VertexSet, EdgeSet, CompVertexSet, CompEdgeSet), 2146 dirgraph(dirgraph(CompVertexSet,CompEdgeSet), CompVertexSet, CompEdgeSet). 2147complementary_graph(undirgraph(VertexSet,EdgeSet), undirgraph(CompVertexSet,CompEdgeSet)) :- 2148 complement_aux(VertexSet, EdgeSet, CompVertexSet, CompEdgeSet), 2149 undirgraph(undirgraph(CompVertexSet,CompEdgeSet), CompVertexSet, CompEdgeSet). 2150 2151complement_aux(VertexSet, EdgeSet, VertexSet, CompEdgeSet) :- 2152 lub(VertexSet, LUBVertex), 2153 findall([X,Y], (member(X, LUBVertex), member(Y, LUBVertex)), LUBCompEdge), 2154 (var(CompEdgeSet) -> 2155 ( 2156 CompEdgeSet `::[]..LUBCompEdge, 2157 EdgeSet `$ CompEdgeSet, 2158 comp_arcs(VertexSet, LUBCompEdge, EdgeSet, CompEdgeSet) 2159 ); 2160 ( 2161 CompEdgeSet `::[]..LUBCompEdge, 2162 EdgeSet `$ CompEdgeSet, 2163 comp_arcs(VertexSet, LUBCompEdge, EdgeSet, CompEdgeSet), 2164 comp_arcs(VertexSet, LUBCompEdge, CompEdgeSet, EdgeSet) 2165 ) 2166 ), 2167 2168 suspend(comp_arcs(VertexSet, LUBCompEdge, EdgeSet, CompEdgeSet), 5, EdgeSet->cardinal:glb, EGSusp), 2169 suspend(comp_arcs(VertexSet, LUBCompEdge, EdgeSet, CompEdgeSet), 5, EdgeSet->cardinal:lub, ELSusp), 2170 suspend(comp_arcs(VertexSet, LUBCompEdge, CompEdgeSet, EdgeSet), 5, CompEdgeSet->cardinal:glb, CEGSusp), 2171 suspend(comp_arcs(VertexSet, LUBCompEdge, CompEdgeSet, EdgeSet), 5, CompEdgeSet->cardinal:lub, CELSusp), 2172 terminate_susps(kill_susps([EGSusp,ELSusp,CEGSusp,CELSusp]), [EdgeSet,CompEdgeSet]). 2173 2174%%% 2175% - If an edge is removed from a graph and both incident vertices are in the glb, then the edge must be added to the complement of the graph 2176% - if an edge is added to a graph then it must be removed from the complementary graph 2177% - O(m + n) 2178%%% 2179 2180:- demon comp_arcs/4. 2181 2182comp_arcs(VertexSet, AllEdges, EdgeSet, CompEdgeSet) :- 2183 glb(VertexSet, GLBVertex), 2184 hash_create(VertexHash), 2185 hash_add_all(VertexHash, GLBVertex), 2186 lub(EdgeSet, LUBEdge), 2187 hash_create(EdgeHash), 2188 hash_add_all(EdgeHash, LUBEdge), 2189 findall([X,Y], (member([X,Y], AllEdges), hash_contains(VertexHash,X), hash_contains(VertexHash,Y), \+hash_contains(EdgeHash, [X,Y])), SubEdgeSet), 2190 SubEdgeSet `< CompEdgeSet. 2191 2192:- comment( 2193 export_graph/2, 2194 [ 2195 amode: export_graph(+,++), 2196 args: 2197 [ 2198 "Graph": "A graph.", 2199 "File": "Name of the file where a GraphViz \'dot\' format of the graph is to be exported." 2200 ], 2201 summary: "Exports Graph to Filename in a .dot format which can then be loaded by GraphViz.", 2202 desc: html("Exports Graph to Filename in a .dot format which can then be loaded by GraphViz.") 2203 ] 2204). 2205 2206export_graph(Graph, _) :- 2207 var(Graph),!,fail. 2208export_graph(Graph, File) :- 2209 open(File, write, Stream), 2210 export_graph_aux(Stream, Graph), 2211 close(Stream). 2212 2213export_graph_aux(Stream, dirgraph(VertexSet,EdgeSet)) :- 2214 writeln(Stream, 'digraph <input_name>'), 2215 writeln(Stream, '{'), 2216 export_vertices(Stream, VertexSet), 2217 export_edges(Stream, '->', EdgeSet, false), 2218 writeln(Stream, '}'). 2219export_graph_aux(Stream, undirgraph(VertexSet,EdgeSet)) :- 2220 writeln(Stream, 'graph <input_name>'), 2221 writeln(Stream, '{'), 2222 export_vertices(Stream, VertexSet), 2223 export_edges(Stream, '--', EdgeSet, true), 2224 writeln(Stream, '}'). 2225 2226export_vertices(Stream, VertexSet) :- 2227 glb_poss(VertexSet, GLB, Poss), 2228 glb_vertices_attrs(GLBVertexAttrs), 2229 export_vertices_aux(Stream, GLB, GLBVertexAttrs), 2230 poss_vertices_attrs(PossVertexAttrs), 2231 export_vertices_aux(Stream, Poss, PossVertexAttrs). 2232 2233glb_vertices_attrs(''). 2234poss_vertices_attrs('[style=dotted]'). 2235 2236export_vertices_aux(_, [], _). 2237export_vertices_aux(Stream, [Elem|Elems], Attrs) :- 2238 write(Stream, Elem), 2239 write(Stream, ' '), 2240 write(Stream, Attrs), 2241 writeln(Stream, ';'), 2242 export_vertices_aux(Stream, Elems, Attrs). 2243 2244export_edges(Stream, EdgeType, EdgeSet, Filter) :- 2245 glb_poss(EdgeSet, GLB, Poss), 2246 glb_edges_attrs(GLBEdgeAttrs), 2247 export_edges_aux(Stream, GLB, EdgeType, Filter, GLBEdgeAttrs), 2248 poss_edges_attrs(PossEdgeAttrs), 2249 export_edges_aux(Stream, Poss, EdgeType, Filter, PossEdgeAttrs). 2250 2251export_edges_aux(_, [], _, _, _). 2252export_edges_aux(Stream, [[In,Out]|Elems], EdgeType, Filter, Attrs) :- 2253 ((Filter == true, Out @< In) -> 2254 true; 2255 (write(Stream, In), 2256 write(Stream, ' '), 2257 write(Stream, EdgeType), 2258 write(Stream, ' '), 2259 write(Stream, Out), 2260 write(Stream, ' '), 2261 write(Stream, Attrs), 2262 writeln(Stream, ';') 2263 ) 2264 ), 2265 export_edges_aux(Stream, Elems, EdgeType, Filter, Attrs). 2266 2267glb_edges_attrs(''). 2268poss_edges_attrs('[style=dotted]'). 2269 2270:- comment( 2271 graph_labeling/1, 2272 [ 2273 amode: graph_labeling(+), 2274 args: 2275 [ 2276 "Graph": "A graph." 2277 ], 2278 summary: "Labels a graph variable.", 2279 desc: html("Labels a graph variable."), 2280 fail_if: 2281 "Fails 2282 if Graph is not a graph variable. 2283 ", 2284 eg: 2285 " 2286?- graph_labeling(G). 2287No. 2288 2289?- V`::[]..[1,2], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), graph_labeling(G). 2290V = [] 2291E = [] 2292G = dirgraph([], []) 2293Yes ? ; 2294 2295V = [2] 2296E = [] 2297G = dirgraph([2], []) 2298Yes ? ; 2299 2300V = [1] 2301E = [] 2302G = dirgraph([1], []) 2303Yes ? ; 2304 2305V = [1, 2] 2306E = [] 2307G = dirgraph([1, 2], []) 2308Yes ? ; 2309 2310V = [1, 2] 2311E = [[2, 1]] 2312G = dirgraph([1, 2], [[2, 1]]) 2313Yes ? ; 2314 2315V = [1, 2] 2316E = [[1, 2]] 2317G = dirgraph([1, 2], [[1, 2]]) 2318Yes ? ; 2319 2320V = [1, 2] 2321E = [[1, 2], [2, 1]] 2322G = dirgraph([1, 2], [[1, 2], [2, 1]]) 2323Yes 2324 2325?- V`::[]..[1,2], E`::[]..[[1,2],[2,1]], undirgraph(G,V,E), graph_labeling(G). 2326V = [] 2327E = [] 2328G = undirgraph([], []) 2329Yes ? ; 2330 2331V = [2] 2332E = [] 2333G = undirgraph([2], []) 2334Yes ? ; 2335 2336V = [1] 2337E = [] 2338G = undirgraph([1], []) 2339Yes ? ; 2340 2341V = [1, 2] 2342E = [] 2343G = undirgraph([1, 2], []) 2344Yes ? ; 2345 2346V = [1, 2] 2347E = [[1, 2], [2, 1]] 2348G = undirgraph([1, 2], [[1, 2], [2, 1]]) 2349Yes 2350 " 2351 ] 2352). 2353 2354graph_labeling(Graph) :- 2355 graph_labeling(Graph, down, down). 2356 2357:- comment( 2358 graph_labeling/3, 2359 [ 2360 amode: graph_labeling(+,++,++), 2361 args: 2362 [ 2363 "Graph": "A graph.", 2364 "VertexHeuristic": "\'up\' for starting vertex inclusion first / \'down\' for starting vertex exclusion first.", 2365 "EdgeHeuristic": "\'up\' for starting edge inclusion first / \'down\' for starting edge exclusion first." 2366 ], 2367 summary: "Labels a graph variable using VertexHeuristic and EdgeHeuristic.", 2368 desc: html("Labels a graph variable using VertexHeuristic and EdgeHeuristic."), 2369 fail_if: 2370 "Fails 2371 if Graph is not a graph variable, 2372 if VertexHeuristic is not in {down,up} or 2373 if EdgeHeuristic is not in {down,up}. 2374 ", 2375 eg: 2376 " 2377?- graph_labeling(G,down,up). 2378No. 2379 2380?- V`::[]..[1,2], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), graph_labeling(G,d,up). 2381No. 2382 2383?- V`::[]..[1,2], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), graph_labeling(G,down,u). 2384No. 2385 2386?- V`::[]..[1,2], E`::[]..[[1,2],[2,1]], dirgraph(G,V,E), graph_labeling(G,down,up). 2387V = [] 2388E = [] 2389G = dirgraph([], []) 2390Yes ? ; 2391 2392V = [2] 2393E = [] 2394G = dirgraph([2], []) 2395Yes ? ; 2396 2397V = [1] 2398E = [] 2399G = dirgraph([1], []) 2400Yes ? ; 2401 2402V = [1, 2] 2403E = [[1, 2], [2, 1]] 2404G = dirgraph([1, 2], [[1, 2], [2, 1]]) 2405Yes ? ; 2406 2407V = [1, 2] 2408E = [[1, 2]] 2409G = dirgraph([1, 2], [[1, 2]]) 2410Yes ? ; 2411 2412V = [1, 2] 2413E = [[2, 1]] 2414G = dirgraph([1, 2], [[2, 1]]) 2415Yes ? ; 2416 2417V = [1, 2] 2418E = [] 2419G = dirgraph([1, 2], []) 2420Yes 2421 " 2422 ] 2423). 2424 2425graph_labeling(Graph, _, _) :- 2426 var(Graph),!,fail. 2427graph_labeling(_, VertexHeuristic, EdgeHeuristic) :- 2428 ( 2429 (VertexHeuristic \== down, VertexHeuristic \== up); 2430 (EdgeHeuristic \== down, EdgeHeuristic \== up) 2431 ),!,fail. 2432graph_labeling(Graph, VertexHeuristic, EdgeHeuristic) :- 2433 getVertexSet(Graph, VertexSet), 2434 getEdgeSet(Graph, EdgeSet), 2435 set_labeling(VertexHeuristic, [VertexSet]), 2436 set_labeling(EdgeHeuristic, [EdgeSet]). 2437 2438%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2439 2440arc_list_to_adj_hash(EdgeList, EdgeHash) :- 2441 hash_create(EdgeHash), 2442 arc_list_to_adj_hash_aux(EdgeList, EdgeHash). 2443 2444arc_list_to_adj_hash_aux([], _). 2445arc_list_to_adj_hash_aux([[X,Y]|Edges], EdgeHash) :- 2446 (hash_contains(EdgeHash, X) -> 2447 hash_get(EdgeHash, X, Succs); 2448 Succs = [] 2449 ), 2450 hash_set(EdgeHash, X, [Y|Succs]), 2451 arc_list_to_adj_hash_aux(Edges, EdgeHash). 2452 2453%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2454 2455hash_add_all(_, []). 2456hash_add_all(Hash, [Elem-Value|Elems]) :- 2457 hash_add(Hash, Elem, Value), 2458 hash_add_all(hash, Elems). 2459hash_add_all(Hash, [Elem|Elems]) :- 2460 hash_add(Hash, Elem, true), 2461 hash_add_all(Hash, Elems). 2462 2463all_have_value([], _, _). 2464all_have_value([Elem|Elems], WeightHash, Value) :- 2465 hash_find(WeightHash, Elem, Weight), 2466 Weight = Value, 2467 all_have_value(Elems, WeightHash, Value). 2468 2469%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2470 2471kill_susps([]). 2472kill_susps([Susp|Susps]) :- 2473 kill_suspension(Susp), 2474 kill_susps(Susps). 2475 2476%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2477 2478terminate_susps(Goal, []) :- 2479 Goal. 2480terminate_susps(Goal, [Cond|Conds]) :- 2481 (ground(Cond) -> 2482 terminate_susps(Goal, Conds); 2483 suspend(terminate_susps(Goal, [Cond|Conds]), 11, Cond->inst) 2484 ). 2485 2486%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%