#!/usr/bin/perl

# _strongly_connected
#
#       $s = $G->_strongly_connected
#
#       (INTERNAL USE ONLY)
#       Returns a graph traversal object that can be used for
#       strong connection computations.
#
#
sub _strongly_connected {
    my $G = shift;
    my $T = $G->transpose;

    Graph::DFS->
        new($T,
            # Pick the potential roots in their DFS postorder.
            strong_root_order => [ Graph::DFS->new($T)->postorder ],
            get_next_root     =>
                sub {
                      my ($T, %param) = @_;

                      while (my $root =
                             shift @{ $param{ strong_root_order } }) {
                          return $root if exists $T->{ pool }->{ $root };
                    }
                }
           );
}

# strongly_connected_components
#
#       @S = $G->strongly_connected_components
#
#       Returns the strongly connected components @S of the graph $G
#       as a list of anonymous lists of vertices, each anonymous list
#       containing the vertices belonging to one strongly connected
#       component.
#
sub strongly_connected_components {
    my $G = shift;
    my $T = $G->_strongly_connected;
    my %R = $T->vertex_roots;
    my @C;

    # Clump together vertices having identical root vertices.
    while (my ($v, $r) = each %R) { push @{ $C[$r] }, $v }

    return @C;
}

# strongly_connected_graph
#
#       $T = $G->strongly_connected_graph
#
#       Returns the strongly connected graph $T of the graph $G.
#       The names of the strongly connected components are
#       formed from their constituent vertices by concatenating
#       their names by '+'-characters: "a" and "b" --> "a+b".
#
sub strongly_connected_graph {
    my $G = shift;
    my $C = (ref $G)->new;
    my $T = $G->_strongly_connected;
    my %R = $T->vertex_roots;
    my @C; # We're not calling the strongly_connected_components()
           # method because we will need also the %R.

    # Create the strongly connected components.
    while (my ($v, $r) = each %R) { push @{ $C[$r] }, $v }
    foreach my $c (@C)            { $c = join("+", @$c)  }

    $C->directed( $G->directed );

    my @E = $G->edges;

    # Copy the edges between strongly connected components.
    while (my ($u, $v) = splice(@E, 0, 2)) {
        $C->add_edge( $C[ $R{ $u } ], $C[ $R{ $v } ] )
            unless $R{ $u } == $R{ $v };
    }

    return $C;
}

use Graph::Directed;

my $g = Graph::Directed->new();
$g->add_edges(qw(a b  a c  b c  c e  c d  d a  d g
                 e f  f e  f i  g h  h i  i g));

print $g->strongly_connected_graph, "\n";