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) = @_