MayaChemTools

   1 package Graph;
   2 #
   3 # $RCSfile: Graph.pm,v $
   4 # $Date: 2008/04/25 00:00:45 $
   5 # $Revision: 1.24 $
   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 Scalar::Util ();
  33 use Storable ();
  34 use Graph::CyclesDetection;
  35 use Graph::PathsTraversal;
  36 
  37 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
  38 
  39 $VERSION = '1.00';
  40 @ISA = qw(Exporter);
  41 @EXPORT = qw(IsGraph);
  42 @EXPORT_OK = qw();
  43 
  44 %EXPORT_TAGS = (all  => [@EXPORT, @EXPORT_OK]);
  45 
  46 # Setup class variables...
  47 my($ClassName);
  48 _InitializeClass();
  49 
  50 # Overload Perl functions...
  51 use overload '""' => 'StringifyGraph';
  52 
  53 # Class constructor...
  54 sub new {
  55   my($Class, @VertexIDs) = @_;
  56 
  57   # Initialize object...
  58   my $This = {};
  59   bless $This, ref($Class) || $Class;
  60   $This->_InitializeGraph();
  61 
  62   if (@VertexIDs) { $This->AddVertices(@VertexIDs); }
  63 
  64   return $This;
  65 }
  66 
  67 # Initialize object data...
  68 sub _InitializeGraph {
  69   my($This) = @_;
  70 
  71   %{$This->{Vertices}} = ();
  72 
  73   %{$This->{Edges}} = ();
  74   %{$This->{Edges}->{From}} = ();
  75   %{$This->{Edges}->{To}} = ();
  76 
  77   %{$This->{Properties}} = ();
  78   %{$This->{Properties}->{Graph}} = ();
  79   %{$This->{Properties}->{Vertices}} = ();
  80   %{$This->{Properties}->{Edges}} = ();
  81 }
  82 
  83 # Initialize class ...
  84 sub _InitializeClass {
  85   #Class name...
  86   $ClassName = __PACKAGE__;
  87 }
  88 
  89 # Add a vertex...
  90 sub AddVertex {
  91   my($This, $VertexID) = @_;
  92 
  93   if (!defined $VertexID ) {
  94     carp "Warning: ${ClassName}->AddVertex: No vertex added: Vertex ID must be specified...";
  95     return undef;
  96   }
  97   if (exists $This->{Vertices}->{$VertexID}) {
  98     carp "Warning: ${ClassName}->AddVertex: Didn't add vertex $VertexID: Already exists in the graph...";
  99     return undef;
 100   }
 101 
 102   $This->{Vertices}->{$VertexID} = $VertexID;
 103 
 104   return $This;
 105 }
 106 
 107 # Add vertices to the graph and return graph...
 108 sub AddVertices {
 109   my($This, @VertexIDs) = @_;
 110 
 111   if (!@VertexIDs) {
 112     carp "Warning: ${ClassName}->AddVertices: No vertices added: Vertices list is empty...";
 113     return undef;
 114   }
 115 
 116   my($VertexID);
 117   for $VertexID (@VertexIDs) {
 118     $This->AddVertex($VertexID);
 119   }
 120 
 121   return $This;
 122 }
 123 
 124 # Delete a vertex...
 125 sub DeleteVertex {
 126   my($This, $VertexID) = @_;
 127 
 128   if (!defined $VertexID ) {
 129     carp "Warning: ${ClassName}->DeleteVertex: No vertex deleted: Vertex ID must be specified...";
 130     return undef;
 131   }
 132   if (!$This->HasVertex($VertexID)) {
 133     carp "Warning: ${ClassName}->DeleteVertex: Didn't delete vertex $VertexID: Vertex $VertexID doesn't exist...";
 134     return undef;
 135   }
 136   $This->_DeleteVertex($VertexID);
 137 
 138   return $This;
 139 }
 140 
 141 # Delete vertex...
 142 sub _DeleteVertex {
 143   my($This, $VertexID) = @_;
 144 
 145   # Delete corresponding edges; the corresponding edge properties are deleted during
 146   # edges deletetion...
 147   my(@VertexIDs);
 148   @VertexIDs = $This->GetEdges($VertexID);
 149   if (@VertexIDs) {
 150     $This->DeleteEdges(@VertexIDs);
 151   }
 152 
 153   # Delete the vertex and any properties associated with vertex...
 154   $This->DeleteVertexProperties($VertexID);
 155   delete $This->{Vertices}->{$VertexID};
 156 }
 157 
 158 # Delete vertices...
 159 sub DeleteVertices {
 160   my($This, @VertexIDs) = @_;
 161 
 162   if (!@VertexIDs) {
 163     carp "Warning: ${ClassName}->DeleteVertices: No vertices deleted: Vertices list is empty...";
 164     return undef;
 165   }
 166   my($VertexID);
 167   for $VertexID (@VertexIDs) {
 168     $This->DeleteVertex($VertexID);
 169   }
 170 
 171   return $This;
 172 }
 173 
 174 # Get vertex data...
 175 sub GetVertex {
 176   my($This, $VertexID) = @_;
 177 
 178   if (!defined $VertexID) {
 179     return undef;
 180   }
 181 
 182   return (exists $This->{Vertices}->{$VertexID}) ? $This->{Vertices}->{$VertexID} : undef;
 183 }
 184 
 185 # Get data for all vertices or those specifed in the list. In scalar context, returned
 186 # the number of vertices found.
 187 #
 188 sub GetVertices {
 189   my($This, @VertexIDs) = @_;
 190   my($ValuesCount, @VertexValues);
 191 
 192   @VertexValues = ();
 193   if (@VertexIDs) {
 194     @VertexValues = map { $This->GetVertex($_) } @VertexIDs;
 195     $ValuesCount = grep { 1 } @VertexValues;
 196   }
 197   else {
 198     @VertexValues = sort { $a <=> $b } keys %{$This->{Vertices}};
 199     $ValuesCount = @VertexValues;
 200   }
 201 
 202   return wantarray ? @VertexValues : $ValuesCount;
 203 }
 204 
 205 # Is this vertex present?
 206 sub HasVertex {
 207   my($This, $VertexID) = @_;
 208 
 209   if (!defined $VertexID) {
 210     return 0;
 211   }
 212   return (exists $This->{Vertices}->{$VertexID}) ? 1 : 0;
 213 }
 214 
 215 # Are these vertices present? Return an array containing 1 or 0  for each vertex.
 216 # In scalar context, return number of vertices found.
 217 sub HasVertices {
 218   my($This, @VertexIDs) = @_;
 219 
 220   if (!@VertexIDs) {
 221     return undef;
 222   }
 223   my($VerticesCount, @VerticesStatus);
 224 
 225   @VerticesStatus = map { $This->HasVertex($_) } @VertexIDs;
 226   $VerticesCount = grep { 1 }  @VerticesStatus;
 227 
 228   return wantarray ? @VerticesStatus : $VerticesCount;
 229 }
 230 
 231 # Add an edge...
 232 sub AddEdge {
 233   my($This, $VertexID1, $VertexID2) = @_;
 234 
 235   if (!(defined($VertexID1) && defined($VertexID2))) {
 236     carp "Warning: ${ClassName}->AddEdge: No edge added: Both vertices must be defined...";
 237     return undef;
 238   }
 239   if (!$This->HasVertex($VertexID1)) {
 240     carp "Warning: ${ClassName}->AddEdge: Didn't add edge between vertices $VertexID1 and $VertexID2: Vertex $VertexID1 doesn's exist...";
 241     return undef;
 242   }
 243   if (!$This->HasVertex($VertexID2)) {
 244     carp "Warning: ${ClassName}->AddEdge: Didn't add edge between vertices $VertexID1 and $VertexID2: Vertex $VertexID2 doesn's exist...";
 245     return undef;
 246   }
 247   if ($VertexID1 == $VertexID2) {
 248     carp "Warning: ${ClassName}->AddEdge: Didn't add edge between vertices $VertexID1 and $VertexID2: Vertices must be different...";
 249     return undef;
 250   }
 251   if ($This->HasEdge($VertexID1, $VertexID2)) {
 252     carp "Warning: ${ClassName}->AddEdge: Didn't add edge between vertices $VertexID1 and $VertexID2: Edge already exists...";
 253     return undef;
 254   }
 255 
 256   if (!exists $This->{Edges}->{From}->{$VertexID1}) {
 257     %{$This->{Edges}->{From}->{$VertexID1}} = ();
 258   }
 259   $This->{Edges}->{From}->{$VertexID1}->{$VertexID2} = $VertexID2;
 260 
 261   if (!exists $This->{Edges}->{To}->{$VertexID2}) {
 262     %{$This->{Edges}->{To}->{$VertexID2}} = ();
 263   }
 264   $This->{Edges}->{To}->{$VertexID2}->{$VertexID1} = $VertexID1;
 265 
 266   return $This;
 267 }
 268 
 269 # Add edges...
 270 sub AddEdges {
 271   my($This, @VertexIDs) = @_;
 272 
 273   if (!@VertexIDs) {
 274     carp "Warning: ${ClassName}->AddEdges: No edges added: Vertices list is empty...";
 275     return undef;
 276   }
 277   if (@VertexIDs % 2) {
 278     carp "Warning: ${ClassName}->AddEdges: No edges added: Invalid vertices data: Input list must contain even number of vertex IDs...";
 279     return undef;
 280   }
 281   my($VertexID1, $VertexID2, $Index);
 282   for ($Index = 0; $Index < $#VertexIDs; $Index += 2) {
 283     $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1];
 284     $This->AddEdge($VertexID1, $VertexID2);
 285   }
 286 
 287   return $This;
 288 }
 289 
 290 # Delete an edge...
 291 sub DeleteEdge {
 292   my($This, $VertexID1, $VertexID2) = @_;
 293 
 294   if (!(defined($VertexID1) && defined($VertexID2))) {
 295     carp "Warning: ${ClassName}->Delete: No edge deleted: Both vertices must be defined...";
 296     return undef;
 297   }
 298   if (!$This->HasVertex($VertexID1)) {
 299     carp "Warning: ${ClassName}->DeleteEdge: Didn't delete edge between vertices $VertexID1 and $VertexID2: Vertex $VertexID1 doesn's exist...";
 300     return undef;
 301   }
 302   if (!$This->HasVertex($VertexID2)) {
 303     carp "Warning: ${ClassName}->DeleteEdge: Didn't delete edge between vertices $VertexID1 and $VertexID2: Vertex $VertexID2 doesn's exist...";
 304     return undef;
 305   }
 306   if (!$This->HasEdge($VertexID1, $VertexID2)) {
 307     carp "Warning: ${ClassName}->DeleteEdge: Didn't delete edge between vertices $VertexID1 and $VertexID2: Edge doesn't exist...";
 308     return undef;
 309   }
 310   $This->_DeleteEdge($VertexID1, $VertexID2);
 311   $This->_DeleteEdge($VertexID2, $VertexID1);
 312 }
 313 
 314 # Delete edge...
 315 sub _DeleteEdge {
 316   my($This, $VertexID1, $VertexID2) = @_;
 317 
 318   # Delete the edge...
 319   if (exists $This->{Edges}->{From}->{$VertexID1}) {
 320     if (exists $This->{Edges}->{From}->{$VertexID1}->{$VertexID2}) {
 321       delete $This->{Edges}->{From}->{$VertexID1}->{$VertexID2};
 322     }
 323     if (! keys %{$This->{Edges}->{From}->{$VertexID1}}) {
 324       delete $This->{Edges}->{From}->{$VertexID1};
 325     }
 326   }
 327 
 328   if (exists $This->{Edges}->{To}->{$VertexID2}) {
 329     if (exists $This->{Edges}->{To}->{$VertexID2}->{$VertexID1}) {
 330       delete $This->{Edges}->{To}->{$VertexID2}->{$VertexID1};
 331     }
 332     if (! keys %{$This->{Edges}->{To}->{$VertexID2}}) {
 333       delete $This->{Edges}->{To}->{$VertexID2};
 334     }
 335   }
 336 
 337   # Delete properties associated with the edge...
 338   $This->DeleteEdgeProperties($VertexID1, $VertexID2);
 339 }
 340 
 341 # Delete edges...
 342 sub DeleteEdges {
 343   my($This, @VertexIDs) = @_;
 344 
 345   if (!@VertexIDs) {
 346     carp "Warning: ${ClassName}->DeleteEdges: No edges deleted: Vertices list is empty...";
 347     return undef;
 348   }
 349   if (@VertexIDs % 2) {
 350     carp "Warning: ${ClassName}->DeleteEdges: No edges deleted: Invalid vertices data: Input list must contain even number of vertex IDs...";
 351     return undef;
 352   }
 353   my($VertexID1, $VertexID2, $Index);
 354   for ($Index = 0; $Index < $#VertexIDs; $Index += 2) {
 355     $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1];
 356     $This->DeleteEdge($VertexID1, $VertexID2);
 357   }
 358 
 359   return $This;
 360 }
 361 
 362 # Does the edge defiend by a vertex pair exists? Edges defined from VertexID1 to VertecID2
 363 # and VertexID2 to VertexID1 are considered equivalent...
 364 sub HasEdge {
 365   my($This, $VertexID1, $VertexID2) = @_;
 366 
 367   if (!(defined($VertexID1) && defined($VertexID2))) {
 368     return 0;
 369   }
 370 
 371   return ($This->_HasEdge($VertexID1, $VertexID2) || $This->_HasEdge($VertexID2, $VertexID1)) ? 1 : 0;
 372 }
 373 
 374 # Does edge exists?
 375 sub _HasEdge {
 376   my($This, $VertexID1, $VertexID2) = @_;
 377 
 378   if (exists $This->{Edges}->{From}->{$VertexID1}) {
 379     if (exists $This->{Edges}->{From}->{$VertexID1}->{$VertexID2}) {
 380       return 1;
 381     }
 382   }
 383   elsif (exists $This->{Edges}->{To}->{$VertexID2}) {
 384     if (exists $This->{Edges}->{To}->{$VertexID2}->{$VertexID1}) {
 385       return 1;
 386     }
 387   }
 388   return 0;
 389 }
 390 
 391 # Do the edges defiend by vertex pairs exist? In scalar context, return the number
 392 # of edges found...
 393 sub HasEdges {
 394   my($This, @VertexIDs) = @_;
 395 
 396   if (!@VertexIDs) {
 397     return 0;
 398   }
 399   if (@VertexIDs % 2) {
 400     return 0;
 401   }
 402   my($VertexID1, $VertexID2, $Index, $Status, $EdgesCount, @EdgesStatus);
 403   @EdgesStatus = ();
 404   $EdgesCount = 0;
 405   for ($Index = 0; $Index < $#VertexIDs; $Index += 2) {
 406     $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1];
 407     $Status = $This->HasEdge($VertexID1, $VertexID2);
 408     push @EdgesStatus, ($Status);
 409     if (defined($Status) && $Status) {
 410       $EdgesCount++;
 411     }
 412   }
 413   return wantarray ? @EdgesStatus : $EdgesCount;
 414 }
 415 
 416 # Get edges for a vertex ID or retrieve all the edges. In scalar context,
 417 #  return the number of edges.
 418 #
 419 sub GetEdges {
 420   my($This, $VertexID) = @_;
 421   my(@VertexIDs);
 422 
 423   @VertexIDs = ();
 424   if (defined $VertexID) {
 425     push @VertexIDs, ($This->_GetEdgesFrom($VertexID), $This->_GetEdgesTo($VertexID))
 426   }
 427   else {
 428     push @VertexIDs, $This->_GetEdges();
 429   }
 430   return (wantarray ? @VertexIDs : @VertexIDs/2);
 431 }
 432 
 433 # Get edge starting from the vertex to its successor vertices...
 434 sub _GetEdgesFrom {
 435   my($This, $VertexID1) = @_;
 436   my($VertexID2) = undef;
 437 
 438   return $This->_GetEdges($VertexID1, $VertexID2);
 439 }
 440 
 441 # Get edge starting from predecessors to the vertex...
 442 sub _GetEdgesTo {
 443   my($This, $VertexID2) = @_;
 444   my($VertexID1) = undef;
 445 
 446   return $This->_GetEdges($VertexID1, $VertexID2);
 447 }
 448 
 449 # Get edges as pair of vertex IDs. Edges data can be retrieved in three
 450 # different ways:
 451 #
 452 # Both vertex IDs are defined: Returns existing edge between the vertices
 453 # Only first vertex ID defined: Returns all edges at the vertex
 454 # Only second vertex defined: Returns all edges at the vertex
 455 # No vertex IDs defined: Returns all edges
 456 #
 457 sub _GetEdges {
 458   my($This, $VertexID1, $VertexID2) = @_;
 459   my($VertexID, @VertexIDs);
 460 
 461   @VertexIDs = ();
 462 
 463   if (defined($VertexID1) && defined($VertexID2)) {
 464     if ($This->HasEdge($VertexID1, $VertexID2)) {
 465       push @VertexIDs, ($VertexID1, $VertexID2);
 466     }
 467   }
 468   elsif (defined($VertexID1)) {
 469     for $VertexID ($This->_GetNeighborsFrom($VertexID1)) {
 470       push @VertexIDs, $This->_GetEdges($VertexID1, $VertexID);
 471     }
 472   }
 473   elsif (defined($VertexID2)) {
 474     for $VertexID ($This->_GetNeighborsTo($VertexID2)) {
 475       push @VertexIDs, $This->_GetEdges($VertexID, $VertexID2);
 476     }
 477   }
 478   else {
 479     for $VertexID ($This->GetVertices()) {
 480       push @VertexIDs, $This->_GetEdges($VertexID);
 481     }
 482   }
 483 
 484   return @VertexIDs;
 485 }
 486 
 487 # Add edges between successive pair of vertex IDs......
 488 sub AddPath {
 489   my($This, @VertexIDs) = @_;
 490 
 491   if (!@VertexIDs) {
 492     carp "Warning: ${ClassName}->AddPath: No path added: Vertices list is empty...";
 493     return undef;
 494   }
 495   if (@VertexIDs == 1) {
 496     carp "Warning: ${ClassName}->AddPath: No path added: Invalid vertices data: Input list must contain more than on vertex ID...";
 497     return undef;
 498   }
 499   if (!$This->HasVertices(@VertexIDs)) {
 500     carp "Warning: ${ClassName}->AddPath: No path added: Some of the vertex IDs don't exist in the graph...";
 501     return undef;
 502   }
 503   if ($This->HasPath(@VertexIDs)) {
 504     carp "Warning: ${ClassName}->AddPath: No path added: Path already exist in the graph...";
 505     return undef;
 506   }
 507   my(@PathVertexIDs);
 508   @PathVertexIDs =$This-> _SetupPathVertices(@VertexIDs);
 509 
 510   return $This->AddEdges(@PathVertexIDs);
 511 }
 512 
 513 
 514 # Delete edges between successive pair of vertex IDs......
 515 sub DeletePath {
 516   my($This, @VertexIDs) = @_;
 517 
 518   if (!@VertexIDs) {
 519     carp "Warning: ${ClassName}->DeletePath: No path deleted: Vertices list is empty...";
 520     return undef;
 521   }
 522   if (@VertexIDs == 1) {
 523     carp "Warning: ${ClassName}->DeletePath: No path deleted: Invalid vertices data: Input list must contain more than on vertex ID...";
 524     return undef;
 525   }
 526   if (!$This->HasVertices(@VertexIDs)) {
 527     carp "Warning: ${ClassName}->DeletePath: No path deleted: Some of the vertex IDs don't exist in the graph...";
 528     return undef;
 529   }
 530   if (!$This->HasPath(@VertexIDs)) {
 531     carp "Warning: ${ClassName}->DeletePath: No path deleted: Path doesn't exist in the graph...";
 532     return undef;
 533   }
 534   my(@PathVertexIDs);
 535   @PathVertexIDs = $This->_SetupPathVertices(@VertexIDs);
 536 
 537   return $This->DeleteEdges(@PathVertexIDs);
 538 }
 539 
 540 # Does the path defiend by edges between successive pairs of vertex IDs exist?
 541 sub HasPath {
 542   my($This, @VertexIDs) = @_;
 543 
 544   if (!@VertexIDs) {
 545     return 0;
 546   }
 547   if (@VertexIDs == 1) {
 548     return 0;
 549   }
 550   if (!$This->HasVertices(@VertexIDs)) {
 551     return 0;
 552   }
 553   my($Status, @PathVertexIDs);
 554   @PathVertexIDs = $This->_SetupPathVertices(@VertexIDs);
 555   $Status = ($This->HasEdges(@PathVertexIDs) == (@PathVertexIDs/2)) ? 1 : 0;
 556 
 557   return $Status;
 558 }
 559 
 560 # Setup vertices for the path to define edges between successive pair of vertex IDs...
 561 sub _SetupPathVertices {
 562   my($This, @VertexIDs) = @_;
 563   my($VertexID1, $VertexID2, $Index, @PathVertexIDs);
 564 
 565   @PathVertexIDs = ();
 566   for $Index (0 .. ($#VertexIDs - 1)) {
 567     $VertexID1 = $VertexIDs[$Index];
 568     $VertexID2 = $VertexIDs[$Index + 1];
 569     push @PathVertexIDs, ($VertexID1, $VertexID2);
 570   }
 571 
 572   return @PathVertexIDs;
 573 }
 574 
 575 # Add edges between successive pair of vertex IDs and an additional edge from the last to
 576 # the first ID to complete the cycle......
 577 sub AddCycle {
 578   my($This, @VertexIDs) = @_;
 579 
 580   if (!@VertexIDs) {
 581     carp "Warning: ${ClassName}->AddCycle: No cycle added: Vertices list is empty...";
 582     return undef;
 583   }
 584   if (@VertexIDs == 1) {
 585     carp "Warning: ${ClassName}->AddCycle: No cycle added: Invalid vertices data: Input list must contain more than on vertex ID...";
 586     return undef;
 587   }
 588   if (!$This->HasVertices(@VertexIDs)) {
 589     carp "Warning: ${ClassName}->AddCycle: No cycle added: Some of the vertex IDs don't exist in the graph...";
 590     return undef;
 591   }
 592   my($FirstVertextID) = $VertexIDs[0];
 593   push @VertexIDs, ($FirstVertextID);
 594 
 595   if ($This->HasCycle(@VertexIDs)) {
 596     carp "Warning: ${ClassName}->AddCycle: No cycle added: Cycle already exist in the graph...";
 597     return undef;
 598   }
 599 
 600   return $This->AddPath(@VertexIDs);
 601 }
 602 
 603 # Delete edges between successive pair of vertex IDs and an additional edge from the last to
 604 # the first ID to complete the cycle......
 605 sub DeleteCycle {
 606   my($This, @VertexIDs) = @_;
 607 
 608   if (!@VertexIDs) {
 609     carp "Warning: ${ClassName}->DeleteCycle: No cycle deleted: Vertices list is empty...";
 610     return undef;
 611   }
 612   if (@VertexIDs == 1) {
 613     carp "Warning: ${ClassName}->DeleteCycle: No cycle deleted: Invalid vertices data: Input list must contain more than on vertex ID...";
 614     return undef;
 615   }
 616   if (!$This->HasVertices(@VertexIDs)) {
 617     carp "Warning: ${ClassName}->DeleteCycle: No cycle deleted: Some of the vertex IDs don't exist in the graph...";
 618     return undef;
 619   }
 620   if (!$This->HasCycle(@VertexIDs)) {
 621     carp "Warning: ${ClassName}->DeleteCycle: No cycle deleted: Cycle doesn't exist in the graph...";
 622     return undef;
 623   }
 624 
 625   my($FirstVertextID) = $VertexIDs[0];
 626   push @VertexIDs, ($FirstVertextID);
 627 
 628   return $This->DeletePath(@VertexIDs);
 629 }
 630 
 631 # Does the cycle defiend by edges between successive pairs of vertex IDs along with an additional
 632 # edge from last to first vertex ID exist?
 633 sub HasCycle {
 634   my($This, @VertexIDs) = @_;
 635 
 636   if (!@VertexIDs) {
 637     return 0;
 638   }
 639   if (@VertexIDs == 1) {
 640     return 0;
 641   }
 642   my($FirstVertextID) = $VertexIDs[0];
 643   push @VertexIDs, ($FirstVertextID);
 644 
 645   return $This->HasPath(@VertexIDs);
 646 }
 647 
 648 # Get neighbors...
 649 sub GetNeighbors {
 650   my($This, $VertexID) = @_;
 651 
 652   if (!defined $VertexID) {
 653     return undef;
 654   }
 655   if (! exists $This->{Vertices}->{$VertexID}) {
 656     return undef;
 657   }
 658 
 659   my($VerticesCount, @VertexIDs);
 660   @VertexIDs = ();
 661 
 662   push @VertexIDs, $This->_GetNeighborsFrom($VertexID);
 663   push @VertexIDs, $This->_GetNeighborsTo($VertexID);
 664   $VerticesCount = @VertexIDs;
 665 
 666   return wantarray ? @VertexIDs : $VerticesCount;
 667 }
 668 
 669 # Get neighbors added by defining edges from the vertex. For undirected graph, it has no
 670 # strict meaning...
 671 sub _GetNeighborsFrom {
 672   my($This, $VertexID) = @_;
 673 
 674   my(@VertexIDs)= ();
 675   if (exists $This->{Edges}->{From}->{$VertexID}) {
 676     push @VertexIDs, map { $This->{Edges}->{From}->{$VertexID}->{$_} }  sort {$a <=> $b} keys %{$This->{Edges}->{From}->{$VertexID}};
 677   }
 678   return @VertexIDs;
 679 }
 680 
 681 # Get neighbors added by defining edges to the vertex. For undirected graphs, it has no
 682 # strict meaning.
 683 sub _GetNeighborsTo {
 684   my($This, $VertexID) = @_;
 685 
 686   my(@VertexIDs)= ();
 687   if (exists $This->{Edges}->{To}->{$VertexID}) {
 688     push @VertexIDs, map { $This->{Edges}->{To}->{$VertexID}->{$_} } sort {$a <=> $b} keys %{$This->{Edges}->{To}->{$VertexID}};
 689   }
 690   return @VertexIDs;
 691 }
 692 
 693 # Get vertex degree...
 694 #
 695 sub GetDegree {
 696   my($This, $VertexID) = @_;
 697 
 698   if (!defined $VertexID) {
 699     return undef;
 700   }
 701   if (! exists $This->{Vertices}->{$VertexID}) {
 702     return undef;
 703   }
 704   my($Degree);
 705   $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID);
 706 
 707   return $Degree;
 708 }
 709 
 710 # Get in degree added by defining edges to the vertex. For undirected graphs, it has no
 711 # strict meaning.
 712 #
 713 sub _GetInDegree {
 714   my($This, $VertexID) = @_;
 715   my($Degree);
 716 
 717   $Degree = 0;
 718   if (exists $This->{Edges}->{To}->{$VertexID}) {
 719     $Degree = keys %{$This->{Edges}->{To}->{$VertexID}};
 720   }
 721   return $Degree;
 722 }
 723 
 724 # Get out degree added by defining edges from the vertex. For undirected graphs, it has no
 725 # strict meaning.
 726 #
 727 sub _GetOutDegree {
 728   my($This, $VertexID) = @_;
 729   my($Degree);
 730 
 731   $Degree = 0;
 732   if (exists $This->{Edges}->{From}->{$VertexID}) {
 733     $Degree = keys %{$This->{Edges}->{From}->{$VertexID}};
 734   }
 735   return $Degree;
 736 }
 737 
 738 # Get vertex with smallest degree...
 739 #
 740 sub GetVertexWithSmallestDegree {
 741   my($This) = @_;
 742   my($Degree, $SmallestDegree, $SmallestDegreeVertexID, $VertexID, @VertexIDs);
 743 
 744   @VertexIDs = ();
 745   @VertexIDs = $This->GetVertices();
 746   if (! @VertexIDs) {
 747     return undef;
 748   }
 749   $SmallestDegree = 99999; $SmallestDegreeVertexID = undef;
 750 
 751   for $VertexID (@VertexIDs) {
 752     $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID);
 753     if ($Degree < $SmallestDegree) {
 754       $SmallestDegree = $Degree;
 755       $SmallestDegreeVertexID = $VertexID;
 756     }
 757   }
 758   return $SmallestDegreeVertexID;
 759 }
 760 
 761 # Get vertex with largest degree...
 762 #
 763 sub GetVertexWithLargestDegree {
 764   my($This) = @_;
 765   my($Degree, $LargestDegree, $LargestDegreeVertexID, $VertexID, @VertexIDs);
 766 
 767   @VertexIDs = ();
 768   @VertexIDs = $This->GetVertices();
 769   if (! @VertexIDs) {
 770     return undef;
 771   }
 772   $LargestDegree = 0; $LargestDegreeVertexID = undef;
 773 
 774   for $VertexID (@VertexIDs) {
 775     $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID);
 776     if ($Degree > $LargestDegree) {
 777       $LargestDegree = $Degree;
 778       $LargestDegreeVertexID = $VertexID;
 779     }
 780   }
 781   return $LargestDegreeVertexID;
 782 }
 783 
 784 # Get maximum degree in the graph...
 785 #
 786 sub GetMaximumDegree {
 787   my($This) = @_;
 788   my($Degree, $MaximumDegree, $VertexID, @VertexIDs);
 789 
 790   @VertexIDs = ();
 791   @VertexIDs = $This->GetVertices();
 792   if (! @VertexIDs) {
 793     return undef;
 794   }
 795   $MaximumDegree = 0;
 796 
 797   for $VertexID (@VertexIDs) {
 798     $Degree = $This->GetDegree($VertexID);
 799     if ($Degree > $MaximumDegree) {
 800       $MaximumDegree = $Degree;
 801     }
 802   }
 803   return $MaximumDegree;
 804 }
 805 
 806 # Get minimum degree in the graph...
 807 #
 808 sub GetMininumDegree {
 809   my($This) = @_;
 810   my($Degree, $MininumDegree, $VertexID, @VertexIDs);
 811 
 812   @VertexIDs = ();
 813   @VertexIDs = $This->GetVertices();
 814   if (! @VertexIDs) {
 815     return undef;
 816   }
 817   $MininumDegree = 99999;
 818 
 819   for $VertexID (@VertexIDs) {
 820     $Degree = $This->GetDegree($VertexID);
 821     if ($Degree < $MininumDegree) {
 822       $MininumDegree = $Degree;
 823     }
 824   }
 825   return $MininumDegree;
 826 }
 827 
 828 # Is it a isolated vertex?
 829 #
 830 sub IsIsolatedVertex {
 831   my($This, $VertexID) = @_;
 832 
 833   if (!defined $VertexID) {
 834     return undef;
 835   }
 836   if (! exists $This->{Vertices}->{$VertexID}) {
 837     return undef;
 838   }
 839   return ($This->GetDegree() == 0) ? 1 : 0;
 840 }
 841 
 842 # Get all isolated vertices...
 843 #
 844 sub GetIsolatedVertices {
 845   my($This) = @_;
 846 
 847   return $This->GetVerticesWithDegreeLessThan(1);
 848 }
 849 
 850 # Is it a leaf vertex?
 851 #
 852 sub IsLeafVertex {
 853   my($This, $VertexID) = @_;
 854 
 855   if (!defined $VertexID) {
 856     return undef;
 857   }
 858   if (! exists $This->{Vertices}->{$VertexID}) {
 859     return undef;
 860   }
 861   return ($This->GetDegree() == 1) ? 1 : 0;
 862 }
 863 
 864 # Get all leaf vertices...
 865 #
 866 sub GetLeafVertices {
 867   my($This) = @_;
 868 
 869   return $This->GetVerticesWithDegreeLessThan(2);
 870 }
 871 
 872 # Get vertices  with degree less than a specified value...
 873 #
 874 sub GetVerticesWithDegreeLessThan {
 875   my($This, $SpecifiedDegree) = @_;
 876   my($Degree, $VertexID, @VertexIDs, @FilteredVertexIDs);
 877 
 878   @VertexIDs = (); @FilteredVertexIDs = ();
 879 
 880   @VertexIDs = $This->GetVertices();
 881   if (! @VertexIDs) {
 882     return @FilteredVertexIDs;
 883   }
 884 
 885   for $VertexID (@VertexIDs) {
 886     $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID);
 887     if ($Degree < $SpecifiedDegree) {
 888       push @FilteredVertexIDs, $VertexID;
 889     }
 890   }
 891   return @FilteredVertexIDs;
 892 }
 893 
 894 # Set a property for graph...
 895 sub SetGraphProperty {
 896   my($This, $Name, $Value) = @_;
 897 
 898   if (!(defined($Name) && defined($Value))) {
 899     carp "Warning: ${ClassName}->SetGraphProperty: Didn't set property: Both property name and value should be specified...";
 900     return undef;
 901   }
 902   if (exists $This->{Properties}->{Graph}->{$Name}) {
 903     carp "Warning: ${ClassName}->SetGraphProperty: Didn't set property $Name: Already exists in the graph...";
 904     return undef;
 905   }
 906 
 907   $This->{Properties}->{Graph}->{$Name} = $Value;
 908 
 909   return $This;
 910 }
 911 
 912 # Set a properties for graph...
 913 sub SetGraphProperties {
 914   my($This, %NamesAndValues) = @_;
 915 
 916   if (!(keys %NamesAndValues)) {
 917     carp "Warning: ${ClassName}->SetGraphProperties: Didn't set properties: Names and values list is empty...";
 918     return undef;
 919   }
 920 
 921   my($Name, $Value);
 922   while (($Name, $Value) = each  %NamesAndValues) {
 923     $This->SetGraphProperty($Name, $Value);
 924   }
 925 
 926   return $This;
 927 }
 928 
 929 # Get a property value for graph...
 930 sub GetGraphProperty {
 931   my($This, $Name) = @_;
 932 
 933   if (!$This->HasGraphProperty($Name)) {
 934     return undef;
 935   }
 936 
 937   return $This->{Properties}->{Graph}->{$Name};
 938 }
 939 
 940 # Get all poperty name/value pairs for graph...
 941 sub GetGraphProperties {
 942   my($This) = @_;
 943 
 944   return %{$This->{Properties}->{Graph}};
 945 }
 946 
 947 # Delete a property for graph...
 948 sub DeleteGraphProperty {
 949   my($This, $Name) = @_;
 950 
 951   if (!defined $Name) {
 952     carp "Warning: ${ClassName}->DeleteGraphProperty: Didn't delete graph property: Name must be specified...";
 953     return undef;
 954   }
 955   if (!$This->HasGraphProperty($Name)) {
 956     carp "Warning: ${ClassName}-> DeleteGraphProperty: Didn't delete graph property $Name: Property doesn't exist...";
 957     return undef;
 958   }
 959   delete $This->{Properties}->{Graph}->{$Name};
 960 
 961   return $This;
 962 }
 963 
 964 # Delete graph properites...
 965 sub DeleteGraphProperties {
 966   my($This) = @_;
 967 
 968   %{$This->{Properties}->{Graph}} = ();
 969 
 970   return $This;
 971 }
 972 
 973 
 974 # Is this property associated with graph?
 975 sub HasGraphProperty {
 976   my($This, $Name) = @_;
 977 
 978   if (!defined $Name) {
 979     return 0;
 980   }
 981   return (exists $This->{Properties}->{Graph}->{$Name}) ? 1 : 0;
 982 }
 983 
 984 # Set a property for vertex...
 985 sub SetVertexProperty {
 986   my($This, $Name, $Value, $VertexID) = @_;
 987 
 988   if (!(defined($Name) && defined($Value) && defined($VertexID))) {
 989     carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property: Property name, value and vertexID should be specified...";
 990     return undef;
 991   }
 992   if (!$This->HasVertex($VertexID)) {
 993     carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property $Name for vertex $VertexID: Vertex doesn't exist...";
 994     return undef;
 995   }
 996   if ($This->HasVertexProperty($Name, $VertexID)) {
 997     carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property $Name for vertex $VertexID: Property already exists...";
 998     return undef;
 999   }
1000 
1001   $This->_SetVertexProperty($Name, $Value, $VertexID);
1002 
1003   return $This;
1004 }
1005 
1006 # Update a property for vertex...
1007 sub UpdateVertexProperty {
1008   my($This, $Name, $Value, $VertexID) = @_;
1009 
1010   if (!(defined($Name) && defined($Value) && defined($VertexID))) {
1011     carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property: Property name, value and vertexID should be specified...";
1012     return undef;
1013   }
1014   if (!$This->HasVertex($VertexID)) {
1015     carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property $Name for vertex $VertexID: Vertex doesn't exist...";
1016     return undef;
1017   }
1018   if (!$This->HasVertexProperty($Name, $VertexID)) {
1019     carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property $Name for vertex $VertexID: Property doesn't exists...";
1020     return undef;
1021   }
1022   $This->_SetVertexProperty($Name, $Value, $VertexID);
1023 
1024   return $This;
1025 }
1026 
1027 # Set a vextex property...
1028 sub _SetVertexProperty {
1029   my($This, $Name, $Value, $VertexID) = @_;
1030 
1031   if (!exists $This->{Properties}->{Vertices}->{$VertexID}) {
1032     %{$This->{Properties}->{Vertices}->{$VertexID}} = ();
1033   }
1034   $This->{Properties}->{Vertices}->{$VertexID}->{$Name} = $Value;
1035 
1036   return $This;
1037 }
1038 
1039 # Set a properties for vertex..
1040 sub SetVertexProperties {
1041   my($This, $VertexID, @NamesAndValues) = @_;
1042 
1043   if (!defined $VertexID) {
1044     carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: VertexID should be specified...";
1045     return undef;
1046   }
1047   if (!@NamesAndValues) {
1048     carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: Names and values list is empty...";
1049     return undef;
1050   }
1051   if (@NamesAndValues % 2) {
1052     carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: Invalid property name and values IDs data: Input list must contain even number of values...";
1053     return undef;
1054   }
1055 
1056   my($Name, $Value, $Index);
1057   for ($Index = 0; $Index < $#NamesAndValues; $Index += 2) {
1058     $Name = $NamesAndValues[$Index]; $Value = $NamesAndValues[$Index + 1];
1059     $This->SetVertexProperty($Name, $Value, $VertexID);
1060   }
1061 
1062   return $This;
1063 }
1064 
1065 
1066 # Set a property for vertices...
1067 sub SetVerticesProperty {
1068   my($This, $Name, @ValuesAndVertexIDs) = @_;
1069 
1070   if (!defined $Name) {
1071     carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Property name should be specified...";
1072     return undef;
1073   }
1074   if (!@ValuesAndVertexIDs) {
1075     carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Values and vertex IDs list is empty...";
1076     return undef;
1077   }
1078   if (@ValuesAndVertexIDs % 2) {
1079     carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Invalid property values and vertex IDs data: Input list must contain even number of values...";
1080     return undef;
1081   }
1082 
1083   my($Value, $VertexID, $Index);
1084   for ($Index = 0; $Index < $#ValuesAndVertexIDs; $Index += 2) {
1085     $Value = $ValuesAndVertexIDs[$Index]; $VertexID = $ValuesAndVertexIDs[$Index + 1];
1086     $This->SetVertexProperty($Name, $Value, $VertexID);
1087   }
1088 
1089   return $This;
1090 }
1091 
1092 # Get a property value for vertex...
1093 sub GetVertexProperty {
1094   my($This, $Name, $VertexID) = @_;
1095 
1096   if (!$This->HasVertexProperty($Name, $VertexID)) {
1097     return undef;
1098   }
1099 
1100   return $This->{Properties}->{Vertices}->{$VertexID}->{$Name};
1101 }
1102 
1103 # Get a property values for vertices...
1104 sub GetVerticesProperty {
1105   my($This, $Name, @VertexIDs) = @_;
1106   my($ValuesCount, @Values);
1107 
1108   if (!@VertexIDs) {
1109     @VertexIDs = ();
1110     @VertexIDs = $This->GetVertices();
1111   }
1112   @Values = ();
1113   @Values = map { $This->GetVertexProperty($Name, $_ ) } @VertexIDs;
1114   $ValuesCount = grep { defined($_) } @Values;
1115 
1116   return wantarray ? @Values : $ValuesCount;
1117 }
1118 
1119 # Get all property name/values pairs for vertex...
1120 sub GetVertexProperties {
1121   my($This, $VertexID) = @_