1 package Graph; 2 # 3 # $RCSfile: Graph.pm,v $ 4 # $Date: 2015/02/28 20:47:17 $ 5 # $Revision: 1.46 $ 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 use Graph::CyclesDetection; 35 use Graph::PathsTraversal; 36 use Graph::GraphMatrix; 37 38 use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); 39 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 # Get a list of unsorted vertices and sort 'em once before returning... 660 # 661 my($VerticesCount, $SortVertices, @VertexIDs); 662 663 $SortVertices = 0; 664 @VertexIDs = (); 665 666 push @VertexIDs, $This->_GetNeighborsFrom($VertexID, $SortVertices); 667 push @VertexIDs, $This->_GetNeighborsTo($VertexID, $SortVertices); 668 $VerticesCount = @VertexIDs; 669 670 return wantarray ? sort {$a <=> $b} @VertexIDs : $VerticesCount; 671 } 672 673 # Get neighbors added by defining edges from the vertex. For undirected graph, it has no 674 # strict meaning... 675 sub _GetNeighborsFrom { 676 my($This, $VertexID, $SortVertices) = @_; 677 my(@VertexIDs); 678 679 $SortVertices = defined $SortVertices ? $SortVertices : 1; 680 @VertexIDs = (); 681 682 if (exists $This->{Edges}->{From}->{$VertexID}) { 683 push @VertexIDs, map { $This->{Edges}->{From}->{$VertexID}->{$_} } keys %{$This->{Edges}->{From}->{$VertexID}}; 684 } 685 return $SortVertices ? sort {$a <=> $b} @VertexIDs : @VertexIDs; 686 } 687 688 # Get neighbors added by defining edges to the vertex. For undirected graphs, it has no 689 # strict meaning. 690 sub _GetNeighborsTo { 691 my($This, $VertexID, $SortVertices) = @_; 692 my(@VertexIDs); 693 694 $SortVertices = defined $SortVertices ? $SortVertices : 1; 695 @VertexIDs = (); 696 697 if (exists $This->{Edges}->{To}->{$VertexID}) { 698 push @VertexIDs, map { $This->{Edges}->{To}->{$VertexID}->{$_} } keys %{$This->{Edges}->{To}->{$VertexID}}; 699 } 700 return $SortVertices ? sort {$a <=> $b} @VertexIDs : @VertexIDs; 701 } 702 703 # Get vertex degree... 704 # 705 sub GetDegree { 706 my($This, $VertexID) = @_; 707 708 if (!defined $VertexID) { 709 return undef; 710 } 711 if (! exists $This->{Vertices}->{$VertexID}) { 712 return undef; 713 } 714 my($Degree); 715 $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID); 716 717 return $Degree; 718 } 719 720 # Get in degree added by defining edges to the vertex. For undirected graphs, it has no 721 # strict meaning. 722 # 723 sub _GetInDegree { 724 my($This, $VertexID) = @_; 725 my($Degree); 726 727 $Degree = 0; 728 if (exists $This->{Edges}->{To}->{$VertexID}) { 729 $Degree = keys %{$This->{Edges}->{To}->{$VertexID}}; 730 } 731 return $Degree; 732 } 733 734 # Get out degree added by defining edges from the vertex. For undirected graphs, it has no 735 # strict meaning. 736 # 737 sub _GetOutDegree { 738 my($This, $VertexID) = @_; 739 my($Degree); 740 741 $Degree = 0; 742 if (exists $This->{Edges}->{From}->{$VertexID}) { 743 $Degree = keys %{$This->{Edges}->{From}->{$VertexID}}; 744 } 745 return $Degree; 746 } 747 748 # Get vertex with smallest degree... 749 # 750 sub GetVertexWithSmallestDegree { 751 my($This) = @_; 752 my($Degree, $SmallestDegree, $SmallestDegreeVertexID, $VertexID, @VertexIDs); 753 754 @VertexIDs = (); 755 @VertexIDs = $This->GetVertices(); 756 if (! @VertexIDs) { 757 return undef; 758 } 759 $SmallestDegree = 99999; $SmallestDegreeVertexID = undef; 760 761 for $VertexID (@VertexIDs) { 762 $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID); 763 if ($Degree < $SmallestDegree) { 764 $SmallestDegree = $Degree; 765 $SmallestDegreeVertexID = $VertexID; 766 } 767 } 768 return $SmallestDegreeVertexID; 769 } 770 771 # Get vertex with largest degree... 772 # 773 sub GetVertexWithLargestDegree { 774 my($This) = @_; 775 my($Degree, $LargestDegree, $LargestDegreeVertexID, $VertexID, @VertexIDs); 776 777 @VertexIDs = (); 778 @VertexIDs = $This->GetVertices(); 779 if (! @VertexIDs) { 780 return undef; 781 } 782 $LargestDegree = 0; $LargestDegreeVertexID = undef; 783 784 for $VertexID (@VertexIDs) { 785 $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID); 786 if ($Degree > $LargestDegree) { 787 $LargestDegree = $Degree; 788 $LargestDegreeVertexID = $VertexID; 789 } 790 } 791 return $LargestDegreeVertexID; 792 } 793 794 # Get maximum degree in the graph... 795 # 796 sub GetMaximumDegree { 797 my($This) = @_; 798 my($Degree, $MaximumDegree, $VertexID, @VertexIDs); 799 800 @VertexIDs = (); 801 @VertexIDs = $This->GetVertices(); 802 if (! @VertexIDs) { 803 return undef; 804 } 805 $MaximumDegree = 0; 806 807 for $VertexID (@VertexIDs) { 808 $Degree = $This->GetDegree($VertexID); 809 if ($Degree > $MaximumDegree) { 810 $MaximumDegree = $Degree; 811 } 812 } 813 return $MaximumDegree; 814 } 815 816 # Get minimum degree in the graph... 817 # 818 sub GetMininumDegree { 819 my($This) = @_; 820 my($Degree, $MininumDegree, $VertexID, @VertexIDs); 821 822 @VertexIDs = (); 823 @VertexIDs = $This->GetVertices(); 824 if (! @VertexIDs) { 825 return undef; 826 } 827 $MininumDegree = 99999; 828 829 for $VertexID (@VertexIDs) { 830 $Degree = $This->GetDegree($VertexID); 831 if ($Degree < $MininumDegree) { 832 $MininumDegree = $Degree; 833 } 834 } 835 return $MininumDegree; 836 } 837 838 # Is it a isolated vertex? 839 # 840 sub IsIsolatedVertex { 841 my($This, $VertexID) = @_; 842 843 if (!defined $VertexID) { 844 return undef; 845 } 846 if (! exists $This->{Vertices}->{$VertexID}) { 847 return undef; 848 } 849 return ($This->GetDegree() == 0) ? 1 : 0; 850 } 851 852 # Get all isolated vertices... 853 # 854 sub GetIsolatedVertices { 855 my($This) = @_; 856 857 return $This->GetVerticesWithDegreeLessThan(1); 858 } 859 860 # Is it a leaf vertex? 861 # 862 sub IsLeafVertex { 863 my($This, $VertexID) = @_; 864 865 if (!defined $VertexID) { 866 return undef; 867 } 868 if (! exists $This->{Vertices}->{$VertexID}) { 869 return undef; 870 } 871 return ($This->GetDegree() == 1) ? 1 : 0; 872 } 873 874 # Get all leaf vertices... 875 # 876 sub GetLeafVertices { 877 my($This) = @_; 878 879 return $This->GetVerticesWithDegreeLessThan(2); 880 } 881 882 # Get vertices with degree less than a specified value... 883 # 884 sub GetVerticesWithDegreeLessThan { 885 my($This, $SpecifiedDegree) = @_; 886 my($Degree, $VertexID, @VertexIDs, @FilteredVertexIDs); 887 888 @VertexIDs = (); @FilteredVertexIDs = (); 889 890 @VertexIDs = $This->GetVertices(); 891 if (! @VertexIDs) { 892 return @FilteredVertexIDs; 893 } 894 895 for $VertexID (@VertexIDs) { 896 $Degree = $This->_GetInDegree($VertexID) + $This->_GetOutDegree($VertexID); 897 if ($Degree < $SpecifiedDegree) { 898 push @FilteredVertexIDs, $VertexID; 899 } 900 } 901 return @FilteredVertexIDs; 902 } 903 904 # Set a property for graph... 905 sub SetGraphProperty { 906 my($This, $Name, $Value) = @_; 907 908 if (!(defined($Name) && defined($Value))) { 909 carp "Warning: ${ClassName}->SetGraphProperty: Didn't set property: Both property name and value should be specified..."; 910 return undef; 911 } 912 if (exists $This->{Properties}->{Graph}->{$Name}) { 913 carp "Warning: ${ClassName}->SetGraphProperty: Didn't set property $Name: Already exists in the graph..."; 914 return undef; 915 } 916 917 $This->{Properties}->{Graph}->{$Name} = $Value; 918 919 return $This; 920 } 921 922 # Set a properties for graph... 923 sub SetGraphProperties { 924 my($This, %NamesAndValues) = @_; 925 926 if (!(keys %NamesAndValues)) { 927 carp "Warning: ${ClassName}->SetGraphProperties: Didn't set properties: Names and values list is empty..."; 928 return undef; 929 } 930 931 my($Name, $Value); 932 while (($Name, $Value) = each %NamesAndValues) { 933 $This->SetGraphProperty($Name, $Value); 934 } 935 936 return $This; 937 } 938 939 # Get a property value for graph... 940 sub GetGraphProperty { 941 my($This, $Name) = @_; 942 943 if (!$This->HasGraphProperty($Name)) { 944 return undef; 945 } 946 947 return $This->{Properties}->{Graph}->{$Name}; 948 } 949 950 # Get all poperty name/value pairs for graph... 951 sub GetGraphProperties { 952 my($This) = @_; 953 954 return %{$This->{Properties}->{Graph}}; 955 } 956 957 # Delete a property for graph... 958 sub DeleteGraphProperty { 959 my($This, $Name) = @_; 960 961 if (!defined $Name) { 962 carp "Warning: ${ClassName}->DeleteGraphProperty: Didn't delete graph property: Name must be specified..."; 963 return undef; 964 } 965 if (!$This->HasGraphProperty($Name)) { 966 carp "Warning: ${ClassName}-> DeleteGraphProperty: Didn't delete graph property $Name: Property doesn't exist..."; 967 return undef; 968 } 969 delete $This->{Properties}->{Graph}->{$Name}; 970 971 return $This; 972 } 973 974 # Delete graph properites... 975 sub DeleteGraphProperties { 976 my($This) = @_; 977 978 %{$This->{Properties}->{Graph}} = (); 979 980 return $This; 981 } 982 983 984 # Is this property associated with graph? 985 sub HasGraphProperty { 986 my($This, $Name) = @_; 987 988 if (!defined $Name) { 989 return 0; 990 } 991 return (exists $This->{Properties}->{Graph}->{$Name}) ? 1 : 0; 992 } 993 994 # Set a property for vertex... 995 sub SetVertexProperty { 996 my($This, $Name, $Value, $VertexID) = @_; 997 998 if (!(defined($Name) && defined($Value) && defined($VertexID))) { 999 carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property: Property name, value and vertexID should be specified..."; 1000 return undef; 1001 } 1002 if (!$This->HasVertex($VertexID)) { 1003 carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property $Name for vertex $VertexID: Vertex doesn't exist..."; 1004 return undef; 1005 } 1006 if ($This->HasVertexProperty($Name, $VertexID)) { 1007 carp "Warning: ${ClassName}->SetVertexProperty: Didn't set property $Name for vertex $VertexID: Property already exists..."; 1008 return undef; 1009 } 1010 1011 $This->_SetVertexProperty($Name, $Value, $VertexID); 1012 1013 return $This; 1014 } 1015 1016 # Update a property for vertex... 1017 sub UpdateVertexProperty { 1018 my($This, $Name, $Value, $VertexID) = @_; 1019 1020 if (!(defined($Name) && defined($Value) && defined($VertexID))) { 1021 carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property: Property name, value and vertexID should be specified..."; 1022 return undef; 1023 } 1024 if (!$This->HasVertex($VertexID)) { 1025 carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property $Name for vertex $VertexID: Vertex doesn't exist..."; 1026 return undef; 1027 } 1028 if (!$This->HasVertexProperty($Name, $VertexID)) { 1029 carp "Warning: ${ClassName}->UpdateVextexProperty: Didn't update property $Name for vertex $VertexID: Property doesn't exists..."; 1030 return undef; 1031 } 1032 $This->_SetVertexProperty($Name, $Value, $VertexID); 1033 1034 return $This; 1035 } 1036 1037 # Set a vextex property... 1038 sub _SetVertexProperty { 1039 my($This, $Name, $Value, $VertexID) = @_; 1040 1041 if (!exists $This->{Properties}->{Vertices}->{$VertexID}) { 1042 %{$This->{Properties}->{Vertices}->{$VertexID}} = (); 1043 } 1044 $This->{Properties}->{Vertices}->{$VertexID}->{$Name} = $Value; 1045 1046 return $This; 1047 } 1048 1049 # Set a properties for vertex.. 1050 sub SetVertexProperties { 1051 my($This, $VertexID, @NamesAndValues) = @_; 1052 1053 if (!defined $VertexID) { 1054 carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: VertexID should be specified..."; 1055 return undef; 1056 } 1057 if (!@NamesAndValues) { 1058 carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: Names and values list is empty..."; 1059 return undef; 1060 } 1061 if (@NamesAndValues % 2) { 1062 carp "Warning: ${ClassName}->SetVertexProperties: Didn't set property: Invalid property name and values IDs data: Input list must contain even number of values..."; 1063 return undef; 1064 } 1065 1066 my($Name, $Value, $Index); 1067 for ($Index = 0; $Index < $#NamesAndValues; $Index += 2) { 1068 $Name = $NamesAndValues[$Index]; $Value = $NamesAndValues[$Index + 1]; 1069 $This->SetVertexProperty($Name, $Value, $VertexID); 1070 } 1071 1072 return $This; 1073 } 1074 1075 1076 # Set a property for vertices... 1077 sub SetVerticesProperty { 1078 my($This, $Name, @ValuesAndVertexIDs) = @_; 1079 1080 if (!defined $Name) { 1081 carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Property name should be specified..."; 1082 return undef; 1083 } 1084 if (!@ValuesAndVertexIDs) { 1085 carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Values and vertex IDs list is empty..."; 1086 return undef; 1087 } 1088 if (@ValuesAndVertexIDs % 2) { 1089 carp "Warning: ${ClassName}->SetVerticesProperty: Didn't set property: Invalid property values and vertex IDs data: Input list must contain even number of values..."; 1090 return undef; 1091 } 1092 1093 my($Value, $VertexID, $Index); 1094 for ($Index = 0; $Index < $#ValuesAndVertexIDs; $Index += 2) { 1095 $Value = $ValuesAndVertexIDs[$Index]; $VertexID = $ValuesAndVertexIDs[$Index + 1]; 1096 $This->SetVertexProperty($Name, $Value, $VertexID); 1097 } 1098 1099 return $This; 1100 } 1101 1102 # Get a property value for vertex... 1103 sub GetVertexProperty { 1104 my($This, $Name, $VertexID) = @_; 1105 1106 if (!$This->HasVertexProperty($Name, $VertexID)) { 1107 return undef; 1108 } 1109 1110 return $This->{Properties}->{Vertices}->{$VertexID}->{$Name}; 1111 } 1112 1113 # Get a property values for vertices... 1114 sub GetVerticesProperty { 1115 my($This, $Name, @VertexIDs) = @_; 1116 my($ValuesCount, @Values); 1117 1118 if (!@VertexIDs) { 1119 @VertexIDs = (); 1120 @VertexIDs = $This->GetVertices(); 1121 } 1122 @Values = (); 1123 @Values = map { $This->GetVertexProperty($Name, $_ ) } @VertexIDs; 1124 $ValuesCount = grep { defined($_) } @Values; 1125 1126 return wantarray ? @Values : $ValuesCount; 1127 } 1128 1129 # Get all property name/values pairs for vertex... 1130 sub GetVertexProperties { 1131 my($This, $VertexID) = @_; 1132 1133 if (!$This->HasVertex($VertexID)) { 1134 return (); 1135 } 1136 1137 if (exists $This->{Properties}->{Vertices}->{$VertexID}) { 1138 return %{$This->{Properties}->{Vertices}->{$VertexID}}; 1139 } 1140 else { 1141 return (); 1142 } 1143 } 1144 1145 1146 # Delete a property for vertex... 1147 sub DeleteVertexProperty { 1148 my($This, $Name, $VertexID) = @_; 1149 1150 if (!(defined($Name) && defined($VertexID))) { 1151 carp "Warning: ${ClassName}->DeleteVertexProperty: Didn't delete property: Property name and vertex ID must be defined..."; 1152 return undef; 1153 } 1154 if (!$This->HasVertexProperty($Name, $VertexID)) { 1155 carp "Warning: ${ClassName}->DeleteVertexProperty: Didn't delete property $Name for vertex $VertexID: Vertex property doesn't exist..."; 1156 return undef; 1157 } 1158 $This->_DeleteVertexProperty($VertexID, $Name); 1159 1160 return $This; 1161 } 1162 1163 # Delete vertex property or all properties... 1164 sub _DeleteVertexProperty { 1165 my($This, $VertexID, $Name) = @_; 1166 1167 if (exists $This->{Properties}->{Vertices}->{$VertexID}) { 1168 if (defined $Name) { 1169 if (exists $This->{Properties}->{Vertices}->{$VertexID}->{$Name}) { 1170 delete $This->{Properties}->{Vertices}->{$VertexID}->{$Name}; 1171 } 1172 } 1173 else { 1174 %{$This->{Properties}->{Vertices}->{$VertexID}} = (); 1175 } 1176 if (! keys %{$This->{Properties}->{Vertices}->{$VertexID}}) { 1177 delete $This->{Properties}->{Vertices}->{$VertexID}; 1178 } 1179 } 1180 return $This; 1181 } 1182 1183 # Delete a property for specified vertices or all the vertices... 1184 sub DeleteVerticesProperty { 1185 my($This, $Name, @VertexIDs) = @_; 1186 1187 if (!defined $Name) { 1188 carp "Warning: ${ClassName}->DeleteVerticesProperty: Didn't delete property: Property name should be specified..."; 1189 return undef; 1190 } 1191 if (!@VertexIDs) { 1192 @VertexIDs = (); 1193 @VertexIDs = $This->GetVertices(); 1194 } 1195 my($VertexID); 1196 for $VertexID (@VertexIDs) { 1197 $This->DeleteVertexProperty($Name, $VertexID); 1198 } 1199 1200 return $This; 1201 } 1202 1203 # Delete all properities for vertex... 1204 sub DeleteVertexProperties { 1205 my($This, $VertexID) = @_; 1206 1207 if (!defined $VertexID) { 1208 carp "Warning: ${ClassName}->DeleteVertexProperties: Didn't delete properties: Vertex ID must be defined..."; 1209 return undef; 1210 } 1211 $This->_DeleteVertexProperty($VertexID); 1212 1213 return $This; 1214 } 1215 1216 # Is this property associated with vertex? 1217 sub HasVertexProperty { 1218 my($This, $Name, $VertexID) = @_; 1219 1220 if (!(defined($Name) && defined($VertexID))) { 1221 return 0; 1222 } 1223 1224 if (exists $This->{Properties}->{Vertices}->{$VertexID}) { 1225 if (exists $This->{Properties}->{Vertices}->{$VertexID}->{$Name}) { 1226 return 1; 1227 } 1228 } 1229 return 0; 1230 } 1231 1232 # Set a property for edge... 1233 sub SetEdgeProperty { 1234 my($This, $Name, $Value, $VertexID1, $VertexID2) = @_; 1235 1236 if (!(defined($Name) && defined($Value) && defined($VertexID1) && defined($VertexID2))) { 1237 carp "Warning: ${ClassName}->SetEdgeProperty: Didn't set property: Property name, value, vertexID1 and vertexID2 should be specified..."; 1238 return undef; 1239 } 1240 if (!$This->HasEdge($VertexID1, $VertexID2)) { 1241 carp "Warning: ${ClassName}->SetEdgeProperty: Didn't set property $Name for edge between vertices $VertexID1 and $VertexID2: Edge doesn't exist..."; 1242 return undef; 1243 } 1244 if ($This->HasEdgeProperty($Name, $VertexID1, $VertexID2)) { 1245 carp "Warning: ${ClassName}->SetEdgeProperty: Didn't set property $Name for edge between vertices $VertexID1 and $VertexID2: Edge property already exists..."; 1246 return undef; 1247 } 1248 $This->_SetEdgeProperty($Name, $Value, $VertexID1, $VertexID2); 1249 $This->_SetEdgeProperty($Name, $Value, $VertexID2, $VertexID1); 1250 1251 return $This; 1252 } 1253 1254 # Update a property for edge... 1255 sub UpdateEdgeProperty { 1256 my($This, $Name, $Value, $VertexID1, $VertexID2) = @_; 1257 1258 if (!(defined($Name) && defined($Value) && defined($VertexID1) && defined($VertexID2))) { 1259 carp "Warning: ${ClassName}->UpdateEdgeProperty: Didn't update property: Property name, value, vertexID1 and vertexID2 should be specified..."; 1260 return undef; 1261 } 1262 if (!$This->HasEdge($VertexID1, $VertexID2)) { 1263 carp "Warning: ${ClassName}->UpdateEdgeProperty: Didn't update property $Name for edge between vertices $VertexID1 and $VertexID2: Edge doesn't exist..."; 1264 return undef; 1265 } 1266 if (!$This->HasEdgeProperty($Name, $VertexID1, $VertexID2)) { 1267 carp "Warning: ${ClassName}->UpdateEdgeProperty: Didn't update property $Name for edge between vertices $VertexID1 and $VertexID2: Edge property doesn't exists..."; 1268 return undef; 1269 } 1270 $This->_SetEdgeProperty($Name, $Value, $VertexID1, $VertexID2); 1271 $This->_SetEdgeProperty($Name, $Value, $VertexID2, $VertexID1); 1272 1273 return $This; 1274 } 1275 # Set a property for edges... 1276 sub SetEdgesProperty { 1277 my($This, $Name, @ValuesAndVertexIDs) = @_; 1278 1279 if (!defined $Name) { 1280 carp "Warning: ${ClassName}->SetEdgesProperty: Didn't set property: Property name should be specified..."; 1281 return undef; 1282 } 1283 if (!@ValuesAndVertexIDs) { 1284 carp "Warning: ${ClassName}->SetEdgesProperty: Didn't set property: Values and vertex IDs list is empty..."; 1285 return undef; 1286 } 1287 if (@ValuesAndVertexIDs % 3) { 1288 carp "Warning: ${ClassName}->SetEdgesProperty: Didn't set property: Invalid property values and vertex IDs data: Input list must contain triplets of values..."; 1289 return undef; 1290 } 1291 1292 my($Value, $VertexID1, $VertexID2, $Index); 1293 for ($Index = 0; $Index < $#ValuesAndVertexIDs; $Index += 3) { 1294 $Value = $ValuesAndVertexIDs[$Index]; 1295 $VertexID1 = $ValuesAndVertexIDs[$Index + 1]; $VertexID2 = $ValuesAndVertexIDs[$Index + 2]; 1296 $This->SetEdgeProperty($Name, $Value, $VertexID1, $VertexID2); 1297 } 1298 1299 return $This; 1300 } 1301 1302 # Set a properties for a edge... 1303 sub SetEdgeProperties { 1304 my($This, $VertexID1, $VertexID2, @NamesAndValues) = @_; 1305 1306 if (!(defined($VertexID1) && defined($VertexID2))) { 1307 carp "Warning: ${ClassName}->SetEdgeProperties: Didn't set property: Both vertexID1 and vertexID2 should be specified..."; 1308 return undef; 1309 } 1310 if (!@NamesAndValues) { 1311 carp "Warning: ${ClassName}->SetEdgeProperties: Didn't set property: Property name and values ist is empty..."; 1312 return undef; 1313 } 1314 if (@NamesAndValues % 2) { 1315 carp "Warning: ${ClassName}->SetEdgeProperties: Didn't set property: Invalid property name and values data: Input list must contain triplets of values..."; 1316 return undef; 1317 } 1318 1319 my($Name, $Value, $Index); 1320 for ($Index = 0; $Index < $#NamesAndValues; $Index += 2) { 1321 $Name = $NamesAndValues[$Index]; 1322 $Value = $NamesAndValues[$Index + 1]; 1323 $This->SetEdgeProperty($Name, $Value, $VertexID1, $VertexID2); 1324 } 1325 1326 return $This; 1327 } 1328 1329 # Set edge property... 1330 sub _SetEdgeProperty { 1331 my($This, $Name, $Value, $VertexID1, $VertexID2) = @_; 1332 1333 if (!exists $This->{Properties}->{Edges}->{$VertexID1}) { 1334 %{$This->{Properties}->{Edges}->{$VertexID1}} = (); 1335 } 1336 if (!exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}) { 1337 %{$This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}} = (); 1338 } 1339 $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}->{$Name} = $Value; 1340 1341 return $This; 1342 } 1343 1344 # Get a property value for edge... 1345 sub GetEdgeProperty { 1346 my($This, $Name, $VertexID1, $VertexID2) = @_; 1347 1348 if (!$This->HasEdgeProperty($Name, $VertexID1, $VertexID2)) { 1349 return undef; 1350 } 1351 return $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}->{$Name}; 1352 } 1353 1354 # Get a property values for edges... 1355 sub GetEdgesProperty { 1356 my($This, $Name, @VertexIDs) = @_; 1357 1358 if (!@VertexIDs) { 1359 @VertexIDs = (); 1360 @VertexIDs = $This->GetEdges(); 1361 } 1362 if (@VertexIDs % 2) { 1363 return undef; 1364 } 1365 1366 my($VertexID1, $VertexID2, $Index, $ValuesCount, @Values); 1367 @Values = (); 1368 for ($Index = 0; $Index < $#VertexIDs; $Index += 2) { 1369 $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1]; 1370 push @Values, $This->GetEdgeProperty($Name, $VertexID1, $VertexID2); 1371 } 1372 $ValuesCount = grep { defined($_) } @Values; 1373 1374 return wantarray ? @Values : $ValuesCount; 1375 } 1376 1377 # Get all property name/value paries for edge... 1378 sub GetEdgeProperties { 1379 my($This, $VertexID1, $VertexID2) = @_; 1380 1381 if (!(defined($VertexID1) && defined($VertexID2))) { 1382 return (); 1383 } 1384 if (!exists $This->{Properties}->{Edges}->{$VertexID1}) { 1385 return (); 1386 } 1387 if (!exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}) { 1388 return (); 1389 } 1390 return %{$This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}}; 1391 } 1392 1393 # Delete a property for edge... 1394 sub DeleteEdgeProperty { 1395 my($This, $Name, $VertexID1, $VertexID2) = @_; 1396 1397 if (!(defined($Name) && defined($VertexID1) && defined($VertexID2))) { 1398 carp "Warning: ${ClassName}->DeleteEdgeProperty: Didn't delete property: Property name, vertexID1 and vertexID2 should be specified..."; 1399 return undef; 1400 } 1401 if (!$This->HasEdgeProperty($Name, $VertexID1, $VertexID2)) { 1402 carp "Warning: ${ClassName}->DeleteEdgeProperty: Didn't delete property $Name for edge between vertices $VertexID1 and $VertexID2: Edge property doesn't exist..."; 1403 return undef; 1404 } 1405 $This->_DeleteEdgeProperty($VertexID1, $VertexID2, $Name); 1406 $This->_DeleteEdgeProperty($VertexID2, $VertexID1, $Name); 1407 1408 return $This; 1409 } 1410 1411 # Delete a property for edges... 1412 sub DeleteEdgesProperty { 1413 my($This, $Name, @VertexIDs) = @_; 1414 1415 if (!defined $Name) { 1416 carp "Warning: ${ClassName}->DeleteEdgesProperty: Didn't delete property: Property name should be specified..."; 1417 return undef; 1418 } 1419 if (!@VertexIDs) { 1420 @VertexIDs = (); 1421 @VertexIDs = $This->GetEdges(); 1422 } 1423 if (@VertexIDs % 2) { 1424 carp "Warning: ${ClassName}->DeleteEdgesProperty: Didn't set property: Invalid property values and vertex IDs data: Input list must contain even number of values..."; 1425 return undef; 1426 } 1427 my($Index, $VertexID1, $VertexID2); 1428 for ($Index = 0; $Index < $#VertexIDs; $Index += 2) { 1429 $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1]; 1430 $This->DeleteEdgeProperty($Name, $VertexID1, $VertexID2); 1431 } 1432 1433 return $This; 1434 } 1435 1436 # Delete all properties for edge... 1437 sub DeleteEdgeProperties { 1438 my($This, $VertexID1, $VertexID2) = @_; 1439 1440 if (!(defined($VertexID1) && defined($VertexID2))) { 1441 carp "Warning: ${ClassName}->DeleteEdgeProperties: Didn't delete property: VertexID1 and vertexID2 should be specified..."; 1442 return undef; 1443 } 1444 $This->_DeleteEdgeProperty($VertexID1, $VertexID2); 1445 $This->_DeleteEdgeProperty($VertexID2, $VertexID1); 1446 1447 return $This; 1448 } 1449 1450 # Delete properties for edges... 1451 sub DeleteEdgesProperties { 1452 my($This, @VertexIDs) = @_; 1453 1454 if (!@VertexIDs) { 1455 @VertexIDs = (); 1456 @VertexIDs = $This->GetEdges(); 1457 } 1458 if (@VertexIDs % 2) { 1459 carp "Warning: ${ClassName}->DeleteEdgesProperty: Didn't set property: Invalid property values and vertex IDs data: Input list must contain even number of values..."; 1460 return undef; 1461 } 1462 my($Index, $VertexID1, $VertexID2); 1463 for ($Index = 0; $Index < $#VertexIDs; $Index += 2) { 1464 $VertexID1 = $VertexIDs[$Index]; $VertexID2 = $VertexIDs[$Index + 1]; 1465 $This->DeleteEdgeProperties($VertexID1, $VertexID2); 1466 } 1467 return $This; 1468 } 1469 1470 1471 # Delete a specific edge property or all edge properties... 1472 sub _DeleteEdgeProperty { 1473 my($This, $VertexID1, $VertexID2, $Name) = @_; 1474 1475 if (exists $This->{Properties}->{Edges}->{$VertexID1}) { 1476 if (exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}) { 1477 if (defined $Name) { 1478 if (exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}->{$Name}) { 1479 delete $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}->{$Name}; 1480 } 1481 } 1482 else { 1483 %{$This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}} = (); 1484 } 1485 if (! keys %{$This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}}) { 1486 delete $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}; 1487 } 1488 } 1489 if (! keys %{$This->{Properties}->{Edges}->{$VertexID1}}) { 1490 delete $This->{Properties}->{Edges}->{$VertexID1}; 1491 } 1492 } 1493 1494 return $This; 1495 } 1496 1497 # Is this property associated with edge? 1498 sub HasEdgeProperty { 1499 my($This, $Name, $VertexID1, $VertexID2) = @_; 1500 1501 if (!(defined($Name) && defined($VertexID1) && defined($VertexID2))) { 1502 return 0; 1503 } 1504 my($Status); 1505 1506 $Status = ($This->_HasEdgeProperty($Name, $VertexID1, $VertexID2) || $This->_HasEdgeProperty($Name, $VertexID2, $VertexID1)) ? 1 : 0; 1507 1508 return $Status; 1509 } 1510 1511 # Does edge proprty exists? 1512 sub _HasEdgeProperty { 1513 my($This, $Name, $VertexID1, $VertexID2) = @_; 1514 1515 if (exists $This->{Properties}->{Edges}->{$VertexID1}) { 1516 if (exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}) { 1517 if (exists $This->{Properties}->{Edges}->{$VertexID1}->{$VertexID2}->{$Name}) { 1518 return 1; 1519 } 1520 } 1521 } 1522 return 0; 1523 } 1524 1525 # Is it a graph object? 1526 sub IsGraph ($) { 1527 my($Object) = @_; 1528 1529 return _IsGraph($Object); 1530 } 1531 1532 # Return a string containg vertices, edges and other properties... 1533 sub StringifyGraph { 1534 my($This) = @_; 1535 my($GraphString); 1536 1537 $GraphString = 'Graph:' . $This->StringifyVerticesAndEdges() . '; ' . $This->StringifyProperties(); 1538 1539 return $GraphString; 1540 } 1541 1542 # Return a string containg vertices, edges and other properties... 1543 sub StringifyProperties { 1544 my($This) = @_; 1545 my($PropertiesString); 1546 1547 $PropertiesString = $This->StringifyGraphProperties() . '; ' . $This->StringifyVerticesProperties(). '; ' . $This->StringifyEdgesProperties(); 1548 1549 return $PropertiesString; 1550 } 1551 1552 # Return a string containg vertices and edges... 1553 sub StringifyVerticesAndEdges { 1554 my($This) = @_; 1555 my($GraphString, $Index, $VertexID, $VertexID1, $VertexID2, $Count, @EdgeVertexIDs, @VertexIDs); 1556 1557 # Get vertices and edges... 1558 $GraphString = ''; 1559 @VertexIDs = (); 1560 @VertexIDs = $This->GetVertices(); 1561 $Count = 0; 1562 for $VertexID (@VertexIDs) { 1563 $Count++; 1564 @EdgeVertexIDs = (); 1565 @EdgeVertexIDs = $This->_GetEdgesFrom($VertexID); 1566 if (@EdgeVertexIDs) { 1567 for ($Index = 0; $Index < $#EdgeVertexIDs; $Index += 2) { 1568 $VertexID1 = $EdgeVertexIDs[$Index]; $VertexID2 = $EdgeVertexIDs[$Index + 1]; 1569 $GraphString .= " ${VertexID1}-${VertexID2}"; 1570 } 1571 } 1572 else { 1573 $GraphString .= " ${VertexID}"; 1574 } 1575 } 1576 if (!$Count) { 1577 $GraphString = 'Graph: None'; 1578 } 1579 return $GraphString; 1580 } 1581 1582 # Return a string containg graph properties... 1583 sub StringifyGraphProperties { 1584 my($This) = @_; 1585 my($Name, $Value, $Count, $GraphPropertyString, %GraphProperties); 1586 1587 $GraphPropertyString = "GraphProperties: "; 1588 %GraphProperties = (); 1589 %GraphProperties = $This->GetGraphProperties(); 1590 if (keys %GraphProperties) { 1591 for $Name (sort keys %GraphProperties) { 1592 $Value = $GraphProperties{$Name}; 1593 if (ref($Value) =~ /^ARRAY/) { 1594 if (@{$Value}) { 1595 $GraphPropertyString .= " ${Name}=(Count: " . scalar @{$Value} . "; " . join(', ', @{$Value}) . ")"; 1596 } 1597 else { 1598 $GraphPropertyString .= " ${Name}=None"; 1599 } 1600 } 1601 else { 1602 $GraphPropertyString .= " ${Name}=${Value}"; 1603 } 1604 } 1605 } 1606 else { 1607 $GraphPropertyString .= " None"; 1608 } 1609 return $GraphPropertyString; 1610 } 1611 1612 # Return a string containg vertices properties... 1613 sub StringifyVerticesProperties { 1614 my($This) = @_; 1615 my($Name, $Value, $Count, $VertexPropertyString, $VertexID, @VertexIDs, %VertexProperties); 1616 1617 @VertexIDs = (); 1618 @VertexIDs = $This->GetVertices(); 1619 $Count = 0; 1620 $VertexPropertyString = "VertexProperties:"; 1621 for $VertexID (@VertexIDs) { 1622 %VertexProperties = (); 1623 %VertexProperties = $This->GetVertexProperties($VertexID); 1624 if (keys %VertexProperties) { 1625 $Count++; 1626 $VertexPropertyString .= " <Vertex ${VertexID}: "; 1627 for $Name (sort keys %VertexProperties) { 1628 $Value = $VertexProperties{$Name}; 1629 if (ref($Value) =~ /^ARRAY/) { 1630 if (@{$Value}) { 1631 $VertexPropertyString .= " ${Name}=(" . join(', ', @{$Value}) . ")"; 1632 } 1633 else { 1634 $VertexPropertyString .= " ${Name}=None"; 1635 } 1636 } 1637 else { 1638 $VertexPropertyString .= " ${Name}=${Value}"; 1639 } 1640 } 1641 $VertexPropertyString .= ">"; 1642 } 1643 } 1644 if (!$Count) { 1645 $VertexPropertyString = "VertexProperties: None"; 1646 } 1647 return $VertexPropertyString; 1648 } 1649 1650 # Return a string containg edges properties... 1651 sub StringifyEdgesProperties { 1652 my($This) = @_; 1653 my($Name, $Value, $Index, $EdgePropertyString, $Count, $VertexID, $VertexID1, $VertexID2, @EdgesVertexIDs, %EdgeProperties); 1654 1655 @EdgesVertexIDs = (); 1656 @EdgesVertexIDs = $This->GetEdges(); 1657 $Count = 0; 1658 $EdgePropertyString = "EdgeProperties:"; 1659 for ($Index = 0; $Index < $#EdgesVertexIDs; $Index += 2) { 1660 $VertexID1 = $EdgesVertexIDs[$Index]; $VertexID2 = $EdgesVertexIDs[$Index + 1]; 1661 %EdgeProperties = (); 1662 %EdgeProperties = $This->GetEdgeProperties($VertexID1, $VertexID2); 1663 if (keys %EdgeProperties) { 1664 $Count++; 1665 $EdgePropertyString .= " <Edge ${VertexID1}-${VertexID2}:"; 1666 for $Name (sort keys %EdgeProperties) { 1667 $Value = $EdgeProperties{$Name}; 1668 if (ref($Value) =~ /^ARRAY/) { 1669 if (@{$Value}) { 1670 $EdgePropertyString .= " ${Name}=(" . join(', ', @{$Value}) . ")"; 1671 } 1672 else { 1673 $EdgePropertyString .= " ${Name}=None"; 1674 } 1675 } 1676 else { 1677 $EdgePropertyString .= " ${Name}=${Value}"; 1678 } 1679 } 1680 $EdgePropertyString .= ">"; 1681 } 1682 } 1683 if (!$Count) { 1684 $EdgePropertyString = "EdgeProperties: None"; 1685 } 1686 1687 return $EdgePropertyString; 1688 } 1689 1690 # Is it a graph object? 1691 sub _IsGraph { 1692 my($Object) = @_; 1693 1694 return (Scalar::Util::blessed($Object) && $Object->isa($ClassName)) ? 1 : 0; 1695 } 1696 1697 # Copy graph and its associated data using Storable::dclone and return a new graph... 1698 # 1699 sub Copy { 1700 my($This) = @_; 1701 my($NewGraph); 1702 1703 $NewGraph = Storable::dclone($This); 1704 1705 return $NewGraph; 1706 } 1707 1708 # Copy vertrices and edges from This graph to NewGraph specified... 1709 # 1710 sub CopyVerticesAndEdges { 1711 my($This, $NewGraph) = @_; 1712 1713 # Copy vertices and edges... 1714 my(@Vertices, @Edges); 1715 @Vertices = $This->GetVertices(); 1716 if (@Vertices) { 1717 $NewGraph->AddVertices(@Vertices); 1718 } 1719 @Edges = $This->GetEdges(); 1720 if (@Edges) { 1721 $NewGraph->AddEdges(@Edges); 1722 } 1723 1724 return $NewGraph; 1725 } 1726 1727 # Copy properties of vertices from This graph to NewGraph specified... 1728 # 1729 sub CopyVerticesProperties { 1730 my($This, $NewGraph) = @_; 1731 1732 my($VertexID, @VertexIDs, %VertexProperties); 1733 @VertexIDs = (); 1734 @VertexIDs = $This->GetVertices(); 1735 for $VertexID (@VertexIDs) { 1736 %VertexProperties = (); %VertexProperties = $This->GetVertexProperties($VertexID); 1737 if (keys %VertexProperties) { 1738 $NewGraph->SetVertexProperties($VertexID, %VertexProperties); 1739 } 1740 } 1741 return $NewGraph; 1742 } 1743 1744 # Copy properties of edges from This graph to NewGraph specified... 1745 # 1746 sub CopyEdgesProperties { 1747 my($This, $NewGraph) = @_; 1748 1749 my($Index, $VertexID1, $VertexID2, @EdgesVertexIDs, %EdgeProperties); 1750 @EdgesVertexIDs = (); 1751 @EdgesVertexIDs = $This->GetEdges(); 1752 for ($Index = 0; $Index < $#EdgesVertexIDs; $Index += 2) { 1753 $VertexID1 = $EdgesVertexIDs[$Index]; $VertexID2 = $EdgesVertexIDs[$Index + 1]; 1754 %EdgeProperties = (); %EdgeProperties = $This->GetEdgeProperties($VertexID1, $VertexID2); 1755 if (keys %EdgeProperties) { 1756 $NewGraph->SetEdgeProperties($VertexID1, $VertexID2, %EdgeProperties); 1757 } 1758 } 1759 return $NewGraph; 1760 } 1761 1762 # Detect cycles and associate 'em to graph as graph property... 1763 # 1764 # Note: 1765 # . CyclesDetection class detects all cycles in the graph and filters 'em to find 1766 # independent cycles. 1767 # . All cycles related methods in the graph operate on active cyclic paths. By default, 1768 # active cyclic paths correspond to independent cycles. This behavior can be changed 1769 # using SetActiveCyclicPaths method. 1770 # . For topologically complex graphs containing large number of cycles, DetectCycles method 1771 # implemented in CyclesDetection can time out in which case no cycles are detected or 1772 # assigned. 1773 # 1774 sub DetectCycles { 1775 my($This) = @_; 1776 my($CyclesDetection); 1777 1778 # Delete existing graph cycles... 1779 $This->_DeleteCyclesAssociatedWithGraph(); 1780 1781 # Detect cycles... 1782 $CyclesDetection = new Graph::CyclesDetection($This); 1783 if (!$CyclesDetection->DetectCycles()) { 1784 # Cycles detection didn't finish... 1785 return undef; 1786 } 1787 1788 # Get cycles and associate 'em to graph as properties... 1789 my(@AllCyclicPaths, @IndependentCyclicPaths); 1790 @AllCyclicPaths = $CyclesDetection->GetAllCyclicPaths(); 1791 @IndependentCyclicPaths = $CyclesDetection->GetIndependentCyclicPaths(); 1792 1793 $This->SetGraphProperty('ActiveCyclicPaths', \@IndependentCyclicPaths); 1794 $This->SetGraphProperty('AllCyclicPaths', \@AllCyclicPaths); 1795 $This->SetGraphProperty('IndependentCyclicPaths', \@IndependentCyclicPaths); 1796 1797 # Map cycles information to vertices and edges; identify fused cycles as well... 1798 return $This->_ProcessDetectedCycles(); 1799 } 1800 1801 # Delete any cycle properties assigned to graph, vertices and edges during detect cycles operation... 1802 # 1803 sub ClearCycles { 1804 my($This) = @_; 1805 1806 # Delete cycle properties associated with graph... 1807 $This->_DeleteCyclesAssociatedWithGraph(); 1808 $This->_DeleteFusedCyclesAssociatedWithGraph(); 1809 1810 # Delete cycle properties associated with vertices and edges... 1811 $This->_DeleteCyclesAssociatedWithVertices(); 1812 $This->_DeleteCyclesAssociatedWithEdges(); 1813 1814 return $This; 1815 } 1816 1817 # Setup cyclic paths to use during all cycle related methods. Possible values: 1818 # Independent or All. Default is to use Independent cyclic paths. 1819 # 1820 sub SetActiveCyclicPaths { 1821 my($This, $CyclicPathsType) = @_; 1822 1823 if (!defined $CyclicPathsType) { 1824 carp "Warning: ${ClassName}->SetActiveCyclicPaths: Didn't set active cyclic path: Cyclic path must be specified..."; 1825 return undef; 1826 } 1827 if ($CyclicPathsType !~ /^(Independent|All)$/i) { 1828 carp "Warning: ${ClassName}->SetActiveCyclicPaths: Didn't set active cyclic path: Specified path type, $CyclicPathsType, is not valid. Supported valeus: Independent or All..."; 1829 return undef; 1830 } 1831 if (!$This->HasGraphProperty('ActiveCyclicPaths')) { 1832 carp "Warning: ${ClassName}->SetActiveCyclicPaths: Didn't set active cyclic path: Cycles haven't been detected yet..."; 1833 return undef; 1834 } 1835 $This->DeleteGraphProperty('ActiveCyclicPaths'); 1836 1837 my($ActiveCyclicPathsRef); 1838 if ($CyclicPathsType =~ /^Independent$/i) { 1839 $ActiveCyclicPathsRef = $This->GetGraphProperty('IndependentCyclicPaths'); 1840 } 1841 elsif ($CyclicPathsType =~ /^All$/i) { 1842 $ActiveCyclicPathsRef = $This->GetGraphProperty('AllCyclicPaths'); 1843 } 1844 $This->SetGraphProperty('ActiveCyclicPaths', $ActiveCyclicPathsRef); 1845 1846 # Map cycles information to vertices and edges; identify fused cycles as well... 1847 $This->_ProcessDetectedCycles(); 1848 1849 return $This; 1850 } 1851 1852 # Assign cycles information on to vertices and edges as vertex edge properties properties; 1853 # identify fused cycles as well... 1854 # 1855 sub _ProcessDetectedCycles { 1856 my($This) = @_; 1857 1858 $This->_AssociateCyclesWithVertices(); 1859 $This->_AssociateCyclesWithEdgesAndIdentifyFusedCycles(); 1860 1861 return $This; 1862 } 1863 1864 # Associate cycles information to vertices as vertex properties... 1865 # 1866 sub _AssociateCyclesWithVertices { 1867 my($This) = @_; 1868 1869 # Clear up any exisiting properties... 1870 $This->_DeleteCyclesAssociatedWithVertices(); 1871 1872 # Collects CyclicPaths for each vertex... 1873 my($VertexID, $ActiveCyclicPath, $ActiveCyclicPathsRef, @CyclicPathVertexIDs, %VertexIDToCylicPaths); 1874 1875 %VertexIDToCylicPaths = (); 1876 $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); 1877 1878 if (!@{$ActiveCyclicPathsRef}) { 1879 # No cycles out there... 1880 return $This; 1881 } 1882 1883 for $ActiveCyclicPath (@{$ActiveCyclicPathsRef}) { 1884 @CyclicPathVertexIDs = (); 1885 @CyclicPathVertexIDs = $ActiveCyclicPath->GetVertices(); 1886 # Take out end vertex: It's same as start vertex for cyclic path... 1887 pop @CyclicPathVertexIDs; 1888 for $VertexID (@CyclicPathVertexIDs) { 1889 if (!exists $VertexIDToCylicPaths{$VertexID}) { 1890 @{$VertexIDToCylicPaths{$VertexID}} = (); 1891 } 1892 push @{$VertexIDToCylicPaths{$VertexID}}, $ActiveCyclicPath; 1893 } 1894 } 1895 1896 # Associate CyclicPaths to vertices... 1897 for $VertexID (keys %VertexIDToCylicPaths) { 1898 $This->SetVertexProperty('ActiveCyclicPaths', \@{$VertexIDToCylicPaths{$VertexID}}, $VertexID); 1899 } 1900 return $This; 1901 } 1902 1903 # Associate cycles information to edges as edge properties and identify fused 1904 # cycles... 1905 # 1906 sub _AssociateCyclesWithEdgesAndIdentifyFusedCycles { 1907 my($This) = @_; 1908 1909 # Delete existing cycles... 1910 $This->_DeleteCyclesAssociatedWithEdges(); 1911 $This->_DeleteFusedCyclesAssociatedWithGraph(); 1912 1913 # Collect cyclic paths for each edge... 1914 my($Index, $VertexID1, $VertexID2, $ActiveCyclicPath, $ActiveCyclicPathsRef, $EdgeID, $EdgeIDDelimiter, $CyclesWithCommonEdgesPresent, @CyclicPathEdgeVertexIDs, %EdgeIDToCylicPaths); 1915 1916 %EdgeIDToCylicPaths = (); 1917 $EdgeIDDelimiter = "~"; 1918 $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); 1919 1920 if (!@{$ActiveCyclicPathsRef}) { 1921 # No cycles out there... 1922 return $This; 1923 } 1924 1925 $CyclesWithCommonEdgesPresent = 0; 1926 for $ActiveCyclicPath (@{$ActiveCyclicPathsRef}) { 1927 @CyclicPathEdgeVertexIDs = (); 1928 @CyclicPathEdgeVertexIDs = $ActiveCyclicPath->GetEdges(); 1929 for ($Index = 0; $Index < $#CyclicPathEdgeVertexIDs; $Index += 2) { 1930 $VertexID1 = $CyclicPathEdgeVertexIDs[$Index]; $VertexID2 = $CyclicPathEdgeVertexIDs[$Index + 1]; 1931 $EdgeID = ($VertexID1 < $VertexID2) ? "${VertexID1}${EdgeIDDelimiter}${VertexID2}" : "${VertexID2}${EdgeIDDelimiter}${VertexID1}"; 1932 if (exists $EdgeIDToCylicPaths{$EdgeID}) { 1933 # A common edge between two cycles indicates a potential fused cycle... 1934 $CyclesWithCommonEdgesPresent = 1; 1935 } 1936 else { 1937 @{$EdgeIDToCylicPaths{$EdgeID}} = (); 1938 } 1939 push @{$EdgeIDToCylicPaths{$EdgeID}}, $ActiveCyclicPath; 1940 } 1941 } 1942 1943 # Associate CyclicPaths with edges... 1944 for $EdgeID (keys %EdgeIDToCylicPaths) { 1945 ($VertexID1, $VertexID2) = split($EdgeIDDelimiter, $EdgeID); 1946 $This->SetEdgeProperty('ActiveCyclicPaths', \@{$EdgeIDToCylicPaths{$EdgeID}}, $VertexID1, $VertexID2); 1947 } 1948 1949 if ($CyclesWithCommonEdgesPresent) { 1950 # Identify fused cycles... 1951 $This->_IdentifyAndAssociateFusedCyclesWithGraph(); 1952 } 1953 1954 return $This; 1955 } 1956 1957 # Identify fused cycles and associate them to graph as graph property after cycles 1958 # have been associated with edges... 1959 # 1960 # Note: 1961 # . During aromaticity detection, fused cycles are treated as one set for counting 1962 # number of available pi electrons to check against Huckel's rule. 1963 # . Fused cylce sets contain cycles with at least one common edge between pair 1964 # of cycles. A specific pair of cycles might not have a direct common edge, but 1965 # ends up in the same set due to a common edge with another cycle. 1966 # . Fused cycles are attached to graph as 'FusedActiveCyclicPaths' property with 1967 # its value as a reference to list of reference where each refernece corresponds 1968 # to a list of cyclic path objects in a fused set. 1969 # . For graphs containing fused cycles, non-fused cycles are separeted from fused 1970 # cycles and attached to the graph as 'NonFusedActiveCyclicPaths'. It's a reference 1971 # to list containing cylic path objects. 1972 # 1973 sub _IdentifyAndAssociateFusedCyclesWithGraph { 1974 my($This) = @_; 1975 1976 # Delete exisiting fused and non-fused cycles... 1977 $This->_DeleteFusedCyclesAssociatedWithGraph(); 1978 1979 my($ActiveCyclicPathsRef); 1980 $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); 1981 if (!@{$ActiveCyclicPathsRef}) { 1982 # No cycles out there... 1983 return $This; 1984 } 1985 1986 # Get fused cycle pairs... 1987 my($FusedCyclePairsRef, $FusedCyclesRef, $InValidFusedCycleRef); 1988 ($FusedCyclePairsRef, $FusedCyclesRef, $InValidFusedCycleRef) = $This->_GetFusedCyclePairs($ActiveCyclicPathsRef); 1989 1990 # Get fused cycle set indices... 1991 my($FusedCycleSetsIndicesRef, $FusedCycleSetsCommonEdgesRef); 1992 $FusedCycleSetsIndicesRef = $This->_GetFusedCycleSetsIndices($FusedCyclePairsRef, $FusedCyclesRef); 1993 if (!@{$FusedCycleSetsIndicesRef}) { 1994 # No fused cycles out there... 1995 return $This; 1996 } 1997 1998 # Get fused and non-fused cycles... 1999 my($FusedCycleSetsRef, $NonFusedCyclesRef); 2000 ($FusedCycleSetsRef, $NonFusedCyclesRef) = $This->_GetFusedAndNonFusedCycles($ActiveCyclicPathsRef, $FusedCycleSetsIndicesRef, $InValidFusedCycleRef); 2001 if (!@{$FusedCycleSetsRef}) { 2002 # No fused cycles out there... 2003 return $This; 2004 } 2005 2006 # Associate fused and non fused cycles to graph.... 2007 $This->SetGraphProperty('FusedActiveCyclicPaths', $FusedCycleSetsRef); 2008 $This->SetGraphProperty('NonFusedActiveCyclicPaths', $NonFusedCyclesRef); 2009 2010 return $This; 2011 } 2012 2013 # Collect fused cycle pairs... 2014 # 2015 sub _GetFusedCyclePairs { 2016 my($This, $ActiveCyclicPathsRef) = @_; 2017 2018 # Setup a CyclicPathID to CyclicPathIndex map... 2019 my($CyclicPathIndex, $CyclicPathID, $ActiveCyclicPath, %CyclicPathIDToIndex); 2020 2021 %CyclicPathIDToIndex = (); 2022 for $CyclicPathIndex (0 .. $#{$ActiveCyclicPathsRef}) { 2023 $ActiveCyclicPath = $ActiveCyclicPathsRef->[$CyclicPathIndex]; 2024 $CyclicPathID = "$ActiveCyclicPath"; 2025 $CyclicPathIDToIndex{$CyclicPathID} = $CyclicPathIndex; 2026 } 2027 # Go over cycle edges and collect fused cycle pairs... 2028 my($Index, $VertexID1, $VertexID2, $EdgeCyclicPathsRef, $EdgeID, $CyclicPath1, $CyclicPath2, $CyclicPathID1, $CyclicPathID2, $FusedCyclePairID, $FusedCyclicPath1, $FusedCyclicPath2, $FusedCyclicPathID1, $FusedCyclicPathID2, $FusedCyclicPathIndex1, $FusedCyclicPathIndex2, $FusedCyclePairEdgeCount, @CyclicPathEdgeVertexIDs, %FusedCyclePairs, %CommonEdgeVisited, %CommonEdgesCount, %FusedCycles, %InValidFusedCycles); 2029 2030 %FusedCyclePairs = (); %CommonEdgeVisited = (); 2031 %CommonEdgesCount = (); 2032 %InValidFusedCycles = (); %FusedCycles = (); 2033 2034 for $ActiveCyclicPath (@{$ActiveCyclicPathsRef}) { 2035 @CyclicPathEdgeVertexIDs = (); 2036 @CyclicPathEdgeVertexIDs = $ActiveCyclicPath->GetEdges(); 2037 EDGE: for ($Index = 0; $Index < $#CyclicPathEdgeVertexIDs; $Index += 2) { 2038 $VertexID1 = $CyclicPathEdgeVertexIDs[$Index]; $VertexID2 = $CyclicPathEdgeVertexIDs[$Index + 1]; 2039 $EdgeCyclicPathsRef = $This->GetEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); 2040 if (@{$EdgeCyclicPathsRef} != 2) { 2041 # Not considered a fused edge... 2042 next EDGE; 2043 } 2044 # Set up a fused cycle pair... 2045 ($FusedCyclicPath1, $FusedCyclicPath2) = @{$EdgeCyclicPathsRef}; 2046 ($FusedCyclicPathID1, $FusedCyclicPathID2) = ("${FusedCyclicPath1}", "${FusedCyclicPath2}"); 2047 ($FusedCyclicPathIndex1, $FusedCyclicPathIndex2) = ($CyclicPathIDToIndex{$FusedCyclicPathID1}, $CyclicPathIDToIndex{$FusedCyclicPathID2}); 2048 $FusedCyclePairID = ($FusedCyclicPathIndex1 < $FusedCyclicPathIndex2) ? "${FusedCyclicPathIndex1}-${FusedCyclicPathIndex2}" : "${FusedCyclicPathIndex2}-${FusedCyclicPathIndex1}"; 2049 $EdgeID = ($VertexID1 < $VertexID2) ? "${VertexID1}-${VertexID2}" : "${VertexID2}-${VertexID1}"; 2050 2051 if (exists $FusedCyclePairs{$FusedCyclePairID}) { 2052 if (exists $CommonEdgeVisited{$FusedCyclePairID}{$EdgeID}) { 2053 # Edge already processed... 2054 next EDGE; 2055 } 2056 $CommonEdgeVisited{$FusedCyclePairID}{$EdgeID} = $EdgeID; 2057 2058 $CommonEdgesCount{$FusedCyclePairID} += 1; 2059 push @{$FusedCyclePairs{$FusedCyclePairID}}, $EdgeID; 2060 } 2061 else { 2062 @{$FusedCyclePairs{$FusedCyclePairID}} = (); 2063 push @{$FusedCyclePairs{$FusedCyclePairID}}, $EdgeID; 2064 2065 %{$CommonEdgeVisited{$FusedCyclePairID}} = (); 2066 $CommonEdgeVisited{$FusedCyclePairID}{$EdgeID} = $EdgeID; 2067 2068 $CommonEdgesCount{$FusedCyclePairID} = 1; 2069 } 2070 } 2071 } 2072 # Valid fused cyle in fused cycle pairs must have only one common egde... 2073 for $FusedCyclePairID (keys %FusedCyclePairs) { 2074 ($FusedCyclicPathIndex1, $FusedCyclicPathIndex2) = split /-/, $FusedCyclePairID; 2075 $FusedCycles{$FusedCyclicPathIndex1} = $FusedCyclicPathIndex1; 2076 $FusedCycles{$FusedCyclicPathIndex2} = $FusedCyclicPathIndex2; 2077 if (@{$FusedCyclePairs{$FusedCyclePairID}} != 1) { 2078 # Mark the cycles involved as invalid fused cycles... 2079 $InValidFusedCycles{$FusedCyclicPathIndex1} = $FusedCyclicPathIndex1; 2080 $InValidFusedCycles{$FusedCyclicPathIndex2} = $FusedCyclicPathIndex2; 2081 } 2082 } 2083 return (\%FusedCyclePairs, \%FusedCycles, \%InValidFusedCycles); 2084 } 2085 2086 # Go over fused cycles and set up a graph to collect fused cycle sets. Graph vertices 2087 # correspond to cylce indices; edges correspond to pair of fused cylcles; fused cycle 2088 # sets correspond to connected components. Addionally set up common edges for 2089 # fused cycle sets. 2090 # 2091 sub _GetFusedCycleSetsIndices { 2092 my($This, $FusedCyclePairsRef, $FusedCyclesRef) = @_; 2093 my($FusedCyclesGraph, @FusedCycleIndices, @FusedCyclePairIndices, @FusedCycleSetsIndices); 2094 2095 @FusedCycleIndices = (); @FusedCyclePairIndices = (); 2096 @FusedCycleSetsIndices = (); 2097 2098 @FusedCycleIndices = sort { $a <=> $b } keys %{$FusedCyclesRef}; 2099 @FusedCyclePairIndices = map { split /-/, $_; } keys %{$FusedCyclePairsRef}; 2100 if (!@FusedCycleIndices) { 2101 # No fused cycles out there... 2102 return \@FusedCycleSetsIndices; 2103 } 2104 $FusedCyclesGraph = new Graph(@FusedCycleIndices); 2105 $FusedCyclesGraph->AddEdges(@FusedCyclePairIndices); 2106 2107 @FusedCycleSetsIndices = $FusedCyclesGraph->GetConnectedComponentsVertices(); 2108 2109 return \@FusedCycleSetsIndices; 2110 } 2111 2112 # Go over indices of fused cycle sets and map cyclic path indices to cyclic path objects. 2113 # For fused sets containing a cycle with more than one common edge, the whole set is treated 2114 # as non-fused set... 2115 # 2116 sub _GetFusedAndNonFusedCycles { 2117 my($This, $ActiveCyclicPathsRef, $FusedCycleSetsIndicesRef, $InValidFusedCycleRef) = @_; 2118 my($CycleSetIndicesRef, $CyclicPathIndex, $ValidFusedCycleSet, @FusedCycleSets, @UnsortedNonFusedCycles, @NonFusedCycles, %CycleIndexVisited); 2119 2120 @FusedCycleSets = (); @NonFusedCycles = (); @UnsortedNonFusedCycles = (); 2121 %CycleIndexVisited = (); 2122 for $CycleSetIndicesRef (@{$FusedCycleSetsIndicesRef}) { 2123 # Is it a valid fused cycle set? Fused cycle set containing any cycle with more than one common 2124 # edge is considered invalid and all its cycles are treated as non-fused cycles. 2125 $ValidFusedCycleSet = 1; 2126 for $CyclicPathIndex (@{$CycleSetIndicesRef}) { 2127 $CycleIndexVisited{$CyclicPathIndex} = $CyclicPathIndex; 2128 if (exists $InValidFusedCycleRef->{$CyclicPathIndex}) { 2129 $ValidFusedCycleSet = 0; 2130 } 2131 } 2132 if ($ValidFusedCycleSet) { 2133 my(@FusedCycleSet); 2134 @FusedCycleSet = (); 2135 push @FusedCycleSet, sort { $a->GetLength() <=> $b->GetLength() } map { $ActiveCyclicPathsRef->[$_] } @{$CycleSetIndicesRef}; 2136 push @FusedCycleSets, \@FusedCycleSet; 2137 } 2138 else { 2139 push @UnsortedNonFusedCycles, map { $ActiveCyclicPathsRef->[$_] } @{$CycleSetIndicesRef}; 2140 } 2141 } 2142 2143 # Add any leftover cycles to non-fused cycles list... 2144 CYCLICPATH: for $CyclicPathIndex (0 .. $#{$ActiveCyclicPathsRef}) { 2145 if (exists $CycleIndexVisited{$CyclicPathIndex}) { 2146 next CYCLICPATH; 2147 } 2148 push @UnsortedNonFusedCycles, $ActiveCyclicPathsRef->[$CyclicPathIndex]; 2149 } 2150 @NonFusedCycles = sort { $a->GetLength() <=> $b->GetLength() } @UnsortedNonFusedCycles; 2151 2152 return (\@FusedCycleSets, \@NonFusedCycles); 2153 } 2154 2155 # Delete cycles associated with graph... 2156 # 2157 sub _DeleteCyclesAssociatedWithGraph { 2158 my($This) = @_; 2159 2160 if ($This->HasGraphProperty('ActiveCyclicPaths')) { 2161 $This->DeleteGraphProperty('ActiveCyclicPaths'); 2162 $This->DeleteGraphProperty('AllCyclicPaths'); 2163 $This->DeleteGraphProperty('IndependentCyclicPaths'); 2164 } 2165 return $This; 2166 } 2167 2168 # Delete cycles associated with vertices... 2169 # 2170 sub _DeleteCyclesAssociatedWithVertices { 2171 my($This) = @_; 2172 my($VertexID, @VertexIDs); 2173 2174 @VertexIDs = (); 2175 @VertexIDs = $This->GetVertices(); 2176 for $VertexID (@VertexIDs) { 2177 if ($This->HasVertexProperty('ActiveCyclicPaths', $VertexID)) { 2178 $This->DeleteVertexProperty('ActiveCyclicPaths', $VertexID); 2179 } 2180 } 2181 return $This; 2182 } 2183 2184 # Delete cycles associated with edges... 2185 # 2186 sub _DeleteCyclesAssociatedWithEdges { 2187 my($This) = @_; 2188 my($Index, $VertexID1, $VertexID2, @EdgeVertexIDs); 2189 2190 @EdgeVertexIDs = (); 2191 @EdgeVertexIDs = $This->GetEdges(); 2192 for ($Index = 0; $Index < $#EdgeVertexIDs; $Index += 2) { 2193 $VertexID1 = $EdgeVertexIDs[$Index]; $VertexID2 = $EdgeVertexIDs[$Index + 1]; 2194 if ($This->HasEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2)) { 2195 $This->DeleteEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); 2196 } 2197 } 2198 return $This; 2199 } 2200 2201 # Delete fused cycles associated with edges... 2202 # 2203 sub _DeleteFusedCyclesAssociatedWithGraph { 2204 my($This) = @_; 2205 2206 # Delete exisiting cycles... 2207 if ($This->HasGraphProperty('FusedActiveCyclicPaths')) { 2208 $This->DeleteGraphProperty('FusedActiveCyclicPaths'); 2209 $This->DeleteGraphProperty('NonFusedActiveCyclicPaths'); 2210 } 2211 return $This; 2212 } 2213 2214 # Does graph contains any cycles? 2215 # 2216 sub IsAcyclic { 2217 my($This) = @_; 2218 2219 return $This->GetNumOfCycles() ? 0 : 1; 2220 } 2221 2222 # Does graph contains cycles? 2223 # 2224 sub IsCyclic { 2225 my($This) = @_; 2226 2227 return $This->GetNumOfCycles() ? 1 : 0; 2228 } 2229 2230 # Does graph contains only any cycle? 2231 # 2232 sub IsUnicyclic { 2233 my($This) = @_; 2234 2235 return ($This->GetNumOfCycles() == 1) ? 1 : 0; 2236 } 2237 2238 # Get size of smallest cycle in graph... 2239 # 2240 sub GetGirth { 2241 my($This) = @_; 2242 2243 return $This->GetSizeOfSmallestCycle(); 2244 } 2245 2246 # Get size of smallest cycle in graph... 2247 # 2248 sub GetSizeOfSmallestCycle { 2249 my($This) = @_; 2250 2251 return $This->_GetCycleSize('GraphCycle', 'SmallestCycle'); 2252 } 2253 2254 # Get size of largest cycle in graph... 2255 # 2256 sub GetCircumference { 2257 my($This) = @_; 2258 2259 return $This->GetSizeOfLargestCycle(); 2260 } 2261 2262 # Get size of largest cycle in graph... 2263 # 2264 sub GetSizeOfLargestCycle { 2265 my($This) = @_; 2266 2267 return $This->_GetCycleSize('GraphCycle', 'LargestCycle'); 2268 } 2269 2270 # Get number of cycles in graph... 2271 # 2272 sub GetNumOfCycles { 2273 my($This) = @_; 2274 2275 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'AllSizes'); 2276 } 2277 2278 # Get number of cycles with odd size in graph... 2279 # 2280 sub GetNumOfCyclesWithOddSize { 2281 my($This) = @_; 2282 2283 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'OddSize'); 2284 } 2285 2286 # Get number of cycles with even size in graph... 2287 # 2288 sub GetNumOfCyclesWithEvenSize { 2289 my($This) = @_; 2290 2291 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'EvenSize'); 2292 } 2293 2294 # Get number of cycles with specific size in graph... 2295 # 2296 sub GetNumOfCyclesWithSize { 2297 my($This, $CycleSize) = @_; 2298 2299 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'SpecifiedSize', $CycleSize); 2300 } 2301 2302 # Get number of cycles with size less than a specific size in graph... 2303 # 2304 sub GetNumOfCyclesWithSizeLessThan { 2305 my($This, $CycleSize) = @_; 2306 2307 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'SizeLessThan', $CycleSize); 2308 } 2309 2310 # Get number of cycles with size greater than a specific size in graph... 2311 # 2312 sub GetNumOfCyclesWithSizeGreaterThan { 2313 my($This, $CycleSize) = @_; 2314 2315 return $This->_GetNumOfCyclesWithSize('GraphCycle', 'SizeGreaterThan', $CycleSize); 2316 } 2317 2318 # Get largest cyclic path in graph... 2319 # 2320 sub GetLargestCycle { 2321 my($This) = @_; 2322 2323 return $This->_GetCycle('GraphCycle', 'LargestCycle'); 2324 } 2325 2326 # Get smallest cyclic path in graph... 2327 # 2328 sub GetSmallestCycle { 2329 my($This) = @_; 2330 2331 return $This->_GetCycle('GraphCycle', 'SmallestCycle'); 2332 } 2333 2334 # Get all cycles in graph... 2335 # 2336 sub GetCycles { 2337 my($This) = @_; 2338 2339 return $This->_GetCyclesWithSize('GraphCycle', 'AllSizes'); 2340 } 2341 2342 # Get cycles with odd size in graph... 2343 # 2344 sub GetCyclesWithOddSize { 2345 my($This) = @_; 2346 2347 return $This->_GetCyclesWithSize('GraphCycle', 'OddSize'); 2348 } 2349 2350 # Get cycles with even size in graph... 2351 # 2352 sub GetCyclesWithEvenSize { 2353 my($This) = @_; 2354 2355 return $This->_GetCyclesWithSize('GraphCycle', 'EvenSize'); 2356 } 2357 2358 # Get cycles with specific size in graph... 2359 # 2360 sub GetCyclesWithSize { 2361 my($This, $CycleSize) = @_; 2362 2363 return $This->_GetCyclesWithSize('GraphCycle', 'SpecifiedSize', $CycleSize); 2364 } 2365 2366 # Get cycles with size less than a specific size in graph... 2367 # 2368 sub GetCyclesWithSizeLessThan { 2369 my($This, $CycleSize) = @_; 2370 2371 return $This->_GetCyclesWithSize('GraphCycle', 'SizeLessThan', $CycleSize); 2372 } 2373 2374 # Get cycles with size greater than a specific size in graph... 2375 # 2376 sub GetCyclesWithSizeGreaterThan { 2377 my($This, $CycleSize) = @_; 2378 2379 return $This->_GetCyclesWithSize('GraphCycle', 'SizeGreaterThan', $CycleSize); 2380 } 2381 2382 # Is vertex in a cycle? 2383 # 2384 sub IsCyclicVertex { 2385 my($This, $VertexID) = @_; 2386 2387 return $This->GetNumOfVertexCycles($VertexID) ? 1 : 0; 2388 } 2389 2390 # Is vertex in a only one cycle? 2391 # 2392 sub IsUnicyclicVertex { 2393 my($This, $VertexID) = @_; 2394 2395 return ($This->GetNumOfVertexCycles($VertexID) == 1) ? 1 : 0; 2396 } 2397 2398 # Is vertex not in a cycle? 2399 # 2400 sub IsAcyclicVertex { 2401 my($This, $VertexID) = @_; 2402 2403 return $This->GetNumOfVertexCycles($VertexID) ? 0 : 1; 2404 } 2405 2406 # Get size of smallest cycle containing specified vertex... 2407 # 2408 sub GetSizeOfSmallestVertexCycle { 2409 my($This, $VertexID) = @_; 2410 2411 return $This->_GetCycleSize('VertexCycle', 'SmallestCycle', $VertexID); 2412 } 2413 2414 # Get size of largest cycle containing specified vertex... 2415 # 2416 sub GetSizeOfLargestVertexCycle { 2417 my($This, $VertexID) = @_; 2418 2419 return $This->_GetCycleSize('VertexCycle', 'LargestCycle', $VertexID); 2420 } 2421 2422 # Get number of cycles containing specified vertex... 2423 # 2424 sub GetNumOfVertexCycles { 2425 my($This, $VertexID) = @_; 2426 2427 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'AllSizes', 0, $VertexID); 2428 } 2429 2430 # Get number of cycles with odd size containing specified vertex... 2431 # 2432 sub GetNumOfVertexCyclesWithOddSize { 2433 my($This, $VertexID) = @_; 2434 2435 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'OddSize', 0, $VertexID); 2436 } 2437 2438 # Get number of cycles with even size containing specified vertex... 2439 # 2440 sub GetNumOfVertexCyclesWithEvenSize { 2441 my($This, $VertexID) = @_; 2442 2443 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'EvenSize', 0, $VertexID); 2444 } 2445 2446 # Get number of cycles with specified size containing specified vertex... 2447 # 2448 sub GetNumOfVertexCyclesWithSize { 2449 my($This, $VertexID, $CycleSize) = @_; 2450 2451 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'SpecifiedSize', $CycleSize, $VertexID); 2452 } 2453 2454 # Get number of cycles with size less than specified size containing specified vertex... 2455 # 2456 sub GetNumOfVertexCyclesWithSizeLessThan { 2457 my($This, $VertexID, $CycleSize) = @_; 2458 2459 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'SizeLessThan', $CycleSize, $VertexID); 2460 } 2461 2462 # Get number of cycles with size greater than specified size containing specified vertex... 2463 # 2464 sub GetNumOfVertexCyclesWithSizeGreaterThan { 2465 my($This, $VertexID, $CycleSize) = @_; 2466 2467 return $This->_GetNumOfCyclesWithSize('VertexCycle', 'SizeGreaterThan', $CycleSize, $VertexID); 2468 } 2469 2470 # Get smallest cycle containing specified vertex... 2471 # 2472 sub GetSmallestVertexCycle { 2473 my($This, $VertexID) = @_; 2474 2475 return $This->_GetCycle('VertexCycle', 'SmallestCycle', $VertexID); 2476 } 2477 2478 # Get largest cycle containing specified vertex... 2479 # 2480 sub GetLargestVertexCycle { 2481 my($This, $VertexID) = @_; 2482 2483 return $This->_GetCycle('VertexCycle', 'LargestCycle', $VertexID); 2484 } 2485 2486 # Get cycles containing specified vertex... 2487 # 2488 sub GetVertexCycles { 2489 my($This, $VertexID) = @_; 2490 2491 return $This->_GetCyclesWithSize('VertexCycle', 'AllSizes', 0, $VertexID); 2492 } 2493 2494 # Get cycles with odd size containing specified vertex... 2495 # 2496 sub GetVertexCyclesWithOddSize { 2497 my($This, $VertexID) = @_; 2498 2499 return $This->_GetCyclesWithSize('VertexCycle', 'OddSize', 0, $VertexID); 2500 } 2501 2502 # Get cycles with even size containing specified vertex... 2503 # 2504 sub GetVertexCyclesWithEvenSize { 2505 my($This, $VertexID) = @_; 2506 2507 return $This->_GetCyclesWithSize('VertexCycle', 'EvenSize', 0, $VertexID); 2508 } 2509 2510 # Get cycles with specified size containing specified vertex... 2511 # 2512 sub GetVertexCyclesWithSize { 2513 my($This, $VertexID, $CycleSize) = @_; 2514 2515 return $This->_GetCyclesWithSize('VertexCycle', 'SpecifiedSize', $CycleSize, $VertexID); 2516 } 2517 2518 # Get cycles with size less than specified size containing specified vertex... 2519 # 2520 sub GetVertexCyclesWithSizeLessThan { 2521 my($This, $VertexID, $CycleSize) = @_; 2522 2523 return $This->_GetCyclesWithSize('VertexCycle', 'SizeLessThan', $CycleSize, $VertexID); 2524 } 2525 2526 # Get cycles with size greater than specified size containing specified vertex... 2527 # 2528 sub GetVertexCyclesWithSizeGreaterThan { 2529 my($This, $VertexID, $CycleSize) = @_; 2530 2531 return $This->_GetCyclesWithSize('VertexCycle', 'SizeGreaterThan', $CycleSize, $VertexID); 2532 } 2533 2534 # Is edge in a cycle? 2535 # 2536 sub IsCyclicEdge { 2537 my($This, $VertexID1, $VertexID2) = @_; 2538 2539 return $This->GetNumOfEdgeCycles($VertexID1, $VertexID2) ? 1 : 0; 2540 } 2541 2542 # Is edge in a only one cycle? 2543 # 2544 sub IsUnicyclicEdge { 2545 my($This, $VertexID1, $VertexID2) = @_; 2546 2547 return ($This->GetNumOfEdgeCycles($VertexID1, $VertexID2) == 1) ? 1 : 0; 2548 } 2549 2550 # Is Edge not in a cycle? 2551 # 2552 sub IsAcyclicEdge { 2553 my($This, $VertexID1, $VertexID2) = @_; 2554 2555 return $This->GetNumOfEdgeCycles($VertexID1, $VertexID2) ? 0 : 1; 2556 } 2557 2558 # Get size of smallest cycle containing specified edge... 2559 # 2560 sub GetSizeOfSmallestEdgeCycle { 2561 my($This, $VertexID1, $VertexID2) = @_; 2562 2563 return $This->_GetCycleSize('EdgeCycle', 'SmallestCycle', $VertexID1, $VertexID2); 2564 } 2565 2566 # Get size of largest cycle containing specified edge... 2567 # 2568 sub GetSizeOfLargestEdgeCycle { 2569 my($This, $VertexID1, $VertexID2) = @_; 2570 2571 return $This->_GetCycleSize('EdgeCycle', 'LargestCycle', $VertexID1, $VertexID2); 2572 } 2573 2574 # Get number of cycles containing specified edge... 2575 # 2576 sub GetNumOfEdgeCycles { 2577 my($This, $VertexID1, $VertexID2) = @_; 2578 2579 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'AllSizes', 0, $VertexID1, $VertexID2); 2580 } 2581 2582 # Get number of cycles with odd size containing specified edge... 2583 # 2584 sub GetNumOfEdgeCyclesWithOddSize { 2585 my($This, $VertexID1, $VertexID2) = @_; 2586 2587 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'OddSize', 0, $VertexID1, $VertexID2); 2588 } 2589 2590 # Get number of cycles with even size containing specified edge... 2591 # 2592 sub GetNumOfEdgeCyclesWithEvenSize { 2593 my($This, $VertexID1, $VertexID2) = @_; 2594 2595 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'EvenSize', 0, $VertexID1, $VertexID2); 2596 } 2597 2598 # Get number of cycles with specified size containing specified edge... 2599 # 2600 sub GetNumOfEdgeCyclesWithSize { 2601 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2602 2603 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'SpecifiedSize', $CycleSize, $VertexID1, $VertexID2); 2604 } 2605 2606 # Get number of cycles with size less than specified size containing specified edge... 2607 # 2608 sub GetNumOfEdgeCyclesWithSizeLessThan { 2609 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2610 2611 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'SizeLessThan', $CycleSize, $VertexID1, $VertexID2); 2612 } 2613 2614 # Get number of cycles with size greater than specified size containing specified edge... 2615 # 2616 sub GetNumOfEdgeCyclesWithSizeGreaterThan { 2617 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2618 2619 return $This->_GetNumOfCyclesWithSize('EdgeCycle', 'SizeGreaterThan', $CycleSize, $VertexID1, $VertexID2); 2620 } 2621 2622 # Get smallest cycle containing specified edge... 2623 # 2624 sub GetSmallestEdgeCycle { 2625 my($This, $VertexID1, $VertexID2) = @_; 2626 2627 return $This->_GetCycle('EdgeCycle', 'SmallestCycle', $VertexID1, $VertexID2); 2628 } 2629 2630 # Get largest cycle containing specified edge... 2631 # 2632 sub GetLargestEdgeCycle { 2633 my($This, $VertexID1, $VertexID2) = @_; 2634 2635 return $This->_GetCycle('EdgeCycle', 'LargestCycle', $VertexID1, $VertexID2); 2636 } 2637 2638 # Get cycles containing specified edge... 2639 # 2640 sub GetEdgeCycles { 2641 my($This, $VertexID1, $VertexID2) = @_; 2642 2643 return $This->_GetCyclesWithSize('EdgeCycle', 'AllSizes', 0, $VertexID1, $VertexID2); 2644 } 2645 2646 # Get cycles with odd size containing specified edge... 2647 # 2648 sub GetEdgeCyclesWithOddSize { 2649 my($This, $VertexID1, $VertexID2) = @_; 2650 2651 return $This->_GetCyclesWithSize('EdgeCycle', 'OddSize', 0, $VertexID1, $VertexID2); 2652 } 2653 2654 # Get cycles with even size containing specified edge... 2655 # 2656 sub GetEdgeCyclesWithEvenSize { 2657 my($This, $VertexID1, $VertexID2) = @_; 2658 2659 return $This->_GetCyclesWithSize('EdgeCycle', 'EvenSize', 0, $VertexID1, $VertexID2); 2660 } 2661 2662 # Get cycles with specified size containing specified edge... 2663 # 2664 sub GetEdgeCyclesWithSize { 2665 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2666 2667 return $This->_GetCyclesWithSize('EdgeCycle', 'SpecifiedSize', $CycleSize, $VertexID1, $VertexID2); 2668 } 2669 2670 # Get cycles with size less than specified size containing specified edge... 2671 # 2672 sub GetEdgeCyclesWithSizeLessThan { 2673 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2674 2675 return $This->_GetCyclesWithSize('EdgeCycle', 'SizeLessThan', $CycleSize, $VertexID1, $VertexID2); 2676 } 2677 2678 # Get cycles with size greater than specified size containing specified edge... 2679 # 2680 sub GetEdgeCyclesWithSizeGreaterThan { 2681 my($This, $VertexID1, $VertexID2, $CycleSize) = @_; 2682 2683 return $This->_GetCyclesWithSize('EdgeCycle', 'SizeGreaterThan', $CycleSize, $VertexID1, $VertexID2); 2684 } 2685 2686 # Get size of specified cycle type... 2687 # 2688 sub _GetCycleSize { 2689 my($This, $Mode, $CycleSize, $VertexID1, $VertexID2) = @_; 2690 my($ActiveCyclicPathsRef, $CyclicPath, $Size); 2691 2692 if (!$This->HasGraphProperty('ActiveCyclicPaths')) { 2693 return 0; 2694 } 2695 if ($Mode =~ /^VertexCycle$/i) { 2696 if (!$This->HasVertexProperty('ActiveCyclicPaths', $VertexID1)) { 2697 return 0; 2698 } 2699 } 2700 elsif ($Mode =~ /^EdgeCycle$/i) { 2701 if (!$This->HasEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2)) { 2702 return 0; 2703 } 2704 } 2705 2706 MODE: { 2707 if ($Mode =~ /^GraphCycle$/i) { $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); last MODE; } 2708 if ($Mode =~ /^VertexCycle$/i) { $ActiveCyclicPathsRef = $This->GetVertexProperty('ActiveCyclicPaths', $VertexID1); last MODE; } 2709 if ($Mode =~ /^EdgeCycle$/i) { $ActiveCyclicPathsRef = $This->GetEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); last MODE; } 2710 return 0; 2711 } 2712 2713 if (!@{$ActiveCyclicPathsRef}) { 2714 return 0; 2715 } 2716 2717 CYCLESIZE: { 2718 if ($CycleSize =~ /^SmallestCycle$/i) { $CyclicPath = $ActiveCyclicPathsRef->[0]; last CYCLESIZE; } 2719 if ($CycleSize =~ /^LargestCycle$/i) { $CyclicPath = $ActiveCyclicPathsRef->[$#{$ActiveCyclicPathsRef}]; last CYCLESIZE; } 2720 return 0; 2721 } 2722 $Size = $CyclicPath->GetLength() - 1; 2723 2724 return $Size; 2725 } 2726 2727 # Get of specified cycle size... 2728 # 2729 sub _GetCycle { 2730 my($This, $Mode, $CycleSize, $VertexID1, $VertexID2) = @_; 2731 my($ActiveCyclicPathsRef, $CyclicPath, $Size); 2732 2733 if (!$This->HasGraphProperty('ActiveCyclicPaths')) { 2734 return $This->_GetEmptyCycles(); 2735 } 2736 if ($Mode =~ /^VertexCycle$/i) { 2737 if (!$This->HasVertexProperty('ActiveCyclicPaths', $VertexID1)) { 2738 return $This->_GetEmptyCycles(); 2739 } 2740 } 2741 elsif ($Mode =~ /^EdgeCycle$/i) { 2742 if (!$This->HasEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2)) { 2743 return $This->_GetEmptyCycles(); 2744 } 2745 } 2746 2747 MODE: { 2748 if ($Mode =~ /^GraphCycle$/i) { $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); last MODE; } 2749 if ($Mode =~ /^VertexCycle$/i) { $ActiveCyclicPathsRef = $This->GetVertexProperty('ActiveCyclicPaths', $VertexID1); last MODE; } 2750 if ($Mode =~ /^EdgeCycle$/i) { $ActiveCyclicPathsRef = $This->GetEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); last MODE; } 2751 return $This->_GetEmptyCycles(); 2752 } 2753 2754 if (!@{$ActiveCyclicPathsRef}) { 2755 return $This->_GetEmptyCycles(); 2756 } 2757 2758 CYCLESIZE: { 2759 if ($CycleSize =~ /^SmallestCycle$/i) { $CyclicPath = $ActiveCyclicPathsRef->[0]; last CYCLESIZE; } 2760 if ($CycleSize =~ /^LargestCycle$/i) { $CyclicPath = $ActiveCyclicPathsRef->[$#{$ActiveCyclicPathsRef}]; last CYCLESIZE; } 2761 return $This->_GetEmptyCycles(); 2762 } 2763 return $CyclicPath; 2764 } 2765 2766 # Get num of cycles in graph... 2767 # 2768 sub _GetNumOfCyclesWithSize { 2769 my($This, $Mode, $SizeMode, $SpecifiedSize, $VertexID1, $VertexID2) = @_; 2770 my($ActiveCyclicPathsRef); 2771 2772 if (!$This->HasGraphProperty('ActiveCyclicPaths')) { 2773 return 0; 2774 } 2775 if ($Mode =~ /^VertexCycle$/i) { 2776 if (!$This->HasVertexProperty('ActiveCyclicPaths', $VertexID1)) { 2777 return 0; 2778 } 2779 } 2780 elsif ($Mode =~ /^EdgeCycle$/i) { 2781 if (!$This->HasEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2)) { 2782 return 0; 2783 } 2784 } 2785 2786 if ($SizeMode =~ /^(SizeLessThan|SizeGreaterThan|SpecifiedSize)$/i) { 2787 if (!defined $SpecifiedSize) { 2788 carp "Warning: ${ClassName}->_GetNumOfCyclesWithSize: Cycle size muse be defined..."; 2789 return 0; 2790 } 2791 if ($SpecifiedSize < 0) { 2792 carp "Warning: ${ClassName}->_GetNumOfCyclesWithSize: Specified cycle size, $SpecifiedSize, must be > 0 ..."; 2793 return 0; 2794 } 2795 } 2796 2797 MODE: { 2798 if ($Mode =~ /^GraphCycle$/i) { $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); last MODE; } 2799 if ($Mode =~ /^VertexCycle$/i) { $ActiveCyclicPathsRef = $This->GetVertexProperty('ActiveCyclicPaths', $VertexID1); last MODE; } 2800 if ($Mode =~ /^EdgeCycle$/i) { $ActiveCyclicPathsRef = $This->GetEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); last MODE; } 2801 return 0; 2802 } 2803 2804 if (!@{$ActiveCyclicPathsRef}) { 2805 return 0; 2806 } 2807 my($NumOfCycles); 2808 2809 $NumOfCycles = $This->_GetCycles($Mode, $ActiveCyclicPathsRef, $SizeMode, $SpecifiedSize); 2810 2811 return $NumOfCycles; 2812 } 2813 2814 # Get cycles in graph... 2815 # 2816 sub _GetCyclesWithSize { 2817 my($This, $Mode, $SizeMode, $SpecifiedSize, $VertexID1, $VertexID2) = @_; 2818 my($ActiveCyclicPathsRef); 2819 2820 if (!$This->HasGraphProperty('ActiveCyclicPaths')) { 2821 return $This->_GetEmptyCycles(); 2822 } 2823 if ($Mode =~ /^VertexCycle$/i) { 2824 if (!$This->HasVertexProperty('ActiveCyclicPaths', $VertexID1)) { 2825 return $This->_GetEmptyCycles(); 2826 } 2827 } 2828 elsif ($Mode =~ /^EdgeCycle$/i) { 2829 if (!$This->HasEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2)) { 2830 return $This->_GetEmptyCycles(); 2831 } 2832 } 2833 2834 if ($SizeMode =~ /^(SizeLessThan|SizeGreaterThan|SpecifiedSize)$/i) { 2835 if (!defined $SpecifiedSize) { 2836 carp "Warning: ${ClassName}->_GetCyclesWithSize: Cycle size must be defined..."; 2837 return $This->_GetEmptyCycles(); 2838 } 2839 if ($SpecifiedSize < 0) { 2840 carp "Warning: ${ClassName}->_GetCyclesWithSize: Specified cycle size, $SpecifiedSize, must be > 0 ..."; 2841 return $This->_GetEmptyCycles(); 2842 } 2843 } 2844 2845 MODE: { 2846 if ($Mode =~ /^GraphCycle$/i) { $ActiveCyclicPathsRef = $This->GetGraphProperty('ActiveCyclicPaths'); last MODE; } 2847 if ($Mode =~ /^VertexCycle$/i) { $ActiveCyclicPathsRef = $This->GetVertexProperty('ActiveCyclicPaths', $VertexID1); last MODE; } 2848 if ($Mode =~ /^EdgeCycle$/i) { $ActiveCyclicPathsRef = $This->GetEdgeProperty('ActiveCyclicPaths', $VertexID1, $VertexID2); last MODE; } 2849 return $This->_GetEmptyCycles(); 2850 } 2851 2852 if (!@{$ActiveCyclicPathsRef}) { 2853 return $This->_GetEmptyCycles(); 2854 } 2855 return $This->_GetCycles($Mode, $ActiveCyclicPathsRef, $SizeMode, $SpecifiedSize); 2856 } 2857 2858 # Get cycles information... 2859 # 2860 sub _GetCycles { 2861 my($This, $Mode, $ActiveCyclicPathsRef, $SizeMode, $SpecifiedSize) = @_; 2862 2863 if (!@{$ActiveCyclicPathsRef}) { 2864 return $This->_GetEmptyCycles(); 2865 } 2866 2867 if ($SizeMode =~ /^AllSizes$/i) { 2868 return wantarray ? @{$ActiveCyclicPathsRef} : scalar @{$ActiveCyclicPathsRef}; 2869 } 2870 2871 # Get appropriate cycles... 2872 my($Size, $CyclicPath, @FilteredCyclicPaths); 2873 @FilteredCyclicPaths = (); 2874 2875 for $CyclicPath (@{$ActiveCyclicPathsRef}) { 2876 $Size = $CyclicPath->GetLength() - 1; 2877 SIZEMODE: { 2878 if ($SizeMode =~ /^OddSize$/i) { if ($Size % 2) { push @FilteredCyclicPaths, $CyclicPath; } last SIZEMODE; } 2879 if ($SizeMode =~ /^EvenSize$/i) { if (!($Size % 2)) { push @FilteredCyclicPaths, $CyclicPath; } last SIZEMODE; } 2880 if ($SizeMode =~ /^SizeLessThan$/i) { if ($Size < $SpecifiedSize) { push @FilteredCyclicPaths, $CyclicPath; } last SIZEMODE; } 2881 if ($SizeMode =~ /^SizeGreaterThan$/i) { if ($Size > $SpecifiedSize) { push @FilteredCyclicPaths, $CyclicPath; } last SIZEMODE; } 2882 if ($SizeMode =~ /^SpecifiedSize$/i) { if ($Size == $SpecifiedSize) { push @FilteredCyclicPaths, $CyclicPath; } last SIZEMODE; } 2883 return undef; 2884 } 2885 } 2886 return wantarray ? @FilteredCyclicPaths : scalar @FilteredCyclicPaths; 2887 } 2888 2889 # Return empty cyles array... 2890 # 2891 sub _GetEmptyCycles { 2892 my($This) = @_; 2893 my(@CyclicPaths); 2894 2895 @CyclicPaths = (); 2896 2897 return wantarray ? @CyclicPaths : scalar @CyclicPaths; 2898 } 2899 2900 # Does graph contains fused cycles? 2901 sub HasFusedCycles { 2902 my($This) = @_; 2903 2904 return ($This->HasGraphProperty('FusedActiveCyclicPaths')) ? 1 : 0; 2905 } 2906 2907 # Return a reference to fused cycle sets lists containing references to lists of cyclic path objects 2908 # in each fused cycle set and a reference to a list containing non-fused cyclic paths... 2909 # 2910 sub GetFusedAndNonFusedCycles { 2911 my($This) = @_; 2912 my($FusedCycleSetsRef, $NonFusedCyclesRef); 2913 2914 $FusedCycleSetsRef = $This->HasGraphProperty('FusedActiveCyclicPaths') ? $This->GetGraphProperty('FusedActiveCyclicPaths') : undef; 2915 $NonFusedCyclesRef = $This->HasGraphProperty('NonFusedActiveCyclicPaths') ? $This->GetGraphProperty('NonFusedActiveCyclicPaths') : undef; 2916 2917 return ($FusedCycleSetsRef, $NonFusedCyclesRef); 2918 } 2919 2920 # Get vertices of connected components as a list containing references to 2921 # lists of vertices for each component sorted in order of its decreasing size... 2922 # 2923 sub GetConnectedComponentsVertices { 2924 my($This) = @_; 2925 my($PathsTraversal); 2926 2927 $PathsTraversal = new Graph::PathsTraversal($This); 2928 $PathsTraversal->PerformDepthFirstSearch(); 2929 2930 return $PathsTraversal->GetConnectedComponentsVertices(); 2931 } 2932 2933 # Get a list of topologically sorted vertrices starting from a specified vertex or 2934 # an arbitrary vertex in the graph... 2935 # 2936 sub GetTopologicallySortedVertices { 2937 my($This, $RootVertexID) = @_; 2938 my($PathsTraversal); 2939 2940 $PathsTraversal = new Graph::PathsTraversal($This); 2941 $PathsTraversal->PerformBreadthFirstSearch($RootVertexID); 2942 2943 return $PathsTraversal->GetVertices(); 2944 } 2945 2946 # Get a list of paths starting from a specified vertex with length upto specified length 2947 # and no sharing of edges in paths traversed. By default, cycles are included in paths. 2948 # A path containing a cycle is terminated at a vertex completing the cycle. 2949 # 2950 sub GetPathsStartingAtWithLengthUpto { 2951 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 2952 my($PathsTraversal); 2953 2954 $PathsTraversal = new Graph::PathsTraversal($This); 2955 $PathsTraversal->PerformPathsSearchWithLengthUpto($StartVertexID, $Length, $AllowCycles); 2956 2957 return $PathsTraversal->GetPaths(); 2958 } 2959 2960 # Get a list of paths starting from a specified vertex with specified length 2961 # and no sharing of edges in paths traversed. By default, cycles are included in paths. 2962 # A path containing a cycle is terminated at a vertex completing the cycle. 2963 # 2964 sub GetPathsStartingAtWithLength { 2965 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 2966 my($PathsTraversal); 2967 2968 $PathsTraversal = new Graph::PathsTraversal($This); 2969 $PathsTraversal->PerformPathsSearchWithLength($StartVertexID, $Length, $AllowCycles); 2970 2971 return $PathsTraversal->GetPaths(); 2972 } 2973 2974 # Get a list of paths with all possible lengths starting from a specified vertex 2975 # with no sharing of edges in paths traversed. By default, cycles are included in paths. 2976 # A path containing a cycle is terminated at a vertex completing the cycle. 2977 # 2978 sub GetPathsStartingAt { 2979 my($This, $StartVertexID, $AllowCycles) = @_; 2980 my($PathsTraversal); 2981 2982 $PathsTraversal = new Graph::PathsTraversal($This); 2983 $PathsTraversal->PerformPathsSearch($StartVertexID, $AllowCycles); 2984 2985 return $PathsTraversal->GetPaths(); 2986 } 2987 2988 # Get a list of all paths starting from a specified vertex with length upto a specified length 2989 # with sharing of edges in paths traversed. By default, cycles are included in paths. 2990 # A path containing a cycle is terminated at a vertex completing the cycle. 2991 # 2992 sub GetAllPathsStartingAtWithLengthUpto { 2993 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 2994 my($PathsTraversal); 2995 2996 $PathsTraversal = new Graph::PathsTraversal($This); 2997 $PathsTraversal->PerformAllPathsSearchWithLengthUpto($StartVertexID, $Length, $AllowCycles); 2998 2999 return $PathsTraversal->GetPaths(); 3000 } 3001 3002 # Get a list of all paths starting from a specified vertex with specified length 3003 # with sharing of edges in paths traversed. By default, cycles are included in paths. 3004 # A path containing a cycle is terminated at a vertex completing the cycle. 3005 # 3006 sub GetAllPathsStartingAtWithLength { 3007 my($This, $StartVertexID, $Length, $AllowCycles) = @_; 3008 my($PathsTraversal); 3009 3010 $PathsTraversal = new Graph::PathsTraversal($This); 3011 $PathsTraversal->PerformAllPathsSearchWithLength($StartVertexID, $Length, $AllowCycles); 3012 3013 return $PathsTraversal->GetPaths(); 3014 } 3015 3016 3017 # Get a list of all paths with all possible lengths starting from a specified vertex 3018 # with sharing of edges in paths traversed. By default, cycles are included in paths. 3019 # A path containing a cycle is terminated at a vertex completing the cycle. 3020 # 3021 sub GetAllPathsStartingAt { 3022 my($This, $StartVertexID, $AllowCycles) = @_; 3023 my($PathsTraversal); 3024 3025 $PathsTraversal = new Graph::PathsTraversal($This); 3026 $PathsTraversal->PerformAllPathsSearch($StartVertexID, $AllowCycles); 3027 3028 return $PathsTraversal->GetPaths(); 3029 } 3030 3031 # Get a reference to list of paths starting from each vertex in graph with length upto specified 3032 # length and no sharing of edges in paths traversed. By default, cycles are included in paths. 3033 # A path containing a cycle is terminated at a vertex completing the cycle. 3034 # 3035 sub GetPathsWithLengthUpto { 3036 my($This, $Length, $AllowCycles) = @_; 3037 3038 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3039 3040 return $This->_GetPaths('PathsWithLengthUpto', $Length, $AllowCycles); 3041 } 3042 3043 # Get a reference to list of paths starting from each vertex in graph with specified 3044 # length and no sharing of edges in paths traversed. By default, cycles are included in paths. 3045 # A path containing a cycle is terminated at a vertex completing the cycle. 3046 # 3047 sub GetPathsWithLength { 3048 my($This, $Length, $AllowCycles) = @_; 3049 3050 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3051 3052 return $This->_GetPaths('PathsWithLength', $Length, $AllowCycles); 3053 } 3054 3055 # Get a reference to list of paths with all possible lengths starting from each vertex 3056 # with no sharing of edges in paths traversed. By default, cycles are included in paths. 3057 # A path containing a cycle is terminated at a vertex completing the cycle. 3058 # 3059 # 3060 sub GetPaths { 3061 my($This, $AllowCycles) = @_; 3062 3063 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3064 3065 return $This->_GetPaths('PathsWithAllLengths', undef, $AllowCycles); 3066 } 3067 3068 # Get a reference to list of all paths starting from each vertex in graph with length upto a specified 3069 # length with sharing of edges in paths traversed. By default, cycles are included in paths. A path 3070 # containing a cycle is terminated at a vertex completing the cycle. 3071 # 3072 # Note: 3073 # . Duplicate paths are not removed. 3074 # 3075 sub GetAllPathsWithLengthUpto { 3076 my($This, $Length, $AllowCycles) = @_; 3077 3078 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3079 3080 return $This->_GetPaths('AllPathsWithLengthUpto', $Length, $AllowCycles); 3081 } 3082 3083 # Get a reference to list of all paths starting from each vertex in graph with specified 3084 # length with sharing of edges in paths traversed. By default, cycles are included in paths. A path 3085 # containing a cycle is terminated at a vertex completing the cycle. 3086 # 3087 # Note: 3088 # . Duplicate paths are not removed. 3089 # 3090 sub GetAllPathsWithLength { 3091 my($This, $Length, $AllowCycles) = @_; 3092 3093 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3094 3095 return $This->_GetPaths('AllPathsWithLength', $Length, $AllowCycles); 3096 } 3097 3098 # Get a reference to list of all paths with all possible lengths starting from each vertex in graph 3099 # with sharing of edges in paths traversed. By default, cycles are included in paths. A path 3100 # containing a cycle is terminated at a vertex completing the cycle. 3101 # 3102 # Note: 3103 # . Duplicate paths are not removed. 3104 # 3105 sub GetAllPaths { 3106 my($This, $AllowCycles) = @_; 3107 3108 $AllowCycles = (defined $AllowCycles) ? $AllowCycles : 1; 3109 3110 return $This->_GetPaths('AllPathsWithAllLengths', undef, $AllowCycles); 3111 } 3112 3113 3114 # Retrieve appropriate paths for each vertex in graph and return a referernce to list 3115 # containing path objects... 3116 # 3117 sub _GetPaths { 3118 my($This, $Mode, $Length, $AllowCycles) = @_; 3119 my($VertexID, @EmptyPaths, @Paths); 3120 3121 @Paths = (); @EmptyPaths = (); 3122 3123 for $VertexID ($This->GetVertices()) { 3124 my($Status, $PathsTraversal); 3125 3126 $PathsTraversal = new Graph::PathsTraversal($This); 3127 MODE: { 3128 if ($Mode =~ /^PathsWithLengthUpto$/i) { $Status = $PathsTraversal->PerformPathsSearchWithLengthUpto($VertexID, $Length, $AllowCycles); last MODE; } 3129 if ($Mode =~ /^PathsWithLength$/i) { $Status = $PathsTraversal->PerformPathsSearchWithLength($VertexID, $Length, $AllowCycles); last MODE; } 3130 if ($Mode =~ /^PathsWithAllLengths$/i) { $Status = $PathsTraversal->PerformPathsSearch($VertexID, $AllowCycles); last MODE; } 3131 3132 if ($Mode =~ /^AllPathsWithLengthUpto$/i) { $Status = $PathsTraversal->PerformAllPathsSearchWithLengthUpto($VertexID, $Length, $AllowCycles); last MODE; } 3133 if ($Mode =~ /^AllPathsWithLength$/i) { $Status = $PathsTraversal->PerformAllPathsSearchWithLength($VertexID, $Length, $AllowCycles); last MODE; } 3134 if ($Mode =~ /^AllPathsWithAllLengths$/i) { $Status = $PathsTraversal->PerformAllPathsSearch($VertexID, $AllowCycles); last MODE; } 3135 3136 return \@EmptyPaths; 3137 } 3138 if (!defined $Status) { 3139 return \@EmptyPaths; 3140 } 3141 push @Paths, $PathsTraversal->GetPaths(); 3142 } 3143 return \@Paths; 3144 } 3145 3146 # Get a list of paths between two vertices. For cyclic graphs, the list contains 3147 # may contain two paths... 3148 # 3149 sub GetPathsBetween { 3150 my($This, $StartVertexID, $EndVertexID) = @_; 3151 my($Path, $ReversePath, @Paths); 3152 3153 @Paths = (); 3154 3155 $Path = $This->_GetPathBetween($StartVertexID, $EndVertexID); 3156 if (!defined $Path) { 3157 return \@Paths; 3158 } 3159 3160 $ReversePath = $This->_GetPathBetween($EndVertexID, $StartVertexID); 3161 if (!defined $ReversePath) { 3162 return \@Paths; 3163 } 3164 if ($Path eq $ReversePath) { 3165 push @Paths, $Path; 3166 } 3167 else { 3168 # Make sure first vertex in reverse path corresponds to specified start vertex ID... 3169 $ReversePath->Reverse(); 3170 push @Paths, ($Path->GetLength <= $ReversePath->GetLength()) ? ($Path, $ReversePath) : ($ReversePath, $Path); 3171 } 3172 return @Paths; 3173 } 3174 3175 # Get a path beween two vertices... 3176 # 3177 sub _GetPathBetween { 3178 my($This, $StartVertexID, $EndVertexID) = @_; 3179 my($PathsTraversal, @Paths); 3180 3181 $PathsTraversal = new Graph::PathsTraversal($This); 3182 $PathsTraversal->PerformPathsSearchBetween($StartVertexID, $EndVertexID); 3183 3184 @Paths = $PathsTraversal->GetPaths(); 3185 3186 return (@Paths) ? $Paths[0] : undef; 3187 } 3188 3189 # Get a list containing lists of neighborhood vertices around a specified vertex with in a 3190 # specified radius... 3191 # 3192 sub GetNeighborhoodVerticesWithRadiusUpto { 3193 my($This, $StartVertexID, $Radius) = @_; 3194 my($PathsTraversal); 3195 3196 $PathsTraversal = new Graph::PathsTraversal($This); 3197 $PathsTraversal->PerformNeighborhoodVerticesSearchWithRadiusUpto($StartVertexID, $Radius); 3198 3199 return $PathsTraversal->GetVerticesNeighborhoods(); 3200 } 3201 3202 # Get a list containing lists of neighborhood vertices around a specified vertex at all 3203 # radii levels... 3204 # 3205 sub GetNeighborhoodVertices { 3206 my($This, $StartVertexID) = @_; 3207 my($PathsTraversal); 3208 3209 $PathsTraversal = new Graph::PathsTraversal($This); 3210 $PathsTraversal->PerformNeighborhoodVerticesSearch($StartVertexID); 3211 3212 return $PathsTraversal->GetVerticesNeighborhoods(); 3213 } 3214 3215 # Get neighborhood vertices around a specified vertex, along with their successor connected vertices, collected 3216 # with in a specified radius as a list containing references to lists with first value corresponding to vertex 3217 # ID and second value as reference to a list containing its successor connected vertices. 3218 # 3219 # For a neighborhood vertex at each radius level, the successor connected vertices correspond to the 3220 # neighborhood vertices at the next radius level. Consequently, the neighborhood vertices at the last 3221 # radius level don't contain any successor vertices which fall outside the range of specified radius. 3222 # 3223 sub GetNeighborhoodVerticesWithSuccessorsAndRadiusUpto { 3224 my($This, $StartVertexID, $Radius) = @_; 3225 my($PathsTraversal); 3226 3227 $PathsTraversal = new Graph::PathsTraversal($This); 3228 $PathsTraversal->PerformNeighborhoodVerticesSearchWithSuccessorsAndRadiusUpto($StartVertexID, $Radius); 3229 3230 return $PathsTraversal->GetVerticesNeighborhoodsWithSuccessors(); 3231 } 3232 3233 # Get neighborhood vertices around a specified vertex, along with their successor connected vertices, collected 3234 # at all neighborhood radii as a list containing references to lists with first value corresponding to vertex 3235 # ID and second value as reference to a list containing its successor connected vertices. 3236 # 3237 # For a neighborhood vertex at each radius level, the successor connected vertices correspond to the 3238 # neighborhood vertices at the next radius level. Consequently, the neighborhood vertices at the last 3239 # radius level don't contain any successor vertices which fall outside the range of specified radius. 3240 # 3241 sub GetNeighborhoodVerticesWithSuccessors { 3242 my($This, $StartVertexID) = @_; 3243 my($PathsTraversal); 3244 3245 $PathsTraversal = new Graph::PathsTraversal($This); 3246 $PathsTraversal->PerformNeighborhoodVerticesSearchWithSuccessors($StartVertexID); 3247 3248 return $PathsTraversal->GetVerticesNeighborhoodsWithSuccessors(); 3249 } 3250 3251 # Get adjacency matrix for the graph as a Matrix object with row and column indices 3252 # corresponding to graph vertices returned by GetVertices method. 3253 # 3254 # For a simple graph G with n vertices, the adjacency matrix for G is a n x n square matrix and 3255 # its elements Mij are: 3256 # 3257 # . 0 if i == j 3258 # . 1 if i != j and vertex Vi is adjacent to vertex Vj 3259 # . 0 if i != j and vertex Vi is not adjacent to vertex Vj 3260 # 3261 sub GetAdjacencyMatrix { 3262 my($This) = @_; 3263 my($GraphMatrix); 3264 3265 $GraphMatrix = new Graph::GraphMatrix($This); 3266 $GraphMatrix->GenerateAdjacencyMatrix(); 3267 3268 return $GraphMatrix->GetMatrix(); 3269 } 3270 3271 # Get Siedel adjacency matrix for the graph as a Matrix object with row and column indices 3272 # corresponding to graph vertices returned by GetVertices method. 3273 # 3274 # For a simple graph G with n vertices, the Siedal adjacency matrix for G is a n x n square matrix and 3275 # its elements Mij are: 3276 # 3277 # . 0 if i == j 3278 # . -1 if i != j and vertex Vi is adjacent to vertex Vj 3279 # . 1 if i != j and vertex Vi is not adjacent to vertex Vj 3280 # 3281 sub GetSiedelAdjacencyMatrix { 3282 my($This) = @_; 3283 my($GraphMatrix); 3284 3285 $GraphMatrix = new Graph::GraphMatrix($This); 3286 $GraphMatrix->GenerateSiedelAdjacencyMatrix(); 3287 3288 return $GraphMatrix->GetMatrix(); 3289 } 3290 3291 # Get distance matrix for the graph as a Matrix object with row and column indices 3292 # corresponding to graph vertices returned by GetVertices method. 3293 # 3294 # For a simple graph G with n vertices, the distance matrix for G is a n x n square matrix and 3295 # its elements Mij are: 3296 # 3297 # . 0 if i == j 3298 # . d if i != j and d is the shortest distance between vertex Vi and vertex Vj 3299 # 3300 # Note: 3301 # . In the final matrix, BigNumber values correspond to vertices with no edges. 3302 # 3303 sub GetDistanceMatrix { 3304 my($This) = @_; 3305 my($GraphMatrix); 3306 3307 $GraphMatrix = new Graph::GraphMatrix($This); 3308 $GraphMatrix->GenerateDistanceMatrix(); 3309 3310 return $GraphMatrix->GetMatrix(); 3311 } 3312 3313 # Get incidence matrix for the graph as a Matrix object with row and column indices 3314 # corresponding to graph vertices and edges returned by GetVertices and GetEdges 3315 # methods respectively. 3316 # 3317 # For a simple graph G with n vertices and e edges, the incidence matrix for G is a n x e matrix 3318 # its elements Mij are: 3319 # 3320 # . 1 if vertex Vi and the edge Ej are incident; in other words, Vi and Ej are related 3321 # . 0 otherwise 3322 # 3323 sub GetIncidenceMatrix { 3324 my($This) = @_; 3325 my($GraphMatrix); 3326 3327 $GraphMatrix = new Graph::GraphMatrix($This); 3328 $GraphMatrix->GenerateIncidenceMatrix(); 3329 3330 return $GraphMatrix->GetMatrix(); 3331 } 3332 3333 # Get degree matrix for the graph as a Matrix object with row and column indices 3334 # corresponding to graph vertices returned by GetVertices method. 3335 # 3336 # For a simple graph G with n vertices, the degree matrix for G is a n x n square matrix and 3337 # its elements Mij are: 3338 # 3339 # . deg(Vi) if i == j and deg(Vi) is the degree of vertex Vi 3340 # . 0 otherwise 3341 # 3342 sub GetDegreeMatrix { 3343 my($This) = @_; 3344 my($GraphMatrix); 3345 3346 $GraphMatrix = new Graph::GraphMatrix($This); 3347 $GraphMatrix->GenerateDegreeMatrix(); 3348 3349 return $GraphMatrix->GetMatrix(); 3350 } 3351 3352 # Get Laplacian matrix for the graph as a Matrix object with row and column indices 3353 # corresponding to graph vertices returned by GetVertices method. 3354 # 3355 # For a simple graph G with n vertices, the Laplacian matrix for G is a n x n square matrix and 3356 # its elements Mij are: 3357 # 3358 # . deg(Vi) if i == j and deg(Vi) is the degree of vertex Vi 3359 # . -1 if i != j and vertex Vi is adjacent to vertex Vj 3360 # . 0 otherwise 3361 # 3362 # Note: The Laplacian matrix is the difference between the degree matrix and adjacency matrix. 3363 # 3364 sub GetLaplacianMatrix { 3365 my($This) = @_; 3366 my($GraphMatrix); 3367 3368 $GraphMatrix = new Graph::GraphMatrix($This); 3369 $GraphMatrix->GenerateLaplacianMatrix(); 3370 3371 return $GraphMatrix->GetMatrix(); 3372 } 3373 3374 # Get normalized Laplacian matrix for the graph as a Matrix object with row and column indices 3375 # corresponding to graph vertices returned by GetVertices method. 3376 # 3377 # For a simple graph G with n vertices, the normalized Laplacian matrix L for G is a n x n square matrix and 3378 # its elements Lij are: 3379 # 3380 # . 1 if i == j and deg(Vi) != 0 3381 # . -1/SQRT(deg(Vi) * deg(Vj)) if i != j and vertex Vi is adjacent to vertex Vj 3382 # . 0 otherwise 3383 # 3384 # 3385 sub GetNormalizedLaplacianMatrix { 3386 my($This) = @_; 3387 my($GraphMatrix); 3388 3389 $GraphMatrix = new Graph::GraphMatrix($This); 3390 $GraphMatrix->GenerateNormalizedLaplacianMatrix(); 3391 3392 return $GraphMatrix->GetMatrix(); 3393 } 3394 3395 # Get admittance matrix for the graph as a Matrix object with row and column indices 3396 # corresponding to graph vertices returned by GetVertices method. 3397 # 3398 sub GetAdmittanceMatrix { 3399 my($This) = @_; 3400 3401 return $This->GetLaplacianMatrix(); 3402 } 3403 3404 # Get Kirchhoff matrix for the graph as a Matrix object with row and column indices 3405 # corresponding to graph vertices returned by GetVertices method. 3406 # 3407 sub GetKirchhoffMatrix { 3408 my($This) = @_; 3409 3410 return $This->GetLaplacianMatrix(); 3411 } 3412