File Coverage

blib/lib/Graph/TransitiveClosure.pm

Criterion	Covered	Total	%
statement	36	36	100.0
branch	13	14	92.8
condition	4	6	66.6
subroutine	8	8	100.0
pod	3	3	100.0
total	64	67	95.5

package Graph::TransitiveClosure;

use strict;
use warnings;

# COMMENT THESE OUT FOR TESTING AND PRODUCTION.
# $SIG{__DIE__ } = \&Graph::__carp_confess;
# $SIG{__WARN__} = \&Graph::__carp_confess;

use base 'Graph';
use Graph::TransitiveClosure::Matrix;

sub _G () { Graph::_G() }

sub new {
    my ($class, $g, %opt) = @_;
    Graph::__carp_confess(__PACKAGE__."->new given non-Graph '$g'")
	if !(ref $g and $g->isa('Graph'));
    %opt = (path_vertices => 1) unless %opt;
    # No delete $opt{ attribute_name } since we need to pass it on.
    my $attr = exists $opt{ attribute_name } ? $opt{ attribute_name } : Graph::_defattr();
    $opt{ reflexive } = 1 unless exists $opt{ reflexive };
    my $tcg = $g->new(
	multiedged => 0,
	($opt{ reflexive } ? (vertices => [$g->vertices]) : ()),
    );
    my $tcm = $g->_check_cache('transitive_closure_matrix', [],
	\&_transitive_closure_matrix_compute, %opt);
    my $tcm00 = $tcm->[0][0]; # 0=am, 0=bitmatrix
    my $tcm01 = $tcm->[0][1]; #     , 1=hash mapping v-name to the offset into dm data structures (in retval of $g->vertices)
    my @edges;
    for my $u ($tcm->vertices) {
	my $tcm00i = $tcm00->[ $tcm01->{ $u } ];
	for my $v ($tcm->vertices) {
	    next if $u eq $v && ! $opt{ reflexive };
	    my $j = $tcm01->{ $v };
	    push @edges, [$u, $v] if vec($tcm00i, $j, 1);
				      # $tcm->is_transitive($u, $v)
				      # $tcm->[0]->get($u, $v)
	}
    }
    $tcg->add_edges(@edges);
    $tcg->set_graph_attribute('_tcm', [ $g->[ _G ], $tcm ]);
    bless $tcg, $class;
}

sub _transitive_closure_matrix_compute {
    Graph::TransitiveClosure::Matrix->new(@_);
}

sub is_transitive {
    my $g = shift;
    $g->expect_no_args(@_);
    Graph::TransitiveClosure::Matrix::is_transitive($g);
}

sub transitive_closure_matrix {
    $_[0]->get_graph_attribute('_tcm')->[1];
}

1;
__END__