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   68923 use strict;
  7         25  
  7         241  
4 7     7   38 use warnings;
  7         16  
  7         4655  
5              
6             sub _PARENT () { 0 }
7             sub _RANK () { 1 }
8              
9             sub new {
10 30     30 1 176 my $class = shift;
11 30         96 bless { }, $class;
12             }
13              
14             sub add {
15 497     497 1 1075 my ($self, @elems) = @_;
16 497         1488 @elems = grep !defined $self->{$_}, @elems;
17 497         1440 @$self{ @elems } = map [ $_, 0 ], @elems;
18             }
19              
20             sub _parent {
21 18323 50   18323   28194 return undef unless defined $_[1];
22 18323 50 33     46349 Graph::__carp_confess(__PACKAGE__ . "::_parent: bad arity") if @_ < 2 or @_ > 3;
23 18323 100       27355 if (@_ == 2) {
24 14739 100       39888 exists $_[0]->{ $_[ 1 ] } ? $_[0]->{ $_[1] }->[ _PARENT ] : undef;
25             } else {
26 3584         6297 $_[0]->{ $_[1] }->[ _PARENT ] = $_[2];
27             }
28             }
29              
30             sub _rank {
31 987 50   987   1696 return unless defined $_[1];
32 987 50 33     2601 Graph::__carp_confess(__PACKAGE__ . "::_rank: bad arity") if @_ < 2 or @_ > 3;
33 987 100       1498 if (@_ == 2) {
34 948 50       1943 exists $_[0]->{ $_[1] } ? $_[0]->{ $_[1] }->[ _RANK ] : undef;
35             } else {
36 39         142 $_[0]->{ $_[1] }->[ _RANK ] = $_[2];
37             }
38             }
39              
40             sub find {
41 5244     5244 1 8998 my ($self, @v) = @_;
42 5244         6092 my @ret;
43 5244         7099 for my $x (@v) {
44 7371 100       11080 push(@ret, undef), next unless defined(my $px = $self->_parent($x));
45 7368 100       14222 $self->_parent( $x, $self->find( $px ) ) if $px ne $x;
46 7368         11614 push @ret, $self->_parent( $x );
47             }
48 5244         13915 @ret;
49             }
50              
51             sub union {
52 465     465 1 781 my ($self, @edges) = @_;
53 465         1412 $self->add(map @$_, @edges);
54 465         807 for my $e (@edges) {
55 490         846 my ($px, $py) = $self->find( @$e );
56 490 100       995 next if $px eq $py;
57 474         795 my $rx = $self->_rank( $px );
58 474         892 my $ry = $self->_rank( $py );
59             # print "union($x, $y): px = $px, py = $py, rx = $rx, ry = $ry\n";
60 474 100       820 if ( $rx > $ry ) {
61 416         703 $self->_parent( $py, $px );
62             } else {
63 58         189 $self->_parent( $px, $py );
64 58 100       208 $self->_rank( $py, $ry + 1 ) if $rx == $ry;
65             }
66             }
67             }
68              
69             sub same {
70 1616     1616 1 2498 my ($uf, $u, $v) = @_;
71 1616         2537 my ($fu, $fv) = $uf->find($u, $v);
72 1616 100       4052 return undef if grep !defined, $fu, $fv;
73 1615         4516 $fu eq $fv;
74             }
75              
76             1;
77             __END__