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   61986 use strict;
  7         20  
  7         238  
4 7     7   34 use warnings;
  7         11  
  7         3996  
5              
6             sub _PARENT () { 0 }
7             sub _RANK () { 1 }
8              
9             sub new {
10 30     30 1 122 my $class = shift;
11 30         86 bless { }, $class;
12             }
13              
14             sub add {
15 497     497 1 1002 my ($self, @elems) = @_;
16 497         1189 @elems = grep !defined $self->{$_}, @elems;
17 497         1321 @$self{ @elems } = map [ $_, 0 ], @elems;
18             }
19              
20             sub _parent {
21 18031 50   18031   23193 return undef unless defined $_[1];
22 18031 50 33     37838 Graph::__carp_confess(__PACKAGE__ . "::_parent: bad arity") if @_ < 2 or @_ > 3;
23 18031 100       22046 if (@_ == 2) {
24 14503 100       40644 exists $_[0]->{ $_[ 1 ] } ? $_[0]->{ $_[1] }->[ _PARENT ] : undef;
25             } else {
26 3528         5162 $_[0]->{ $_[1] }->[ _PARENT ] = $_[2];
27             }
28             }
29              
30             sub _rank {
31 987 50   987   1329 return unless defined $_[1];
32 987 50 33     2158 Graph::__carp_confess(__PACKAGE__ . "::_rank: bad arity") if @_ < 2 or @_ > 3;
33 987 100       1305 if (@_ == 2) {
34 948 50       1791 exists $_[0]->{ $_[1] } ? $_[0]->{ $_[1] }->[ _RANK ] : undef;
35             } else {
36 39         127 $_[0]->{ $_[1] }->[ _RANK ] = $_[2];
37             }
38             }
39              
40             sub find {
41 5157     5157 1 7135 my ($self, @v) = @_;
42 5157         5002 my @ret;
43 5157         5814 for my $x (@v) {
44 7253 100       8555 push(@ret, undef), next unless defined(my $px = $self->_parent($x));
45 7250 100       11689 $self->_parent( $x, $self->find( $px ) ) if $px ne $x;
46 7250         9455 push @ret, $self->_parent( $x );
47             }
48 5157         10878 @ret;
49             }
50              
51             sub union {
52 465     465 1 678 my ($self, @edges) = @_;
53 465         1170 $self->add(map @$_, @edges);
54 465         657 for my $e (@edges) {
55 490         728 my ($px, $py) = $self->find( @$e );
56 490 100       770 next if $px eq $py;
57 474         622 my $rx = $self->_rank( $px );
58 474         679 my $ry = $self->_rank( $py );
59             # print "union($x, $y): px = $px, py = $py, rx = $rx, ry = $ry\n";
60 474 100       622 if ( $rx > $ry ) {
61 416         540 $self->_parent( $py, $px );
62             } else {
63 58         195 $self->_parent( $px, $py );
64 58 100       159 $self->_rank( $py, $ry + 1 ) if $rx == $ry;
65             }
66             }
67             }
68              
69             sub same {
70 1585     1585 1 1986 my ($uf, $u, $v) = @_;
71 1585         2025 my ($fu, $fv) = $uf->find($u, $v);
72 1585 100       3343 return undef if grep !defined, $fu, $fv;
73 1584         3687 $fu eq $fv;
74             }
75              
76             1;
77             __END__