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