1 package Graph::Path;
   2 #
   3 # File: Path.pm
   4 # Author: Manish Sud <msud@san.rr.com>
   5 #
   6 # Copyright (C) 2024 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