MayaChemTools

   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