File Coverage

blib/lib/Graph/UnionFind.pm
Criterion Covered Total %
statement 43 43 100.0
branch 23 28 82.1
condition 2 6 33.3
subroutine 9 9 100.0
pod 5 5 100.0
total 82 91 90.1


line stmt bran cond sub pod time code
1             package Graph::UnionFind;
2              
3 7     7   65930 use strict;
  7         32  
  7         252  
4 7     7   37 use warnings;
  7         14  
  7         4650  
5              
6             sub _PARENT () { 0 }
7             sub _RANK () { 1 }
8              
9             sub new {
10 30     30 1 152 my $class = shift;
11 30         81 bless { }, $class;
12             }
13              
14             sub add {
15 497     497 1 1087 my ($self, @elems) = @_;
16 497         1426 @elems = grep !defined $self->{$_}, @elems;
17 497         1507 @$self{ @elems } = map [ $_, 0 ], @elems;
18             }
19              
20             sub _parent {
21 18362 50   18362   29002 return undef unless defined $_[1];
22 18362 50 33     48845 Graph::__carp_confess(__PACKAGE__ . "::_parent: bad arity") if @_ < 2 or @_ > 3;
23 18362 100       27310 if (@_ == 2) {
24 14765 100       40268 exists $_[0]->{ $_[ 1 ] } ? $_[0]->{ $_[1] }->[ _PARENT ] : undef;
25             } else {
26 3597         6355 $_[0]->{ $_[1] }->[ _PARENT ] = $_[2];
27             }
28             }
29              
30             sub _rank {
31 987 50   987   1642 return unless defined $_[1];
32 987 50 33     2679 Graph::__carp_confess(__PACKAGE__ . "::_rank: bad arity") if @_ < 2 or @_ > 3;
33 987 100       1579 if (@_ == 2) {
34 948 50       1936 exists $_[0]->{ $_[1] } ? $_[0]->{ $_[1] }->[ _RANK ] : undef;
35             } else {
36 39         128 $_[0]->{ $_[1] }->[ _RANK ] = $_[2];
37             }
38             }
39              
40             sub find {
41 5257     5257 1 9190 my ($self, @v) = @_;
42 5257         6270 my @ret;
43 5257         7140 for my $x (@v) {
44 7384 100       10660 push(@ret, undef), next unless defined(my $px = $self->_parent($x));
45 7381 100       14398 $self->_parent( $x, $self->find( $px ) ) if $px ne $x;
46 7381         11689 push @ret, $self->_parent( $x );
47             }
48 5257         13378 @ret;
49             }
50              
51             sub union {
52 465     465 1 716 my ($self, @edges) = @_;
53 465         1543 $self->add(map @$_, @edges);
54 465         773 for my $e (@edges) {
55 490         820 my ($px, $py) = $self->find( @$e );
56 490 100       1007 next if $px eq $py;
57 474         755 my $rx = $self->_rank( $px );
58 474         800 my $ry = $self->_rank( $py );
59             # print "union($x, $y): px = $px, py = $py, rx = $rx, ry = $ry\n";
60 474 100       804 if ( $rx > $ry ) {
61 416         637 $self->_parent( $py, $px );
62             } else {
63 58         156 $self->_parent( $px, $py );
64 58 100       178 $self->_rank( $py, $ry + 1 ) if $rx == $ry;
65             }
66             }
67             }
68              
69             sub same {
70 1616     1616 1 2445 my ($uf, $u, $v) = @_;
71 1616         2614 my ($fu, $fv) = $uf->find($u, $v);
72 1616 100       4018 return undef if grep !defined, $fu, $fv;
73 1615         4388 $fu eq $fv;
74             }
75              
76             1;
77             __END__