home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / Directed.pm < prev    next >
Encoding:
Perl POD Document  |  1999-08-18  |  1.7 KB  |  100 lines
  1. package Graph::Directed;
  2.  
  3. use strict;
  4. local $^W = 1;
  5.  
  6. use Graph::Base;
  7.  
  8. use vars qw(@ISA);
  9. @ISA = qw(Graph::Base);
  10.  
  11. use overload '""' => \&stringify;
  12.  
  13. =head1 NAME
  14.  
  15. Graph::Directed - directed graphs
  16.  
  17. =head1 SYNOPSIS
  18.  
  19.     use Graph::Directed;
  20.  
  21.     $g = new Graph::Directed;
  22.  
  23. =head1 DESCRIPTION
  24.  
  25. See Graph::Base for the available methods.
  26.  
  27. =head1 COPYRIGHT
  28.  
  29. Copyright 1999, O'Reilly & Associates.
  30.  
  31. This code is distributed under the same copyright terms as Perl itself.
  32.  
  33. =cut
  34.  
  35. # new
  36. #
  37. #    $D = Graph::Directed->new(@V)
  38. #
  39. #    The Constructor.  Returns a new directed graph $D, possibly
  40. #    populated with the optional initial vertices @V.
  41. #
  42. sub new {
  43.     my $class = shift;
  44.  
  45.     my $G = Graph::Base->new(@_);
  46.  
  47.     bless $G, $class;
  48.  
  49.     $G->directed(1);
  50.  
  51.     return $G;
  52. }
  53.  
  54. # _edges
  55. #
  56. #    @e = $G->_edges($u, $v)
  57. #
  58. #    (INTERNAL USE ONLY)
  59. #    Both vertices undefined:
  60. #        returns all the edges of the graph.
  61. #    Both vertices defined:
  62. #        returns all the edges between the vertices.
  63. #    Only 1st vertex defined:
  64. #        returns all the edges leading out of the vertex.
  65. #    Only 2nd vertex defined:
  66. #        returns all the edges leading into the vertex.
  67. #    Edges @e are returned as ($start_vertex, $end_vertex) pairs.
  68. #
  69. sub _edges {
  70.     my ($G, $u, $v) = @_;
  71.     my @e;
  72.  
  73.     if (defined $u and defined $v) {
  74.     @e = ($u, $v)
  75.         if exists $G->{ Succ }->{ $u }->{ $v };
  76.     } elsif (defined $u) {
  77.     foreach $v ($G->successors($u)) {
  78.         push @e, $G->_edges($u, $v);
  79.     }
  80.     } elsif (defined $v) {    # not defined $u and defined $v
  81.     foreach $u ($G->predecessors($v)) {
  82.         push @e, $G->_edges($u, $v);
  83.     }
  84.     } else {             # not defined $u and not defined $v
  85.     foreach $u ($G->vertices) {
  86.         push @e, $G->_edges($u);
  87.     }
  88.     }
  89.  
  90.     return @e;
  91. }
  92.  
  93. sub stringify {
  94.     my $G = shift;
  95.  
  96.     return $G->_stringify("-", ",");
  97. }
  98.  
  99. 1;
  100.