       1 package Graph::Path;
       2 #
       3 # File: Path.pm
       4 # Author: Manish Sud <msud@san.rr.com>
       5 #
       6 # Copyright (C) 2018 Manish Sud. All rights reserved.
       7 #
       8 # This file is part of MayaChemTools.
       9 #
      10 # MayaChemTools is free software; you can redistribute it and/or modify it under
      11 # the terms of the GNU Lesser General Public License as published by the Free
      12 # Software Foundation; either version 3 of the License, or (at your option) any
      13 # later version.
      14 #
      15 # MayaChemTools is distributed in the hope that it will be useful, but without
      16 # any warranty; without even the implied warranty of merchantability of fitness
      17 # for a particular purpose.  See the GNU Lesser General Public License for more
      18 # details.
      19 #
      20 # You should have received a copy of the GNU Lesser General Public License
      21 # along with MayaChemTools; if not, see <http://www.gnu.org/licenses/> or
      22 # write to the Free Software Foundation Inc., 59 Temple Place, Suite 330,
      23 # Boston, MA, 02111-1307, USA.
      24 #
      25
      26 use strict;
      27 use Carp;
      28 use Exporter;
      29 use Storable ();
      30 use Scalar::Util ();
      31
      32 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
      33
      34 @ISA = qw(Exporter);
      35 @EXPORT = qw();
      36 @EXPORT_OK = qw();
      37
      38 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
      39
      40 # Setup class variables...
      41 my($ClassName, $ObjectID);
      42 _InitializeClass();
      43
      44 # Overload Perl functions...
      45 use overload '""' => 'StringifyPath',
      46
      47   '==' => '_PathEqualOperator',
      48   'eq' => '_PathEqualOperator',
      49
      50   'fallback' => undef;
      51
      52 # Class constructor...
      53 sub new {
      54   my($Class, @VertexIDs) = @_;
      55
      56   # Initialize object...
      57   my $This = {};
      58   bless $This, ref($Class) || $Class;
      59   $This->_InitializePath();
      60
      61   if (@VertexIDs) { $This->AddVertices(@VertexIDs); }
      62
      63   return $This;
      64 }
      65
      66 # Initialize object data...
      67 #
      68 sub _InitializePath {
      69   my($This) = @_;
      70
      71   @{$This->{Vertices}} = ();
      72 }
      73
      74 # Initialize class ...
      75 sub _InitializeClass {
      76   #Class name...
      77   $ClassName = __PACKAGE__;
      78 }
      79
      80 # Add a vertex to path after the end vertex...
      81 #
      82 sub AddVertex {
      83   my($This, $VertexID) = @_;
      84
      85   if (!defined $VertexID ) {
      86     carp "Warning: ${ClassName}->AddVertex: No vertex added: Vertex ID must be specified...";
      87     return undef;
      88   }
      89   push @{$This->{Vertices}}, $VertexID;
      90
      91   return $This;
      92 }
      93
      94 # Add vertices to the path after the end vertex...
      95 #
      96 sub AddVertices {
      97   my($This, @VertexIDs) = @_;
      98
      99   if (!@VertexIDs) {
     100     carp "Warning: ${ClassName}->AddVertices: No vertices added: Vertices list is empty...";
     101     return undef;
     102   }
     103   push @{$This->{Vertices}}, @VertexIDs;
     104
     105   return $This;
     106 }
     107
     108 # Add a vertex to path after the end vertex...
     109 #
     110 sub PushVertex {
     111   my($This, $VertexID) = @_;
     112
     113   return $This->AddVertex($VertexID);
     114 }
     115
     116 # Add vertices to the path after the end vertex...
     117 #
     118 sub PushVertices {
     119   my($This, @VertexIDs) = @_;
     120
     121   return $This->AddVertices(@VertexIDs);
     122 }
     123
     124 # Remove end vertex from path...
     125 #
     126 sub PopVertex {
     127   my($This) = @_;
     128
     129   if (!@{$This->{Vertices}}) {
     130     carp "Warning: ${ClassName}->PopVertex: No vertex removed: Path is empty...";
     131     return undef;
     132   }
     133   pop @{$This->{Vertices}};
     134
     135   return $This;
     136 }
     137
     138 # Remove start vertex from path...
     139 #
     140 sub ShiftVertex {
     141   my($This) = @_;
     142
     143   if (!@{$This->{Vertices}}) {
     144     carp "Warning: ${ClassName}->ShiftVertex: No vertex removed: Path is empty...";
     145     return undef;
     146   }
     147   shift @{$This->{Vertices}};
     148
     149   return $This;
     150 }
     151
     152 # Add a vertex to path before the start vertex...
     153 #
     154 sub UnshiftVertex {
     155   my($This, $VertexID) = @_;
     156
     157   if (!defined $VertexID ) {
     158     carp "Warning: ${ClassName}->UnshiftVertex: No vertex added: Vertex ID must be specified...";
     159     return undef;
     160   }
     161   unshift @{$This->{Vertices}}, $VertexID;
     162
     163   return $This;
     164 }
     165
     166 # Add vertices to the path before the start vertex...
     167 #
     168 sub UnshiftVertices {
     169   my($This, @VertexIDs) = @_;
     170
     171   if (!@VertexIDs) {
     172     carp "Warning: ${ClassName}->UnshiftVertices: No vertices added: Vertices list is empty...";
     173     return undef;
     174   }
     175   unshift @{$This->{Vertices}}, @VertexIDs;
     176
     177   return $This;
     178 }
     179
     180 # Get length...
     181 #
     182 sub GetLength {
     183   my($This) = @_;
     184
     185   return scalar @{$This->{Vertices}};
     186 }
     187
     188 # Get start vertex...
     189 #
     190 sub GetStartVertex {
     191   my($This) = @_;
     192
     193   if (!$This->GetLength()) {
     194     return undef;
     195   }
     196   my($Index) = 0;
     197   return $This->_GetVertex($Index);
     198 }
     199
     200 # Get end vertex...
     201 #
     202 sub GetEndVertex {
     203   my($This) = @_;
     204
     205   if (!$This->GetLength()) {
     206     return undef;
     207   }
     208   my($Index);
     209
     210   $Index = $This->GetLength() - 1;
     211   return $This->_GetVertex($Index);
     212 }
     213
     214 # Get start and end vertices...
     215 #
     216 sub GetTerminalVertices {
     217   my($This) = @_;
     218
     219   return ( $This->GetStartVertex(), $This->GetEndVertex() ),
     220 }
     221
     222 # Get path vertices...
     223 #
     224 sub GetVertices {
     225   my($This) = @_;
     226
     227   return wantarray ? @{$This->{Vertices}} : scalar @{$This->{Vertices}};
     228 }
     229
     230 # Get a specific vertex from path with indicies starting from 0...
     231 #
     232 sub GetVertex {
     233   my($This, $Index) = @_;
     234
     235   if ($Index < 0) {
     236     croak "Error: ${ClassName}->GetValue: Index value must be a positive number...";
     237   }
     238   if ($Index >= $This->GetLength()) {
     239     croak "Error: ${ClassName}->GetValue: Index vaue must be less than length of path...";
     240   }
     241   if (!$This->GetLength()) {
     242     return undef;
     243   }
     244   return $This->_GetVertex($Index);
     245 }
     246
     247 # Get a vertex...
     248 #
     249 sub _GetVertex {
     250   my($This, $Index) = @_;
     251
     252   return $This->{Vertices}[$Index];
     253 }
     254
     255 # Get path edges as pair of vertices or number of edges...
     256 #
     257 sub GetEdges {
     258   my($This) = @_;
     259
     260   if ($This->GetLength < 1) {
     261     return undef;
     262   }
     263   # Set up edges...
     264   my($Index, $VertexID1, $VertexID2, @Vertices, @Edges);
     265
     266   @Edges = ();
     267   for $Index (0 .. ($#{$This->{Vertices}} - 1) ) {
     268     $VertexID1 = $This->{Vertices}[$Index];
     269     $VertexID2 = $This->{Vertices}[$Index + 1];
     270     push @Edges, ($VertexID1, $VertexID2);
     271   }
     272
     273   return wantarray ? @Edges : ((scalar @Edges)/2);
     274 }
     275
     276 # Is it a cycle?
     277 #
     278 sub IsCycle {
     279   my($This) = @_;
     280   my($StartVertex, $EndVertex);
     281
     282   ($StartVertex, $EndVertex) = $This->GetTerminalVertices();
     283
     284   return ($StartVertex == $EndVertex) ? 1 : 0;
     285 }
     286
     287 # For a path to be an independent path, it must meet the following conditions:
     288 #   . All other vertices are unique.
     289 #
     290 sub IsIndependentPath {
     291   my($This) = @_;
     292
     293   # Make sure it has at least two vertices...
     294   if ($This->GetLength() < 2) {
     295     return 0;
     296   }
     297
     298   # Check frequency of occurence for non-terminal vertices...
     299   my($VertexID, $IndependenceStatus, @Vertices, %VerticesMap);
     300
     301   @Vertices = $This->GetVertices();
     302   shift @Vertices; pop @Vertices;
     303
     304   %VerticesMap = ();
     305   $IndependenceStatus = 1;
     306
     307   VERTEXID: for $VertexID (@Vertices) {
     308     if (exists $VerticesMap{$VertexID} ) {
     309       $IndependenceStatus = 0;
     310       last VERTEXID;
     311     }
     312     $VerticesMap{$VertexID} = $VertexID;
     313   }
     314   return $IndependenceStatus;
     315 }
     316
     317 # For a path to be an independent cyclic path, it must meet the following conditions:
     318 #   . Termimal vertices are the same
     319 #   . All other vertices are unique.
     320 #
     321 sub IsIndependentCyclicPath {
     322   my($This) = @_;
     323
     324   # Make sure it's a cycle...
     325   if (!($This->GetLength() >= 3 && $This->IsCycle())) {
     326     return 0;
     327   }
     328   return $This->IsIndependentPath();
     329 }
     330
     331 # Is it a path object?
     332 sub IsPath ($) {
     333   my($Object) = @_;
     334
     335   return _IsPath($Object);
     336 }
     337
     338 # Copy path...
     339 #
     340 sub Copy {
     341   my($This) = @_;
     342   my($NewPath);
     343
     344   $NewPath = Storable::dclone($This);
     345
     346   return $NewPath;
     347 }
     348
     349 # Reverse order of vertices in path...
     350 #
     351 sub Reverse {
     352   my($This) = @_;
     353   my(@VertexIDs);
     354
     355   @VertexIDs = (); push @VertexIDs, @{$This->{Vertices}};
     356
     357   @{$This->{Vertices}} = (); push @{$This->{Vertices}}, reverse @VertexIDs;
     358
     359   return $This;
     360 }
     361
     362 # Get vertices common between two paths...
     363 #
     364 sub GetCommonVertices {
     365   my($This, $Other) = @_;
     366   my($VertexID, @CommonVertices, %OtherVerticesMap);
     367
     368   # Setup a vertices hash for a quick look up...
     369   %OtherVerticesMap = ();
     370   for $VertexID ($Other->GetVertices()) {
     371     $OtherVerticesMap{$VertexID} = $VertexID;
     372   }
     373
     374   @CommonVertices = ();
     375   for $VertexID ($This->GetVertices()) {
     376     if ($OtherVerticesMap{$VertexID}) {
     377       push @CommonVertices, $VertexID
     378     }
     379   }
     380   return wantarray ? @CommonVertices : scalar @CommonVertices;
     381 }
     382
     383 # Join the existing path with a new path specifed using a path object of a list of
     384 # verticies.
     385 #
     386 sub Join {
     387   my($This, @Values) = @_;
     388
     389   return $This->_Join(@Values);
     390 }
     391
     392 # Join the existing path with a new path specifed using a path object at a specified
     393 # vertex.
     394 #
     395 sub JoinAtVertex {
     396   my($This, $Other, $CenterVertexID) = @_;
     397
     398   # Make sure CenterVertexID is end vertex in This and start vertex in Other before
     399   # joining them...
     400   if ($This->GetEndVertex() != $CenterVertexID) {
     401     $This->Reverse();
     402   }
     403   if ($Other->GetStartVertex() != $CenterVertexID) {
     404     $Other->Reverse();
     405   }
     406   return $This->_Join($Other);
     407 }
     408
     409 # Join the existing path with a new path specifed using a path object of a list of
     410 # verticies.
     411 #
     412 # Notes:
     413 #  . Paths must have a common terminal vertex.
     414 #  . Based on the common terminal vertex found, new path vertices are added to the
     415 #    current path in one of the four ways:
     416 #    . New path at end of current path with same vertices order : EndVertex = NewStartVertex
     417 #    . New path at end of current path with reversed vertices order: EndVertex = NewEndVertex
     418 #    . New path at front of current path with same vertices order: StartVertex = NewEndVertex
     419 #    . New path at front of current path with reversed vertices order: StartVertex = NewStartVertex
     420 #
     421 sub _Join {
     422   my($This, @Values) = @_;
     423
     424   if (!@Values) {
     425     return;
     426   }
     427
     428   # Get a list of new vertex IDs..
     429   my($NewPath, $FirstValue, $TypeOfFirstValue, @NewVertexIDs);
     430
     431   $NewPath = $This->Copy();
     432
     433   @NewVertexIDs = ();
     434   $FirstValue = $Values[0];
     435   $TypeOfFirstValue = ref $FirstValue;
     436   if ($TypeOfFirstValue =~ /^(SCALAR|HASH|CODE|REF|GLOB)/) {
     437     croak "Error: ${ClassName}->JoinPath: Trying to add vertices to path object with a reference to unsupported value format...";
     438   }
     439
     440   if (_IsPath($FirstValue)) {
     441     # It's another path object...
     442     push @NewVertexIDs,  @{$FirstValue->{Vertices}};
     443   }
     444   elsif ($TypeOfFirstValue =~ /^ARRAY/) {
     445     # It's array reference...
     446     push @NewVertexIDs,  @{$FirstValue};
     447   }
     448   else {
     449     # It's a list of values...
     450     push @NewVertexIDs,  @Values;
     451   }
     452   my($StartVertex, $EndVertex, $NewStartVertex, $NewEndVertex);
     453
     454   ($StartVertex, $EndVertex) = $NewPath->GetTerminalVertices();
     455   ($NewStartVertex, $NewEndVertex) = ($NewVertexIDs[0], $NewVertexIDs[$#NewVertexIDs]);
     456
     457   if (!($EndVertex == $NewStartVertex || $EndVertex == $NewEndVertex || $StartVertex == $NewEndVertex || $StartVertex == $NewStartVertex)) {
     458     carp "Warning: ${ClassName}->JoinPath: Paths can't be joined: No common terminal vertex found...";
     459     return undef;
     460   }
     461
     462   if ($EndVertex == $NewStartVertex) {
     463     # Take out EndVertex and add new path at the end...
     464     pop @{$NewPath->{Vertices}};
     465     push @{$NewPath->{Vertices}}, @NewVertexIDs;
     466   }
     467   elsif ($EndVertex == $NewEndVertex) {
     468     # Take out EndVertex and add new path at the end with reversed vertex order...
     469     pop @{$NewPath->{Vertices}};
     470     push @{$NewPath->{Vertices}}, reverse @NewVertexIDs;
     471   }
     472   elsif ($StartVertex == $NewEndVertex) {
     473     # Take out NewEndVertex and add new path at the front...
     474     pop @NewVertexIDs;
     475     unshift @{$NewPath->{Vertices}}, @NewVertexIDs;
     476   }
     477   elsif ($StartVertex == $NewStartVertex) {
     478     # Take out NewStartVertex and add new path at the front...
     479     shift @NewVertexIDs;
     480     unshift @{$NewPath->{Vertices}}, reverse @NewVertexIDs;
     481   }
     482
     483   return $NewPath,
     484 }
     485
     486 # Compare two paths...
     487 #
     488 sub _PathEqualOperator {
     489   my($This, $Other) = @_;
     490
     491   if (!(defined($This) && _IsPath($This) && defined($Other) && _IsPath($Other))) {
     492     croak "Error: ${ClassName}->_PathEqualOperator: Path equal comparison failed: Both object must be paths...";
     493   }
     494
     495   if ($This->GetLength() != $Other->GetLength()) {
     496     return 0;
     497   }
     498   my($ThisID, $OtherID, $ReverseOtherID);
     499
     500   $ThisID = join('-', @{$This->{Vertices}});
     501   $OtherID = join('-', @{$Other->{Vertices}});
     502   $ReverseOtherID = join('-', reverse(@{$Other->{Vertices}}));
     503
     504   return ($ThisID =~ /^($OtherID|$ReverseOtherID)$/) ? 1 : 0;
     505 }
     506
     507 # Return a string containing vertices in the path...
     508 sub StringifyPath {
     509   my($This) = @_;
     510   my($PathString);
     511
     512   $PathString = "Path: " . join('-', @{$This->{Vertices}});
     513
     514   return $PathString;
     515 }
     516
     517 # Is it a path object?
     518 sub _IsPath {
     519   my($Object) = @_;
     520
     521   return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0;
     522 }
     523