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