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