MayaChemTools

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