view release on metacpan or  search on metacpan

lib/Algorithm/TSort.pm  view on Meta::CPAN

# Preloaded methods go here.
sub tsort($;@) {
    my $object = shift;
    my @nodes  = @_;
    my @sorted;
    my %seen;
    my $req_sub;
    my $guard;
    unless (@nodes) {
        if ( UNIVERSAL::can( $object, 'nodes') ) {
            @nodes = $object->nodes();
        }
        else {
            require Carp;
            Carp::croak("tsort: no nodes for sort");
        }
    }
    $guard = Algorithm::TSort::Guard->new(sub {
	$req_sub = undef; # remove circular dependency;
    });


    $req_sub = sub {
        my $node = shift;
        if ( $seen{$node} ) {
            die "Algorithm::TSort - can't tsort cicle detected" if ( $seen{$node} == 1 );
            return;
        }
        $seen{$node} = 1;
        for ( $object->adj_nodes($node) ) {
            $req_sub->($_);
        }
        $seen{$node} = 2;
        push @sorted, $node;
    };

    for (@nodes) {
        next if $seen{$_};
        $req_sub->($_);
    }
    return reverse @sorted;
}

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Algorithm::TSort - Perl extension for topological sort

=head1 SYNOPSIS

  use Algorithm::TSort;

  
  #  $adj = { 1 => [ 2, 3], 2 => [4], 3 => [4]  } ;
  my (@sorted ) = tsort( Graph( ADJ => $adj ). keys %$adj ); 
  say for @sorted; 

  # -- OR --
	
  # $adj_sub = sub { return unless $adj->{ $_[0] } ; return @{$adj->{$_[0]}}; };
  my (@sorted) = tsort( Graph( ADJSUB => $adj_sub ), @nodes_for_sort );

  # -- OR --
	
  # $sub_arrayref = sub { $adj->{ $_[0] } };
  my (@sorted) = tsort( Graph( ADJSUB_ARRAYREF => $adj_sub ), @nodes_for_sort );

  # -- OR --

  # $buf  = 
  #  "1 2 3
  #   2 4
  #   3 4";
  
  my (@sorted) = tsort( Graph ( SCALAR => $buf )); 


  # -- OR --
  #

  my (@sorted) = tsort( Graph ( IO => \*STDIN) );
  print "$_\n" for @sorted;

  # -- OR --
  
  # Write your own class for graph with 'adj_nodes' method
  # my $graph = MyGraph->new;
  # # Initialization ...

  my (@sorted ) = tsort( $graph, @nodes_for_sort );


=head1 DESCRIPTION

Topological sort for varing inputs

=head2 EXPORT

Graph, tsort

=head1 SEE ALSO

L<Sort::Topological>, L<Graph>

=head1 AUTHOR

A. G. Grishaev, E<lt>grian@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2016 by A. G. Grishaev

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.1 or,
at your option, any later version of Perl 5 you may have available.