File Coverage

blib/lib/Graph/BitMatrix.pm

Criterion	Covered	Total	%
statement	62	62	100.0
branch	16	22	72.7
condition			n/a
subroutine	13	13	100.0
pod	8	9	88.8
total	99	106	93.4

package Graph::BitMatrix;

use strict;
use warnings;

# $SIG{__DIE__ } = \&Graph::__carp_confess;
# $SIG{__WARN__} = \&Graph::__carp_confess;

sub _E () { 3 } # Graph::_E()
sub _i () { 3 } # Index to path.

sub new {
    my ($class, $g, %opt) = @_;
    my @V = $g->vertices;
    my $V = @V;
    my $Z = "\0" x (($V + 7) / 8);
    my %V; @V{ @V } = 0 .. $#V;
    my $bm = bless [ [ ( $Z ) x $V ], \%V ], $class;
    my $bm0 = $bm->[0];
    my $connect_edges = delete $opt{connect_edges};
    $connect_edges = 1 unless defined $connect_edges;
    my $transpose = delete $opt{transpose};
    Graph::_opt_unknown(\%opt);
    return $bm if !$connect_edges;
    # for (my $i = 0; $i <= $#V; $i++) {
    #    my $u = $V[$i];
    #    for (my $j = 0; $j <= $#V; $j++) {
    #	vec($bm0->[$i], $j, 1) = 1 if $g->has_edge($u, $V[$j]);
    #    }
    # }
    my $undirected = $g->is_undirected;
    for my $e ($g->edges) {
	my ($i0, $j0) = map $V{$_}, @$e;
	($j0, $i0) = ($i0, $j0) if $transpose;
	vec($bm0->[$i0], $j0, 1) = 1;
	vec($bm0->[$j0], $i0, 1) = 1 if $undirected;
    }
    $bm;
}

sub stringify {
    my ($m) = @_;
    my @V = sort keys %{ $m->[1] };
    my $top = join ' ', map sprintf('%4s', $_), 'to:', @V;
    my @indices = map $m->[1]{$_}, @V;
    my @rows;
    for my $n (@V) {
        my @vals = $m->get_row($n, @V);
        push @rows, join ' ', map sprintf('%4s', defined()?$_:''), $n, @vals;
    }
    join '', map "$_\n", $top, @rows;
}

sub set { push @_, 1; goto &_get_set }
sub unset { push @_, 0; goto &_get_set }
sub get { push @_, undef; goto &_get_set }
sub _get_set {
    my $val = pop;
    my ($m, $u, $v) = @_;
    my ($m0, $m1) = @$m[0, 1];
    return if grep !defined, my ($i, $j) = @$m1{ $u, $v };
    defined $val ? vec($m0->[$i], $j, 1) = $val : vec($m0->[$i], $j, 1);
}

sub _set_row {
    my $val = pop;
    my ($m, $u) = splice @_, 0, 2;
    my ($m0, $m1) = @$m[0, 1];
    return unless defined(my $i = $m1->{ $u });
    vec($m0->[$i], $_, 1) = $val for grep defined, @$m1{ @_ };
}
sub set_row { push @_, 1; goto &_set_row }
sub unset_row { push @_, 0; goto &_set_row }

sub get_row {
    my ($m, $u) = splice @_, 0, 2;
    my ($m0, $m1) = @$m[0, 1];
    return () x @_ unless defined(my $i = $m1->{ $u });
    map defined() ? (vec($m0->[$i], $_, 1) ? 1 : 0) : undef, @$m1{ @_ };
}

sub vertices {
    keys %{ $_[0]->[1] };
}

1;
__END__