1 package Graph::PathsTraversal; 2 # 3 # $RCSfile: PathsTraversal.pm,v $ 4 # $Date: 2015/02/28 20:49:06 $ 5 # $Revision: 1.29 $ 6 # 7 # Author: Manish Sud <msud@san.rr.com> 8 # 9 # Copyright (C) 2015 Manish Sud. All rights reserved. 10 # 11 # This file is part of MayaChemTools. 12 # 13 # MayaChemTools is free software; you can redistribute it and/or modify it under 14 # the terms of the GNU Lesser General Public License as published by the Free 15 # Software Foundation; either version 3 of the License, or (at your option) any 16 # later version. 17 # 18 # MayaChemTools is distributed in the hope that it will be useful, but without 19 # any warranty; without even the implied warranty of merchantability of fitness 20 # for a particular purpose. See the GNU Lesser General Public License for more 21 # details. 22 # 23 # You should have received a copy of the GNU Lesser General Public License 24 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or 25 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330, 26 # Boston, MA, 02111-1307, USA. 27 # 28 29 use strict; 30 use Carp; 31 use Exporter; 32 use Graph; 33 use Graph::Path; 34 35 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 36 37 @ISA = qw(Exporter); 38 @EXPORT = qw(); 39 @EXPORT_OK = qw(); 40 41 %EXPORT_TAGS = (all => [@EXPORT, @EXPORT_OK]); 42 43 # Setup class variables... 44 my($ClassName); 45 _InitializeClass(); 46 47 # Overload Perl functions... 48 use overload '""' => 'StringifyPathsTraversal'; 49 50 # Class constructor... 51 sub new { 52 my($Class, $Graph) = @_; 53 54 # Initialize object... 55 my $This = {}; 56 bless $This, ref($Class) || $Class; 57 $This->_InitializePathsTraversal($Graph); 58 59 return $This; 60 } 61 62 # Initialize object data... 63 sub _InitializePathsTraversal { 64 my($This, $Graph) = @_; 65 66 # Graph object... 67 $This->{Graph} = $Graph; 68 69 # Traversal mode: Vertex or Path 70 $This->{TraversalMode} = ''; 71 72 # Traversal type: DFS, DFSWithLimit, BFS, BFSWithLimit... 73 $This->{TraversalType} = ''; 74 75 # For finding root vertex and controlling search... 76 my(@VertexIDs); 77 @VertexIDs = $This->{Graph}->GetVertices(); 78 %{$This->{VerticesToVisit}} = (); 79 @{$This->{VerticesToVisit}}{ @VertexIDs } = @VertexIDs; 80 81 # Root vertex of all visited vertices... 82 %{$This->{VerticesRoots}} = (); 83 84 # Visited vertices... 85 %{$This->{VisitedVertices}} = (); 86 87 # Finished vertices... 88 %{$This->{FinishedVertices}} = (); 89 90 # List of active vertices during DFS/BFS search... 91 @{$This->{ActiveVertices}} = (); 92 93 # List of ordered vertices traversed during DFS/BFS search... 94 @{$This->{Vertices}} = (); 95 96 # Vertex neighbors during traversal... 97 %{$This->{VerticesNeighbors}} = (); 98 99 # Vertices depth from root... 100 %{$This->{VerticesDepth}} = (); 101 102 # Predecessor of each vertex during vertex traversal. For root vertex, it's root itself... 103 %{$This->{VerticesPredecessors}} = (); 104 105 # Successors of each vertex during vertex traversal... 106 %{$This->{VerticesSuccessors}} = (); 107 108 # Vertices at different neighborhood levels during vertex traversal... 109 @{$This->{VerticesNeighborhoods}} = (); 110 111 # Vertices, along with their successors, at different neighborhood levels during vertex traversal... 112 @{$This->{VerticesNeighborhoodsWithSuccessors}} = (); 113 114 # Visited edges during Path TraversalMode... 115 %{$This->{VisitedEdges}} = (); 116 %{$This->{VisitedEdges}->{From}} = (); 117 %{$This->{VisitedEdges}->{To}} = (); 118 119 # Vertex path during Path TraversalMode... 120 %{$This->{VerticesPaths}} = (); 121 122 # Allow cycles in paths during VertexNeighborhood TraversalMode. By default, cycles are not allowed 123 # during vertex traversal: a vertex is only visited once during BFS search for neighborhoods. For 124 # neighborhood vertices search during successors identification, vertex cycles are explicity allowed 125 # to indentify all successors. 126 $This->{AllowVertexCycles} = 0; 127 128 # Allow cycles in paths during Path TraversalMode... 129 $This->{AllowPathCycles} = 1; 130 131 # Cycle closure vertices during Path TraversalMode... 132 %{$This->{CycleClosureVertices}} = (); 133 134 # Paths traversed during search... 135 @{$This->{Paths}} = (); 136 137 return $This; 138 } 139 140 # Initialize class ... 141 sub _InitializeClass { 142 #Class name... 143 $ClassName = __PACKAGE__; 144 } 145 146 # Perform a depth first search (DFS)... 147 # 148 sub PerformDepthFirstSearch { 149 my($This, $RootVertexID) = @_; 150 151 if (defined $RootVertexID) { 152 if (!$This->{Graph}->HasVertex($RootVertexID)) { 153 carp "Warning: ${ClassName}->PerformDepthFirstSearch: No search performed: Vertex $RootVertexID doesn't exist..."; 154 return undef; 155 } 156 } 157 return $This->_PerformVertexSearch("DFS", $RootVertexID); 158 } 159 160 # Perform a depth first search (DFS) with limit on depth... 161 # 162 sub PerformDepthFirstSearchWithLimit { 163 my($This, $DepthLimit, $RootVertexID) = @_; 164 165 if (!defined $DepthLimit) { 166 carp "Warning: ${ClassName}->PerformDepthFirstSearchWithLimit: No search performed: Depth limit must be specified..."; 167 return undef; 168 } 169 if ($DepthLimit < 0) { 170 carp "Warning: ${ClassName}->PerformDepthFirstSearchWithLimit: No search performed: Specified depth limit, $DepthLimit, must be a positive integer..."; 171 return undef; 172 } 173 if (defined $RootVertexID) { 174 if (!$This->{Graph}->HasVertex($RootVertexID)) { 175 carp "Warning: ${ClassName}->PerformDepthFirstSearchWithLimit: No search performed: Vertex $RootVertexID doesn't exist..."; 176 return undef; 177 } 178 } 179 return $This->_PerformVertexSearch("DFSWithLimit", $RootVertexID, $DepthLimit); 180 } 181 182 # Perform a breadth first search (BFS)... 183 # 184 sub PerformBreadthFirstSearch { 185 my($This, $RootVertexID) = @_; 186 187 if (defined $RootVertexID) { 188 if (!$This->{Graph}->HasVertex($RootVertexID)) { 189 carp "Warning: ${ClassName}->PerformBreadthFirstSearch: No search performed: Vertex $RootVertexID doesn't exist..."; 190 return undef; 191 } 192 } 193 return $This->_PerformVertexSearch("BFS", $RootVertexID); 194 } 195 196 # Perform a breadth first search (BFS) with limit... 197 # 198 sub PerformBreadthFirstSearchWithLimit { 199 my($This, $DepthLimit, $RootVertexID) = @_; 200 201 if (!defined $DepthLimit) { 202 carp "Warning: ${ClassName}->PerformBreadthFirstSearchWithLimit: No search performed: Depth limit must be specified..."; 203 return undef; 204 } 205 if ($DepthLimit < 0) { 206 carp "Warning: ${ClassName}->PerformBreadthFirstSearchWithLimit: No search performed: Specified depth limit, $DepthLimit, must be a positive integer..."; 207 return undef; 208 } 209 if (defined $RootVertexID) { 210 if (!$This->{Graph}->HasVertex($RootVertexID)) { 211 carp "Warning: ${ClassName}->PerformDepthFirstSearchWithLimit: No search performed: Vertex $RootVertexID doesn't exist..."; 212 return undef; 213 } 214 } 215 return $This->_PerformVertexSearch("BFSWithLimit", $RootVertexID, $DepthLimit); 216 } 217 218 # Perform appropriate vertex search... 219 # 220 sub _PerformVertexSearch { 221 my($This, $SearchType, $RootVertexID, $DepthLimit, $TargetVertexID) = @_; 222 223 # Setup search... 224 $This->{TraversalMode} = 'Vertex'; 225 $This->{TraversalType} = $SearchType; 226 227 if (defined $RootVertexID) { 228 $This->{RootVertex} = $RootVertexID; 229 } 230 if (defined $DepthLimit) { 231 $This->{DepthLimit} = $DepthLimit; 232 } 233 if (defined $TargetVertexID) { 234 $This->{TargetVertex} = $TargetVertexID; 235 } 236 237 # Perform search... 238 return $This->_TraverseGraph(); 239 } 240 241 # Perform DFS or BFS traversal with or without any limits... 242 # 243 sub _TraverseGraph { 244 my($This) = @_; 245 my($ProcessingVertices, $CurrentVertexID, $NeighborVertexID, $VertexID); 246 247 if ($This->{TraversalMode} !~ /^(Vertex|Path|VertexNeighborhood)$/i) { 248 return $This; 249 } 250 251 $ProcessingVertices = 1; 252 253 VERTICES: while ($ProcessingVertices) { 254 # Set root vertex... 255 if (!@{$This->{ActiveVertices}}) { 256 my($RootVertexID); 257 258 $RootVertexID = $This->_GetRootVertex(); 259 if (!defined $RootVertexID) { 260 $ProcessingVertices = 0; next VERTICES; 261 } 262 $This->_ProcessVisitedVertex($RootVertexID, $RootVertexID); 263 } 264 265 # Get current active vertex... 266 $CurrentVertexID = $This->_GetActiveVertex(); 267 if (!defined $CurrentVertexID) { 268 $ProcessingVertices = 0; next VERTICES; 269 } 270 271 # Get next available neighbor of current vertex... 272 # 273 $NeighborVertexID = $This->_GetNeighborVertex($CurrentVertexID); 274 275 # Process neighbor or current vertex... 276 if (defined $NeighborVertexID) { 277 $This->_ProcessVisitedVertex($NeighborVertexID, $CurrentVertexID); 278 } 279 else { 280 # Finished with all neighbors for current vertex... 281 $This->_ProcessFinishedVertex($CurrentVertexID); 282 } 283 } 284 return $This; 285 } 286 287 # Get root vertex to start the search... 288 # 289 # Notes: 290 # . User specification of root vertex forces traversal in a specific connected component 291 # of graph; To traverse find all connected components, perform traversal without specification of 292 # a root vertex. 293 # 294 sub _GetRootVertex { 295 my($This) = @_; 296 my($RootVertexID); 297 298 # Check for specified root vertex and constrain traversal to specific connected 299 # component by setting root limit... 300 if (exists $This->{RootVertex}) { 301 $RootVertexID = $This->{RootVertex}; 302 delete $This->{RootVertex}; 303 $This->{RootVertexSpecified} = 1; 304 305 return $RootVertexID; 306 } 307 # Traversal limited to connected component containing specified root vertex... 308 if (exists $This->{RootVertexSpecified}) { 309 return undef; 310 } 311 312 # Use first vertex in sorted available vertices list to get root vertex. Vertex 313 # with largest degree could also be used as root vertex. However, for all 314 # practical purposes, any arbitrary vertex can be used as root vertex to 315 # start search for another disconnected component of the graph. 316 # 317 my(@VerticesToVisit); 318 319 $RootVertexID = undef; @VerticesToVisit = (); 320 @VerticesToVisit = sort { $a <=> $b } keys %{$This->{VerticesToVisit}}; 321 if (@VerticesToVisit) { 322 $RootVertexID = $VerticesToVisit[0]; 323 } 324 return $RootVertexID; 325 } 326 327 # Get current or new active vertex for DFS/BFS traversals... 328 # 329 sub _GetActiveVertex { 330 my($This) = @_; 331 my($ActiveVertexID); 332 333 $ActiveVertexID = undef; 334 if ($This->{TraversalType} =~ /^(DFS|DFSWithLimit)$/i) { 335 # For DFS, it's last vertex in LIFO queue... 336 $ActiveVertexID = $This->{ActiveVertices}[-1]; 337 } 338 elsif ($This->{TraversalType} =~ /^(BFS|BFSWithLimit)$/i) { 339 # For BFS, it's first vertex in FIFO queue... 340 $ActiveVertexID = $This->{ActiveVertices}[0]; 341 } 342 return $ActiveVertexID; 343 } 344 345 # Get available neigbor of specified vertex... 346 # 347 sub _GetNeighborVertex { 348 my($This, $VertexID) = @_; 349 350 # Retrieve neighbors for vertex... 351 if (!exists $This->{VerticesNeighbors}{$VertexID}) { 352 @{$This->{VerticesNeighbors}{$VertexID}} = (); 353 354 if (exists $This->{DepthLimit}) { 355 # Only collect neighbors to visit below specified depth limit... 356 if ($This->{VerticesDepth}{$VertexID} < $This->{DepthLimit}) { 357 push @{$This->{VerticesNeighbors}{$VertexID}}, $This->{Graph}->GetNeighbors($VertexID); 358 } 359 else { 360 if (!exists $This->{RootVertexSpecified}) { 361 # Mark all other downstream neighbor vertices to be ignored from any further 362 # processing and avoid selection of a new root... 363 $This->_IgnoreDownstreamNeighbors($VertexID); 364 } 365 } 366 } 367 elsif (exists $This->{TargetVertex}) { 368 if ($VertexID != $This->{TargetVertex}) { 369 push @{$This->{VerticesNeighbors}{$VertexID}}, $This->{Graph}->GetNeighbors($VertexID); 370 } 371 } 372 else { 373 push @{$This->{VerticesNeighbors}{$VertexID}}, $This->{Graph}->GetNeighbors($VertexID); 374 } 375 } 376 377 if ($This->{TraversalMode} =~ /^Path$/i) { 378 # Get available neighbor for path search... 379 return $This->_GetNeighborVertexDuringPathTraversal($VertexID); 380 } 381 elsif ($This->{TraversalMode} =~ /^Vertex$/i) { 382 # Get unvisited neighbor for vertex search... 383 return $This->_GetNeighborVertexDuringVertexTraversal($VertexID); 384 } 385 elsif ($This->{TraversalMode} =~ /^VertexNeighborhood$/i) { 386 # Get available neighbor during vertex neighborhood search... 387 return $This->_GetNeighborVertexDuringVertexNeighborhoodTraversal($VertexID); 388 } 389 return undef; 390 } 391 392 # Get unvisited neighbor of specified vertex during vertex traversal... 393 # 394 sub _GetNeighborVertexDuringVertexTraversal { 395 my($This, $VertexID) = @_; 396 my($NeighborVertexID, $UnvisitedNeighborVertexID); 397 398 # Get unvisited neighbor... 399 $UnvisitedNeighborVertexID = undef; 400 NEIGHBOR: for $NeighborVertexID (@{$This->{VerticesNeighbors}{$VertexID}}) { 401 if (!exists $This->{VisitedVertices}{$NeighborVertexID}) { 402 $UnvisitedNeighborVertexID = $NeighborVertexID; 403 last NEIGHBOR; 404 } 405 } 406 return $UnvisitedNeighborVertexID; 407 } 408 409 # Get available neighbor of specified vertex during vertex neighborhood traversal... 410 # 411 sub _GetNeighborVertexDuringVertexNeighborhoodTraversal { 412 my($This, $VertexID) = @_; 413 my($NeighborVertexID, $UnvisitedNeighborVertexID); 414 415 # Get available neighbor... 416 $UnvisitedNeighborVertexID = undef; 417 NEIGHBOR: for $NeighborVertexID (@{$This->{VerticesNeighbors}{$VertexID}}) { 418 if (!exists $This->{VisitedVertices}{$NeighborVertexID}) { 419 $UnvisitedNeighborVertexID = $NeighborVertexID; 420 last NEIGHBOR; 421 } 422 # Look for any unvisited edge back to visited vertex... 423 if ($This->_IsVisitedEdge($VertexID, $NeighborVertexID) || $This->_IsVisitedEdge($NeighborVertexID, $VertexID)) { 424 next NEIGHBOR; 425 } 426 # Check its depth... 427 if (exists $This->{DepthLimit}) { 428 if (($This->{VerticesDepth}{$VertexID} + 1) > $This->{DepthLimit}) { 429 next NEIGHBOR; 430 } 431 } 432 # Its an edge that makes a cycle during BFS search... 433 if ($This->{AllowVertexCycles}) { 434 $This->{CycleClosureVertices}{$NeighborVertexID} = 1; 435 $UnvisitedNeighborVertexID = $NeighborVertexID; 436 last NEIGHBOR; 437 } 438 } 439 return $UnvisitedNeighborVertexID; 440 } 441 442 # Get available neighbor of specified vertex during path traversal... 443 # 444 sub _GetNeighborVertexDuringPathTraversal { 445 my($This, $VertexID) = @_; 446 my($NeighborVertexID, $UnvisitedNeighborVertexID); 447 448 # Get unvisited neighbor... 449 $UnvisitedNeighborVertexID = undef; 450 NEIGHBOR: for $NeighborVertexID (@{$This->{VerticesNeighbors}{$VertexID}}) { 451 if (!exists $This->{VisitedVertices}{$NeighborVertexID}) { 452 # An unvisited vertex... 453 $UnvisitedNeighborVertexID = $NeighborVertexID; 454 last NEIGHBOR; 455 } 456 # Look for any unvisited edge back to visited vertex... 457 if ($This->_IsVisitedEdge($VertexID, $NeighborVertexID) || $This->_IsVisitedEdge($NeighborVertexID, $VertexID)) { 458 next NEIGHBOR; 459 } 460 # Check its depth... 461 if (exists $This->{DepthLimit}) { 462 if (($This->{VerticesDepth}{$VertexID} + 1) >= $This->{DepthLimit}) { 463 next NEIGHBOR; 464 } 465 } 466 467 # It's the edge final edge of a cycle in case $NeighborVertexID is already in the path; otherwise, it's 468 # part of the path from a different direction in a cycle or a left over vertex during Limit search. 469 # 470 if ($This->_IsCycleClosureEdge($VertexID, $NeighborVertexID)) { 471 if ($This->{AllowPathCycles}) { 472 $This->{CycleClosureVertices}{$NeighborVertexID} = 1; 473 $UnvisitedNeighborVertexID = $NeighborVertexID; 474 last NEIGHBOR; 475 } 476 } 477 else { 478 $UnvisitedNeighborVertexID = $NeighborVertexID; 479 last NEIGHBOR; 480 } 481 } 482 return $UnvisitedNeighborVertexID; 483 } 484 485 # Process visited vertex... 486 # 487 sub _ProcessVisitedVertex { 488 my($This, $VertexID, $PredecessorVertexID) = @_; 489 490 if (!exists $This->{VisitedVertices}{$VertexID}) { 491 # Add it to active vertices list... 492 push @{$This->{ActiveVertices}}, $VertexID; 493 494 # Mark vertex as visited vertex and take it out from the list of vertices to visit... 495 $This->{VisitedVertices}{$VertexID} = 1; 496 delete $This->{VerticesToVisit}{$VertexID}; 497 } 498 499 # Set up root vertex, predecessor vertex and distance from root... 500 if ($VertexID == $PredecessorVertexID) { 501 $This->{VerticesRoots}{$VertexID} = $VertexID; 502 503 $This->{VerticesPredecessors}{$VertexID} = $VertexID; 504 if (!exists $This->{VerticesSuccessors}{$VertexID}) { 505 @{$This->{VerticesSuccessors}{$VertexID}} = (); 506 } 507 508 $This->{VerticesDepth}{$VertexID} = 0; 509 510 if ($This->{TraversalMode} =~ /^Path$/i) { 511 $This->_ProcessVisitedPath($VertexID, $PredecessorVertexID); 512 } 513 } 514 else { 515 $This->{VerticesRoots}{$VertexID} = $This->{VerticesRoots}{$PredecessorVertexID}; 516 517 $This->{VerticesPredecessors}{$VertexID} = $PredecessorVertexID; 518 if (!exists $This->{VerticesSuccessors}{$PredecessorVertexID}) { 519 @{$This->{VerticesSuccessors}{$PredecessorVertexID}} = (); 520 } 521 push @{$This->{VerticesSuccessors}{$PredecessorVertexID}}, $VertexID; 522 523 if (!exists $This->{VerticesDepth}{$VertexID}) { 524 $This->{VerticesDepth}{$VertexID} = $This->{VerticesDepth}{$PredecessorVertexID} + 1; 525 } 526 527 if ($This->{TraversalMode} =~ /^Path$/i) { 528 $This->_ProcessVisitedPath($VertexID, $PredecessorVertexID); 529 $This->_ProcessVisitedEdge($PredecessorVertexID, $VertexID); 530 } 531 elsif ($This->{TraversalMode} =~ /^VertexNeighborhood$/i) { 532 $This->_ProcessVisitedEdge($PredecessorVertexID, $VertexID); 533 } 534 } 535 return $This; 536 } 537 538 # Process visited path... 539 # 540 sub _ProcessVisitedPath { 541 my($This, $VertexID, $PredecessorVertexID) = @_; 542 543 # Initialize VerticesPath... 544 if (!exists $This->{VerticesPaths}{$VertexID}) { 545 @{$This->{VerticesPaths}{$VertexID}} = (); 546 } 547 548 if ($VertexID == $PredecessorVertexID) { 549 # Starting of a path from root... 550 push @{$This->{VerticesPaths}{$VertexID}}, $VertexID; 551 } 552 else { 553 # Setup path for a vertex using path information from predecessor vertex... 554 if (exists $This->{CycleClosureVertices}{$PredecessorVertexID}) { 555 # Start of a new path from predecessor vertex... 556 push @{$This->{VerticesPaths}{$VertexID}}, "${PredecessorVertexID}-${VertexID}"; 557 } 558 else { 559 my($PredecessorVertexPath); 560 for $PredecessorVertexPath (@{$This->{VerticesPaths}{$PredecessorVertexID}}) { 561 push @{$This->{VerticesPaths}{$VertexID}}, "${PredecessorVertexPath}-${VertexID}"; 562 } 563 } 564 } 565 return $This; 566 } 567 568 # Process visited edge... 569 # 570 sub _ProcessVisitedEdge { 571 my($This, $VertexID1, $VertexID2) = @_; 572 573 if (!exists $This->{VisitedEdges}->{From}->{$VertexID1}) { 574 %{$This->{VisitedEdges}->{From}->{$VertexID1}} = (); 575 } 576 $This->{VisitedEdges}->{From}->{$VertexID1}->{$VertexID2} = $VertexID2; 577 578 if (!exists $This->{VisitedEdges}->{To}->{$VertexID2}) { 579 %{$This->{VisitedEdges}->{To}->{$VertexID2}} = (); 580 } 581 $This->{VisitedEdges}->{To}->{$VertexID2}->{$VertexID1} = $VertexID1; 582 583 return $This; 584 } 585 586 # Finished processing active vertex... 587 # 588 sub _ProcessFinishedVertex { 589 my($This, $VertexID) = @_; 590 591 if (!exists $This->{FinishedVertices}{$VertexID}) { 592 $This->{FinishedVertices}{$VertexID} = $VertexID; 593 # Add vertex to list of vertices found by traversal... 594 push @{$This->{Vertices}}, $VertexID; 595 } 596 597 # Any active vertices left... 598 if (!@{$This->{ActiveVertices}}) { 599 return $This; 600 } 601 602 # Take it off active vertices list... 603 if ($This->{TraversalType} =~ /^(DFS|DFSWithLimit)$/i) { 604 # For DFS, it's last vertex in LIFO queue... 605 pop @{$This->{ActiveVertices}}; 606 } 607 elsif ($This->{TraversalType} =~ /^(BFS|BFSWithLimit)$/i) { 608 # For BFS, it's first vertex in FIFO queue... 609 shift @{$This->{ActiveVertices}}; 610 } 611 return $This; 612 } 613 614 # Mark all other downstream neighbor vertices to be ignored from any further 615 # processing... 616 # 617 sub _IgnoreDownstreamNeighbors { 618 my($This, $VertexID, $PredecessorVertexID) = @_; 619 620 if (exists $This->{VerticesToVisit}{$VertexID}) { 621 # Mark vertex as visited vertex and take it out from the list of vertices to visit... 622 $This->{VisitedVertices}{$VertexID} = 1; 623 delete $This->{VerticesToVisit}{$VertexID}; 624 625 if (defined($PredecessorVertexID) && $This->{TraversalMode} =~ /^(Path|VertexNeighborhood)$/i) { 626 $This->_ProcessVisitedEdge($VertexID, $PredecessorVertexID); 627 } 628 } 629 my($NeighborVertexID, @NeighborsVertexIDs); 630 631 @NeighborsVertexIDs = (); 632 @NeighborsVertexIDs = $This->{Graph}->GetNeighbors($VertexID); 633 NEIGHBOR: for $NeighborVertexID (@NeighborsVertexIDs) { 634 if (!exists $This->{VerticesToVisit}{$NeighborVertexID}) { 635 # Avoid going back to predecessor vertex which has already been ignored... 636 next NEIGHBOR; 637 } 638 $This->_IgnoreDownstreamNeighbors($NeighborVertexID, $VertexID); 639 } 640 return $This; 641 } 642 643 # Is it a visited edge? 644 # 645 sub _IsVisitedEdge { 646 my($This, $VertexID1, $VertexID2) = @_; 647 648 if (exists $This->{VisitedEdges}->{From}->{$VertexID1}) { 649 if (exists $This->{VisitedEdges}->{From}->{$VertexID1}->{$VertexID2}) { 650 return 1; 651 } 652 } 653 elsif (exists $This->{VisitedEdges}->{To}->{$VertexID2}) { 654 if (exists $This->{VisitedEdges}->{To}->{$VertexID2}->{$VertexID1}) { 655 return 1; 656 } 657 } 658 return 0; 659 } 660 661 # Is it a cycle closure edge? 662 # 663 # Notes: 664 # . Presence of VertexID2 in DFS path traversed for VertexID1 make it a cycle 665 # closure edge... 666 # 667 sub _IsCycleClosureEdge { 668 my($This, $VertexID1, $VertexID2) = @_; 669 670 if (!exists $This->{VerticesPaths}{$VertexID1}) { 671 return 0; 672 } 673 my($Path); 674 for $Path (@{$This->{VerticesPaths}{$VertexID1}}) { 675 if (($Path =~ /-$VertexID2-/ || $Path =~ /^$VertexID2-/ || $Path =~ /-$VertexID2$/)) { 676 return 1; 677 } 678 } 679 return 0; 680 } 681 682 # Search paths starting from a specified vertex with no sharing of edges in paths traversed. 683 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 684 # completing the cycle. 685 # 686 sub PerformPathsSearch { 687 my($This, $StartVertexID, $AllowCycles) = @_; 688 689 # Make sure start vertex is defined... 690 if (!defined $StartVertexID) { 691 carp "Warning: ${ClassName}->PerformPathsSearch: No paths search performed: Start vertex must be specified..."; 692 return undef; 693 } 694 695 # Make sure start vertex is valid... 696 if (!$This->{Graph}->HasVertex($StartVertexID)) { 697 carp "Warning: ${ClassName}->PerformPathsSearch: No paths search performed: Vertex $StartVertexID doesn't exist..."; 698 return undef; 699 } 700 701 if (!defined $AllowCycles) { 702 $AllowCycles = 1; 703 } 704 705 # Perform paths search... 706 return $This->_PerformPathsSearch("AllLengths", $StartVertexID, $AllowCycles); 707 } 708 709 # Search paths starting from a specified vertex with length upto a specified length 710 # with no sharing of edges in paths traversed... 711 # 712 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 713 # completing the cycle. 714 # 715 sub PerformPathsSearchWithLengthUpto { 716 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 717 718 return $This->_PerformPathsSearchWithLength("LengthUpto", $StartVertexID, $Length, $AllowCycles); 719 } 720 721 # Search paths starting from a specified vertex with specified length 722 # with no sharing of edges in paths traversed... 723 # 724 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 725 # completing the cycle. 726 # 727 sub PerformPathsSearchWithLength { 728 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 729 730 return $This->_PerformPathsSearchWithLength("Length", $StartVertexID, $Length, $AllowCycles); 731 } 732 733 734 # Search paths starting from a specified vertex with length upto a specified length 735 # with no sharing of edges in paths traversed... 736 # 737 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 738 # completing the cycle. 739 # 740 sub _PerformPathsSearchWithLength { 741 my($This, $Mode, $StartVertexID, $Length, $AllowCycles) = @_; 742 743 # Make sure both start vertex and length are defined... 744 if (!defined $StartVertexID) { 745 carp "Warning: ${ClassName}->_PerformPathsSearchWithLength: No paths search performed: Start vertex must be specified..."; 746 return undef; 747 } 748 if (!defined $Length) { 749 carp "Warning: ${ClassName}->_PerformPathsSearchWithLength: No paths search performed: Length must be specified..."; 750 return undef; 751 } 752 753 if (!defined $AllowCycles) { 754 $AllowCycles = 1; 755 } 756 757 # Make sure both start vertex and length are valid... 758 if (!$This->{Graph}->HasVertex($StartVertexID)) { 759 carp "Warning: ${ClassName}->_PerformPathsSearchWithLength: No paths search performed: Vertex $StartVertexID doesn't exist..."; 760 return undef; 761 } 762 763 if ($Length < 1) { 764 carp "Warning: ${ClassName}->_PerformPathsSearchWithLength: No paths search performed: Specified length, $Length, must be a positive integer with value greater than 1..."; 765 return undef; 766 } 767 768 # Perform paths search... 769 return $This->_PerformPathsSearch($Mode, $StartVertexID, $AllowCycles, $Length); 770 } 771 772 # Search all paths starting from a specified vertex with sharing of edges in paths traversed... 773 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 774 # completing the cycle. 775 # 776 sub PerformAllPathsSearch { 777 my($This, $StartVertexID, $AllowCycles) = @_; 778 779 # Make sure start vertex is defined... 780 if (!defined $StartVertexID) { 781 carp "Warning: ${ClassName}->PerformAllPathsSearch: No paths search performed: Start vertex must be specified..."; 782 return undef; 783 } 784 785 # Make sure start vertex is valid... 786 if (!$This->{Graph}->HasVertex($StartVertexID)) { 787 carp "Warning: ${ClassName}->PerformAllPathsSearch: No paths search performed: Vertex $StartVertexID doesn't exist..."; 788 return undef; 789 } 790 791 if (!defined $AllowCycles) { 792 $AllowCycles = 1; 793 } 794 795 # Perform paths search... 796 return $This->_PerformAllPathsSearch("AllLengths", $StartVertexID, $AllowCycles); 797 } 798 799 # Search all paths starting from a specified vertex with length upto a specified length with sharing of 800 # edges in paths traversed. 801 # 802 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 803 # completing the cycle. 804 # 805 sub PerformAllPathsSearchWithLengthUpto { 806 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 807 808 return $This->_PerformAllPathsSearchWithLength("LengthUpto", $StartVertexID, $Length, $AllowCycles); 809 } 810 811 # Search all paths starting from a specified vertex with specified length with sharing of 812 # edges in paths traversed. 813 # 814 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 815 # completing the cycle. 816 # 817 sub PerformAllPathsSearchWithLength { 818 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 819 820 return $This->_PerformAllPathsSearchWithLength("Length", $StartVertexID, $Length, $AllowCycles); 821 } 822 823 # Search all paths starting from a specified vertex with length upto a specified length with sharing of 824 # edges in paths traversed. 825 # 826 # By default, cycles are included in paths. A path containing a cycle is terminated at a vertex 827 # completing the cycle. 828 # 829 sub _PerformAllPathsSearchWithLength { 830 my($This, $Mode, $StartVertexID, $Length, $AllowCycles) = @_; 831 832 # Make sure both start vertex and length are defined... 833 if (!defined $StartVertexID) { 834 carp "Warning: ${ClassName}->_PerformAllPathsSearchWithLength: No paths search performed: Start vertex must be specified..."; 835 return undef; 836 } 837 if (!defined $Length) { 838 carp "Warning: ${ClassName}->_PerformAllPathsSearchWithLength: No paths search performed: Length must be specified..."; 839 return undef; 840 } 841 842 if (!defined $AllowCycles) { 843 $AllowCycles = 1; 844 } 845 846 # Make sure both start vertex and length are valid... 847 if (!$This->{Graph}->HasVertex($StartVertexID)) { 848 carp "Warning: ${ClassName}->_PerformAllPathsSearchWithLength: No paths search performed: Vertex $StartVertexID doesn't exist..."; 849 return undef; 850 } 851 852 if ($Length < 1) { 853 carp "Warning: ${ClassName}->_PerformAllPathsSearchWithLength: No paths search performed: Specified length, $Length, must be a positive integer with value greater than 1..."; 854 return undef; 855 } 856 857 # Perform paths search... 858 return $This->_PerformAllPathsSearch($Mode, $StartVertexID, $AllowCycles, $Length); 859 } 860 861 # Search paths between two vertices... 862 # 863 sub PerformPathsSearchBetween { 864 my($This, $StartVertexID, $EndVertexID) = @_; 865 866 # Make sure start and end vertices are defined... 867 if (!defined $StartVertexID) { 868 carp "Warning: ${ClassName}->PerformPathsSearchBetweeb: No paths search performed: Start vertex must be specified..."; 869 return undef; 870 } 871 if (!defined $EndVertexID) { 872 carp "Warning: ${ClassName}->PerformPathsSearchBetweeb: No paths search performed: EndVertex vertex must be specified..."; 873 return undef; 874 } 875 # Make sure start and end vertices are valid... 876 if (!$This->{Graph}->HasVertex($StartVertexID)) { 877 carp "Warning: ${ClassName}->PerformPathsSearchBetween: No paths search performed: Vertex $StartVertexID doesn't exist..."; 878 return undef; 879 } 880 if (!$This->{Graph}->HasVertex($EndVertexID)) { 881 carp "Warning: ${ClassName}->PerformPathsSearchBetween: No paths search performed: Vertex $EndVertexID doesn't exist..."; 882 return undef; 883 } 884 885 # Perform paths search... 886 return $This->_PerformPathsSearchBetween($StartVertexID, $EndVertexID); 887 } 888 889 # Search paths starting from root vertex with no sharing of edges... 890 # 891 # Notes: 892 # . Possible paths searche modes are: DFSPathsWithLimit, DFSPaths. And each 893 # of these modes supports any combination of two options: CommonEdges, Cycles. 894 # Default for CommonEdges - No; Cycles - No. 895 # 896 sub _PerformPathsSearch { 897 my($This, $Mode, $RootVertexID, $AllowCycles, $Length) = @_; 898 899 # Perform DFS path search... 900 901 $This->{TraversalMode} = 'Path'; 902 903 if ($Mode =~ /^(LengthUpto|Length)$/i) { 904 my($DepthLimit); 905 906 $DepthLimit = $Length - 1; 907 $This->{TraversalType} = 'DFSWithLimit'; 908 $This->{DepthLimit} = $DepthLimit; 909 } 910 else { 911 $This->{TraversalType} = 'DFS'; 912 } 913 if (defined $RootVertexID) { 914 $This->{RootVertex} = $RootVertexID; 915 } 916 917 $This->{AllowPathCycles} = $AllowCycles; 918 919 # Perform search... 920 $This->_TraverseGraph(); 921 922 # Make sure traversal did get the root vertex... 923 if (!exists $This->{VerticesDepth}{$RootVertexID}) { 924 return $This; 925 } 926 if ($Mode =~ /^Length$/i) { 927 push @{$This->{Paths}}, $This->_CollectPathsTraversedDuringPathsSearchWithLength($Length); 928 } 929 else { 930 push @{$This->{Paths}}, $This->_CollectPathsTraversedDuringPathsSearch(); 931 } 932 933 return $This; 934 } 935 936 # Search all paths starting from root vertex with sharing of edges... 937 # 938 sub _PerformAllPathsSearch { 939 my($This, $Mode, $RootVertexID, $AllowCycles, $Length) = @_; 940 941 # Perform DFS path search... 942 943 $This->{TraversalMode} = 'AllPaths'; 944 945 if ($Mode =~ /^(LengthUpto|Length)$/i) { 946 my($DepthLimit); 947 948 $DepthLimit = $Length - 1; 949 $This->{TraversalType} = 'DFSWithLimit'; 950 $This->{DepthLimit} = $DepthLimit; 951 } 952 else { 953 $This->{TraversalType} = 'DFS'; 954 } 955 $This->{RootVertex} = $RootVertexID; 956 $This->{AllowPathCycles} = $AllowCycles; 957 958 # Traverse all paths search using DFS search... 959 $This->_TraverseAllPathsInGraph($Mode, $Length); 960 961 return $This; 962 } 963 964 # Travese all paths in graph starting from a specified root vertex... 965 # 966 sub _TraverseAllPathsInGraph { 967 my($This, $Mode, $Length) = @_; 968 969 if ($This->{TraversalMode} !~ /^AllPaths$/i) { 970 return $This; 971 } 972 my($CurrentVertexID, $PredecessorVertexID, $CurrentDepth, $CurrentPath); 973 974 $CurrentVertexID = $This->{RootVertex}; 975 $PredecessorVertexID = $CurrentVertexID; 976 $CurrentDepth = 0; 977 $CurrentPath = "$CurrentVertexID"; 978 979 $This->_TraverseAllPaths($CurrentVertexID, $PredecessorVertexID, $CurrentDepth, $CurrentPath); 980 981 if ($Mode =~ /^Length$/i) { 982 push @{$This->{Paths}}, $This->_CollectPathsTraversedDuringPathsSearchWithLength($Length); 983 } 984 else { 985 push @{$This->{Paths}}, $This->_CollectPathsTraversedDuringPathsSearch(); 986 } 987 988 return $This; 989 } 990 991 # Traverse and collect all paths recuresively.. 992 # 993 sub _TraverseAllPaths { 994 my($This, $CurrentVertexID, $PredecessorVertexID, $CurrentDepth, $CurrentPath) = @_; 995 996 # Save path traversed for current vertex.. 997 if (!exists $This->{VerticesPaths}{$CurrentVertexID}) { 998 @{$This->{VerticesPaths}{$CurrentVertexID}} = (); 999 $This->{VerticesDepth}{$CurrentVertexID} = 0; 1000 } 1001 push @{$This->{VerticesPaths}{$CurrentVertexID}}, $CurrentPath; 1002 $This->{VerticesDepth}{$CurrentVertexID} = $CurrentDepth; 1003 1004 $CurrentDepth++; 1005 if (exists $This->{DepthLimit}) { 1006 if ($CurrentDepth > $This->{DepthLimit}) { 1007 # Nothing more to do... 1008 return $This; 1009 } 1010 } 1011 my($NeighborVertexID, $NewPath); 1012 1013 NEIGHBOR: for $NeighborVertexID ($This->{Graph}->GetNeighbors($CurrentVertexID)) { 1014 if ($NeighborVertexID == $PredecessorVertexID) { 1015 next NEIGHBOR; 1016 } 1017 if ($This->_IsVertexInTraversedPath($NeighborVertexID, $CurrentPath)) { 1018 # It's a cycle... 1019 if ($This->{AllowPathCycles}) { 1020 $NewPath = "${CurrentPath}-${NeighborVertexID}"; 1021 if (!exists $This->{VerticesPaths}{$NeighborVertexID}) { 1022 @{$This->{VerticesPaths}{$NeighborVertexID}} = (); 1023 } 1024 push @{$This->{VerticesPaths}{$NeighborVertexID}}, $NewPath; 1025 } 1026 next NEIGHBOR; 1027 } 1028 $NewPath = "${CurrentPath}-${NeighborVertexID}"; 1029 $This->_TraverseAllPaths($NeighborVertexID, $CurrentVertexID, $CurrentDepth, $NewPath); 1030 } 1031 return $This; 1032 } 1033 1034 # Is vertex already in traversed path? 1035 # 1036 sub _IsVertexInTraversedPath { 1037 my($This, $VertexID, $Path) = @_; 1038 1039 return ($Path =~ /-$VertexID-/ || $Path =~ /^$VertexID-/ || $Path =~ /-$VertexID$/) ? 1 : 0; 1040 } 1041 1042 # Collect all paths traversed during Path TraversalMode and sort 'em in 1043 # ascending order of lengths 1044 # 1045 sub _CollectPathsTraversedDuringPathsSearch { 1046 my($This) = @_; 1047 my($VertexID, @Paths, @SortedPaths); 1048 1049 @Paths = (); @SortedPaths = (); 1050 1051 # Create path objects from path vertex strings... 1052 for $VertexID (keys %{$This->{VerticesPaths}}) { 1053 push @Paths, map { new Graph::Path(split /-/, $_) } @{$This->{VerticesPaths}{$VertexID}}; 1054 } 1055 1056 # Sort paths in ascending order of lengths... 1057 push @SortedPaths, sort { $a->GetLength() <=> $b->GetLength() } @Paths; 1058 1059 return @SortedPaths; 1060 } 1061 1062 # Collect paths traversed during Path TraversalMode with specific length... 1063 # 1064 sub _CollectPathsTraversedDuringPathsSearchWithLength { 1065 my($This, $Length) = @_; 1066 my($VertexID, $Depth, $PathString, @VertexIDs, @Paths); 1067 1068 @Paths = (); 1069 $Depth = $Length - 1; 1070 1071 # Create path objects from path vertex strings... 1072 VERTEXID: for $VertexID (keys %{$This->{VerticesPaths}}) { 1073 if ($This->{VerticesDepth}{$VertexID} != $Depth) { 1074 next VERTEXID; 1075 } 1076 # For vertices involved in cycles, the path might also contain some shorter paths. So check 1077 # the lengths before its collection... 1078 PATHSTRING: for $PathString (@{$This->{VerticesPaths}{$VertexID}}) { 1079 @VertexIDs = split /-/, $PathString; 1080 if ($Length != @VertexIDs) { 1081 next PATHSTRING; 1082 } 1083 push @Paths, new Graph::Path(@VertexIDs); 1084 } 1085 } 1086 return @Paths; 1087 } 1088 1089 # Collect paths traversed during Vertex TraversalMode... 1090 # 1091 sub _CollectPathsTraversedDuringVertexSearch { 1092 my($This, $RootVertexID) = @_; 1093 my($Depth, @Paths, @VerticesAtDepth); 1094 @Paths = (); 1095 1096 # Get vertices at specific depths... 1097 @VerticesAtDepth = (); 1098 @VerticesAtDepth = $This->_CollectVerticesAtSpecificDepths(); 1099 if (!@VerticesAtDepth) { 1100 return @Paths; 1101 } 1102 1103 # Make sure search found only one root vertex and it corresponds to 1104 # what was specified... 1105 $Depth = 0; 1106 if ((@{$VerticesAtDepth[$Depth]} > 1) || ($VerticesAtDepth[$Depth][0] != $RootVertexID)) { 1107 carp "Warning: ${ClassName}->_PerformPathsSearch: No paths found: Root vertex, $VerticesAtDepth[$Depth][0], identified by paths traversal doen't match specified root vertex $RootVertexID..."; 1108 return @Paths; 1109 } 1110 1111 # Setup root vertex at depth 0. And set its path... 1112 my($Path, $VertexID, $SuccessorVertexID, @VertexIDs, %PathAtVertex); 1113 %PathAtVertex = (); 1114 $PathAtVertex{$RootVertexID} = new Graph::Path($RootVertexID); 1115 1116 for $Depth (0 .. $#VerticesAtDepth) { 1117 # Go over all vertices at current depth... 1118 VERTEX: for $VertexID (@{$VerticesAtDepth[$Depth]}) { 1119 if (!exists $This->{VerticesSuccessors}{$VertexID}) { 1120 next VERTEX; 1121 } 1122 # Get vertices for current path... 1123 @VertexIDs = (); 1124 push @VertexIDs, $PathAtVertex{$VertexID}->GetVertices; 1125 1126 # Expand path to successor vertex found during traversal... 1127 for $SuccessorVertexID (@{$This->{VerticesSuccessors}{$VertexID}}) { 1128 $Path = new Graph::Path(@VertexIDs); 1129 $Path->AddVertex($SuccessorVertexID); 1130 $PathAtVertex{$SuccessorVertexID} = $Path; 1131 } 1132 } 1133 } 1134 # Sort paths in ascending order of lengths... 1135 push @Paths, sort { $a->GetLength() <=> $b->GetLength() } values %PathAtVertex; 1136 1137 return @Paths; 1138 } 1139 1140 # Collect vertices at specific depths. Depth values start from 0... 1141 # 1142 sub _CollectVerticesAtSpecificDepths { 1143 my($This) = @_; 1144 my($VertexID, $Depth, @VerticesAtDepth); 1145 1146 @VerticesAtDepth = (); 1147 while (($VertexID, $Depth) = each %{$This->{VerticesDepth}}) { 1148 push @{$VerticesAtDepth[$Depth]}, $VertexID; 1149 } 1150 return @VerticesAtDepth; 1151 } 1152 1153 # Collect vertices, along with their successors, at specific depths and return a list containing references to 1154 # lists with first value corresponding to vertex ID and second value a reference to a list containing 1155 # its successors. 1156 # 1157 # Depth values start from 0... 1158 # 1159 sub _CollectVerticesWithSuccessorsAtSpecificDepths { 1160 my($This) = @_; 1161 my($VertexID, $Depth, @VerticesWithSuccessorsAtDepth); 1162 1163 @VerticesWithSuccessorsAtDepth = (); 1164 while (($VertexID, $Depth) = each %{$This->{VerticesDepth}}) { 1165 my(@VertexWithSuccessors, @VertexSuccessors); 1166 1167 @VertexWithSuccessors = (); @VertexSuccessors = (); 1168 if (exists $This->{VerticesSuccessors}{$VertexID}) { 1169 push @VertexSuccessors, @{$This->{VerticesSuccessors}{$VertexID}}; 1170 } 1171 push @VertexWithSuccessors, ($VertexID, \@VertexSuccessors); 1172 # Multiple entries for a vertex and its successors could be present at a specific depth... 1173 push @{$VerticesWithSuccessorsAtDepth[$Depth]}, \@VertexWithSuccessors; 1174 } 1175 return @VerticesWithSuccessorsAtDepth; 1176 } 1177 1178 # Search paths between two vertices... 1179 # 1180 sub _PerformPathsSearchBetween { 1181 my($This, $RootVertexID, $TargetVertexID) = @_; 1182 my($DepthLimit); 1183 1184 # Perform a targeted DFS search... 1185 $DepthLimit = undef; 1186 $This->_PerformVertexSearch("DFS", $RootVertexID, $DepthLimit, $TargetVertexID); 1187 1188 my($Path); 1189 $Path = $This->_CollectPathBetween($RootVertexID, $TargetVertexID); 1190 1191 if (defined $Path) { 1192 push @{$This->{Paths}}, $Path; 1193 } 1194 return $This; 1195 } 1196 1197 # Collect path between root and target vertex after the search... 1198 # 1199 sub _CollectPathBetween { 1200 my($This, $RootVertexID, $TargetVertexID) = @_; 1201 1202 # Does a path from root to target vertex exist? 1203 if (!(exists($This->{VerticesRoots}{$TargetVertexID}) && ($This->{VerticesRoots}{$TargetVertexID} == $RootVertexID))) { 1204 return undef; 1205 } 1206 1207 # Add target vertex ID path vertices... 1208 my($VertexID, $Path, @VertexIDs); 1209 @VertexIDs = (); 1210 $VertexID = $TargetVertexID; 1211 push @VertexIDs, $VertexID; 1212 1213 # Backtrack to root vertex ID... 1214 while ($This->{VerticesPredecessors}{$VertexID} != $VertexID) { 1215 $VertexID = $This->{VerticesPredecessors}{$VertexID}; 1216 push @VertexIDs, $VertexID; 1217 } 1218 1219 # Create path from target to root and reverse it... 1220 $Path = new Graph::Path(@VertexIDs); 1221 $Path->Reverse(); 1222 1223 return $Path; 1224 } 1225 1226 # Search vertices around specified root vertex with in specific neighborhood radius... 1227 # 1228 sub PerformNeighborhoodVerticesSearchWithRadiusUpto { 1229 my($This, $StartVertexID, $Radius) = @_; 1230 1231 # Make sure both start vertex and radius are defined... 1232 if (!defined $StartVertexID) { 1233 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithRadiusUpto: No vertices search performed: Start vertex must be specified..."; 1234 return undef; 1235 } 1236 if (!defined $Radius) { 1237 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithRadiusUpto: No vertices search performed: Radius must be specified..."; 1238 return undef; 1239 } 1240 1241 # Make sure both start vertex and length are valid... 1242 if (!$This->{Graph}->HasVertex($StartVertexID)) { 1243 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithRadiusUpto: No vertices search performed: Vertex $StartVertexID doesn't exist..."; 1244 return undef; 1245 } 1246 if ($Radius < 0) { 1247 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithRadiusUpto: No vertices search performed: Specified radius, $Radius, must be a positive integer..."; 1248 return undef; 1249 } 1250 1251 # Perform vertices search... 1252 return $This->_PerformNeighborhoodVerticesSearch("RadiusUpto", $StartVertexID, $Radius); 1253 } 1254 1255 # Search vertices around specified root vertex... 1256 # 1257 sub PerformNeighborhoodVerticesSearch { 1258 my($This, $StartVertexID) = @_; 1259 1260 # Make sure start vertex is defined... 1261 if (!defined $StartVertexID) { 1262 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearch: No vertices search performed: Start vertex must be specified..."; 1263 return undef; 1264 } 1265 1266 # Make sure start vertex is valid... 1267 if (!$This->{Graph}->HasVertex($StartVertexID)) { 1268 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearch: No vertices search performed: Vertex $StartVertexID doesn't exist..."; 1269 return undef; 1270 } 1271 # Perform vertices search... 1272 return $This->_PerformNeighborhoodVerticesSearch("AllRadii", $StartVertexID); 1273 } 1274 1275 # Search vertices around specified root vertex with in specific neighborhood radius along with 1276 # identification of successors of each vertex found during the search... 1277 # 1278 sub PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto { 1279 my($This, $StartVertexID, $Radius) = @_; 1280 1281 # Make sure both start vertex and radius are defined... 1282 if (!defined $StartVertexID) { 1283 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto: No vertices search performed: Start vertex must be specified..."; 1284 return undef; 1285 } 1286 if (!defined $Radius) { 1287 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto: No vertices search performed: Radius must be specified..."; 1288 return undef; 1289 } 1290 1291 # Make sure both start vertex and length are valid... 1292 if (!$This->{Graph}->HasVertex($StartVertexID)) { 1293 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto: No vertices search performed: Vertex $StartVertexID doesn't exist..."; 1294 return undef; 1295 } 1296 if ($Radius < 0) { 1297 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto: No vertices search performed: Specified radius, $Radius, must be a positive integer..."; 1298 return undef; 1299 } 1300 1301 # Perform vertices search... 1302 return $This->_PerformNeighborhoodVerticesSearch("WithSuccessorsAndRadiusUpto", $StartVertexID, $Radius); 1303 } 1304 1305 # Search vertices around specified root vertex along with identification of 1306 # successors of each vertex found during the search... 1307 # 1308 sub PerformNeighborhoodVerticesSearchWithSuccessors { 1309 my($This, $StartVertexID) = @_; 1310 1311 # Make sure start vertex is defined... 1312 if (!defined $StartVertexID) { 1313 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessors: No vertices search performed: Start vertex must be specified..."; 1314 return undef; 1315 } 1316 1317 # Make sure start vertex is valid... 1318 if (!$This->{Graph}->HasVertex($StartVertexID)) { 1319 carp "Warning: ${ClassName}->PerformNeighborhoodVerticesSearchWithSuccessors: No vertices search performed: Vertex $StartVertexID doesn't exist..."; 1320 return undef; 1321 } 1322 # Perform vertices search... 1323 return $This->_PerformNeighborhoodVerticesSearch("WithSuccessorsAndAllRadii", $StartVertexID); 1324 } 1325 1326 # Search vertices at successive neighborhood radii levels... 1327 # 1328 sub _PerformNeighborhoodVerticesSearch { 1329 my($This, $Mode, $RootVertexID, $Radius) = @_; 1330 my($DepthLimit, $AllowCycles); 1331 1332 $DepthLimit = defined $Radius ? $Radius : undef; 1333 $AllowCycles = undef; 1334 1335 # Perform BFS search... 1336 if ($Mode =~ /^RadiusUpto$/i) { 1337 $This->_PerformVertexNeighborhoodSearch("BFSWithLimit", $RootVertexID, $DepthLimit); 1338 } 1339 elsif ($Mode =~ /^(AllRadii)$/i) { 1340 $This->_PerformVertexNeighborhoodSearch("BFS", $RootVertexID); 1341 } 1342 elsif ($Mode =~ /^WithSuccessorsAndRadiusUpto$/i) { 1343 $AllowCycles = 1; 1344 $This->_PerformVertexNeighborhoodSearch("BFSWithLimit", $RootVertexID, $DepthLimit, $AllowCycles); 1345 } 1346 elsif ($Mode =~ /^WithSuccessorsAndAllRadii$/i) { 1347 $AllowCycles = 1; 1348 $This->_PerformVertexNeighborhoodSearch("BFSWithLimit", $RootVertexID, $DepthLimit, $AllowCycles); 1349 } 1350 1351 # Make sure traversal did get the root vertex... 1352 if (!exists $This->{VerticesDepth}{$RootVertexID}) { 1353 return $This; 1354 } 1355 1356 if ($Mode =~ /^(RadiusUpto|AllRadii)$/i) { 1357 push @{$This->{VerticesNeighborhoods}}, $This->_CollectVerticesAtSpecificDepths(); 1358 } 1359 elsif ($Mode =~ /^(WithSuccessorsAndRadiusUpto|WithSuccessorsAndAllRadii)$/i) { 1360 push @{$This->{VerticesNeighborhoodsWithSuccessors}}, $This->_CollectVerticesWithSuccessorsAtSpecificDepths(); 1361 } 1362 1363 return $This; 1364 } 1365 1366 # Perform appropriate vertex search... 1367 # 1368 sub _PerformVertexNeighborhoodSearch { 1369 my($This, $SearchType, $RootVertexID, $DepthLimit, $AllowCycles) = @_; 1370 1371 # Setup search... 1372 $This->{TraversalMode} = 'VertexNeighborhood'; 1373 $This->{TraversalType} = $SearchType; 1374 1375 if (defined $RootVertexID) { 1376 $This->{RootVertex} = $RootVertexID; 1377 } 1378 if (defined $DepthLimit) { 1379 $This->{DepthLimit} = $DepthLimit; 1380 } 1381 if (defined $AllowCycles) { 1382 $This->{AllowVertexCycles} = $AllowCycles; 1383 } 1384 1385 # Perform search... 1386 return $This->_TraverseGraph(); 1387 } 1388 1389 # Get orderded list of vertices after DFS/BFS search... 1390 # 1391 sub GetVertices { 1392 my($This) = @_; 1393 1394 return wantarray ? @{$This->{Vertices}} : scalar @{$This->{Vertices}}; 1395 } 1396 1397 # Get a hash list containing vertex and root vertex as key/value pair for all vertices 1398 # ordered using DFS/BFS search available via GetVertices method... 1399 # 1400 sub GetVerticesRoots { 1401 my($This) = @_; 1402 1403 return %{$This->{VerticesRoots}}; 1404 } 1405 1406 # Get a list containing lists of vertices in connected components of graph after DFS/BFS 1407 # search... 1408 # 1409 # Note: 1410 # . List is sorted in descending order of number of vertices in each connected component. 1411 # 1412 sub GetConnectedComponentsVertices { 1413 my($This) = @_; 1414 my($VertexID, $VertexRoot, @ConnectedVertices, %VerticesAtRoot); 1415 1416 @ConnectedVertices = (); 1417 %VerticesAtRoot = (); 1418 for $VertexID (@{$This->{Vertices}}) { 1419 $VertexRoot = $This->{VerticesRoots}{$VertexID}; 1420 if (!exists $VerticesAtRoot{$VertexRoot}) { 1421 @{$VerticesAtRoot{$VertexRoot}} = (); 1422 } 1423 push @{$VerticesAtRoot{$VertexRoot}}, $VertexID; 1424 } 1425 push @ConnectedVertices, sort { @{$b} <=> @{$a} } values %VerticesAtRoot; 1426 1427 return wantarray ? @ConnectedVertices : scalar @ConnectedVertices; 1428 } 1429 1430 # Get predecessor vertices... 1431 # 1432 sub GetVerticesPredecessors { 1433 my($This) = @_; 1434 1435 return %{$This->{VerticesPredecessors}}; 1436 } 1437 1438 # Get a hash list containing vertex and depth from root vertex as key/value pair for all vertices 1439 # ordered using DFS/BFS search available via GetVertices method... 1440 # 1441 sub GetVerticesDepth { 1442 my($This) = @_; 1443 1444 return %{$This->{VerticesDepth}}; 1445 } 1446 1447 # Get paths found during paths search... 1448 # 1449 sub GetPaths { 1450 my($This) = @_; 1451 1452 return wantarray ? @{$This->{Paths}} : scalar @{$This->{Paths}}; 1453 } 1454 1455 # Get vertices collected at various neighborhood radii... 1456 # 1457 sub GetVerticesNeighborhoods { 1458 my($This) = @_; 1459 1460 return wantarray ? @{$This->{VerticesNeighborhoods}} : scalar @{$This->{VerticesNeighborhoods}}; 1461 } 1462 1463 # Get vertices, along with their successor vertices, collected at various neighborhood radii as 1464 # a list containing references to lists with first value corresponding to vertex ID and second value 1465 # a reference to a list containing its successors. 1466 # 1467 sub GetVerticesNeighborhoodsWithSuccessors { 1468 my($This) = @_; 1469 1470 return wantarray ? @{$This->{VerticesNeighborhoodsWithSuccessors}} : scalar @{$This->{VerticesNeighborhoodsWithSuccessors}}; 1471 } 1472 1473 # Return a string containg data for PathsTraversal object... 1474 sub StringifyPathsTraversal { 1475 my($This) = @_; 1476 my($PathsTraversalString); 1477 1478 $PathsTraversalString = "PathsTraversalMode: " . $This->{TraversalMode}; 1479 $PathsTraversalString .= "; PathsTraversalType: " . $This->{TraversalType}; 1480 1481 # Vertices ordered by traversal... 1482 $PathsTraversalString .= "; Vertices: " . join(' ', @{$This->{Vertices}}); 1483 1484 # Stringify depths of vertices... 1485 $PathsTraversalString .= "; " . $This->StringifyVerticesDepth(); 1486 1487 # Stringify roots of vertices... 1488 $PathsTraversalString .= "; " . $This->StringifyVerticesRoots(); 1489 1490 # Stringify predecessor of vertices... 1491 $PathsTraversalString .= "; " . $This->StringifyVerticesPredecessors(); 1492 1493 # Stringify successor vertices... 1494 $PathsTraversalString .= "; " . $This->StringifyVerticesSuccessors(); 1495 1496 # Stringify paths... 1497 $PathsTraversalString .= "; " . $This->StringifyPaths(); 1498 1499 # Stringify vertices neighborhoods... 1500 $PathsTraversalString .= "; " . $This->StringifyVerticesNeighborhoods(); 1501 1502 # Stringify vertices neighborhoods with successors... 1503 $PathsTraversalString .= "; " . $This->StringifyVerticesNeighborhoodsWithSuccessors(); 1504 1505 return $PathsTraversalString; 1506 } 1507 1508 # Stringify vertices depth... 1509 # 1510 sub StringifyVerticesDepth { 1511 my($This) = @_; 1512 my($VertexID, $VertexDepth, $DepthString); 1513 1514 if (!@{$This->{Vertices}}) { 1515 $DepthString = "<Vertex-Depth>: None"; 1516 return $DepthString; 1517 } 1518 1519 $DepthString = "<Vertex-Depth>: "; 1520 for $VertexID (@{$This->{Vertices}}) { 1521 $VertexDepth = $This->{VerticesDepth}{$VertexID}; 1522 $DepthString .= " <$VertexID-$VertexDepth>"; 1523 } 1524 return $DepthString; 1525 } 1526 1527 # Stringify roots of vertices... 1528 # 1529 sub StringifyVerticesRoots { 1530 my($This) = @_; 1531 my($VertexID, $RootVertexID, $RootsString); 1532 1533 if (!@{$This->{Vertices}}) { 1534 $RootsString = "<Vertex-RootVertex>: None"; 1535 return $RootsString; 1536 } 1537 1538 $RootsString = "<Vertex-RootVertex>: "; 1539 for $VertexID (@{$This->{Vertices}}) { 1540 $RootVertexID = $This->{VerticesRoots}{$VertexID}; 1541 $RootsString .= " <$VertexID-$RootVertexID>"; 1542 } 1543 return $RootsString; 1544 } 1545 1546 # Stringify predecessor of vertices... 1547 # 1548 sub StringifyVerticesPredecessors { 1549 my($This) = @_; 1550 my($VertexID, $PredecessorVertexID, $PredecessorString); 1551 1552 if (!@{$This->{Vertices}}) { 1553 $PredecessorString = "<Vertex-PredecessorVertex>: None"; 1554 return $PredecessorString; 1555 } 1556 1557 $PredecessorString = "<Vertex-PredecessorVertex>: "; 1558 for $VertexID (@{$This->{Vertices}}) { 1559 $PredecessorVertexID = $This->{VerticesPredecessors}{$VertexID}; 1560 $PredecessorString .= " <$VertexID-$PredecessorVertexID>"; 1561 } 1562 return $PredecessorString; 1563 } 1564 1565 # Stringify successor vertices... 1566 # 1567 sub StringifyVerticesSuccessors { 1568 my($This) = @_; 1569 my($VertexID, $SuccessorString, $VerticesSuccessorsString); 1570 1571 if (!@{$This->{Vertices}}) { 1572 $SuccessorString = "<Vertex-VerticesSuccessorsList>: None"; 1573 return $SuccessorString; 1574 } 1575 1576 $SuccessorString = "<Vertex-VerticesSuccessorsList>: "; 1577 for $VertexID (@{$This->{Vertices}}) { 1578 if (exists($This->{VerticesSuccessors}{$VertexID}) && @{$This->{VerticesSuccessors}{$VertexID}}) { 1579 $VerticesSuccessorsString = join(',', @{$This->{VerticesSuccessors}{$VertexID}}); 1580 } 1581 else { 1582 $VerticesSuccessorsString = "None"; 1583 } 1584 $SuccessorString .= " <$VertexID-$VerticesSuccessorsString>"; 1585 } 1586 return $SuccessorString; 1587 } 1588 1589 # Strinigify paths... 1590 # 1591 sub StringifyPaths { 1592 my($This) = @_; 1593 my($PathsString, $Path); 1594 1595 if (!@{$This->{Paths}}) { 1596 $PathsString = "Paths: None"; 1597 return $PathsString; 1598 } 1599 1600 my($FirstPath); 1601 $PathsString = "Paths: "; 1602 $FirstPath = 1; 1603 for $Path (@{$This->{Paths}}) { 1604 if ($FirstPath) { 1605 $FirstPath = 0; 1606 } 1607 else { 1608 $PathsString .= " "; 1609 } 1610 $PathsString .= "<" . join('-', $Path->GetVertices()) . ">"; 1611 } 1612 return $PathsString; 1613 } 1614 1615 # Strinigify vertices neighborhoods... 1616 # 1617 sub StringifyVerticesNeighborhoods { 1618 my($This) = @_; 1619 my($NeighborhoodsString, $NeighborhoodVerticesString, $Radius); 1620 1621 if (!@{$This->{VerticesNeighborhoods}}) { 1622 $NeighborhoodsString = "<NeighborhoodRadius-NeighborhoodVerticesList>: None"; 1623 return $NeighborhoodsString; 1624 } 1625 $NeighborhoodsString = "<NeighborhoodRadius-NeighborhoodVerticesList>:"; 1626 for $Radius (0 .. $#{$This->{VerticesNeighborhoods}}) { 1627 $NeighborhoodVerticesString = join(',', @{$This->{VerticesNeighborhoods}[$Radius]}); 1628 $NeighborhoodsString .= " <$Radius-$NeighborhoodVerticesString>"; 1629 } 1630 1631 return $NeighborhoodsString; 1632 } 1633 1634 # Strinigify vertices neighborhoods... 1635 # 1636 sub StringifyVerticesNeighborhoodsWithSuccessors { 1637 my($This) = @_; 1638 my($NeighborhoodsString, $NeighborhoodVertexSuccessorsString, $Radius, $NeighborhoodVertericesWithSuccessorsRef, $NeighborhoodVertexWithSuccessorsRef, $VertexID, $NeighborhoodVertexSuccessorsRef); 1639 1640 if (!@{$This->{VerticesNeighborhoodsWithSuccessors}}) { 1641 $NeighborhoodsString = "<NeighborhoodRadius-NeighborhoodVertex-NeighborhoodVerticeSuccessorsList>: None"; 1642 return $NeighborhoodsString; 1643 } 1644 $NeighborhoodsString = "<NeighborhoodRadius-NeighborhoodVertex-NeighborhoodVerticeSuccessorsList>: None"; 1645 1646 $Radius = 0; 1647 for $NeighborhoodVertericesWithSuccessorsRef (@{$This->{VerticesNeighborhoodsWithSuccessors}}) { 1648 for $NeighborhoodVertexWithSuccessorsRef (@{$NeighborhoodVertericesWithSuccessorsRef}) { 1649 ($VertexID, $NeighborhoodVertexSuccessorsRef) = @{$NeighborhoodVertexWithSuccessorsRef}; 1650 $NeighborhoodVertexSuccessorsString = 'None'; 1651 if (@{$NeighborhoodVertexSuccessorsRef}) { 1652 $NeighborhoodVertexSuccessorsString = join(',', @{$NeighborhoodVertexSuccessorsRef}); 1653 } 1654 $NeighborhoodsString .= " <$Radius-$VertexID-$NeighborhoodVertexSuccessorsString>"; 1655 } 1656 $Radius++; 1657 } 1658 return $NeighborhoodsString; 1659 } 1660 1661 # Return a reference to new paths traversal object... 1662 sub Copy { 1663 my($This) = @_; 1664 my($NewPathsTraversal); 1665 1666 $NewPathsTraversal = Storable::dclone($This); 1667 1668 return $NewPathsTraversal; 1669 } 1670