File Coverage

blib/lib/Algorithm/EquivalenceSets.pm

Criterion	Covered	Total	%
statement	34	34	100.0
branch	4	6	66.6
condition			n/a
subroutine	6	6	100.0
pod	1	1	100.0
total	45	47	95.7

use 5.006;
use strict;
use warnings;

package Algorithm::EquivalenceSets;
BEGIN {
  $Algorithm::EquivalenceSets::VERSION = '1.101420';
}

# ABSTRACT: Group sets transitively
use Exporter qw(import);
our @EXPORT = qw(equivalence_sets);

sub equivalence_sets {
    my $item_list  = shift;
    my $next_group = 1;
    my %group;     # key = item, value = group this item belongs to
    my %member;    # key = group name, value = list of items in this group
    for my $item_def (@$item_list) {

        # flatten item aliases
        my @alias = map { ref eq 'ARRAY' ? @$_ : $_ } @$item_def;
        my %seen_group;

        # known groups that these aliases belong to
        my @group =
          grep { !$seen_group{$_}++ }
          map { $group{$_} || () } @alias;

        # unify the groups listed in @group by dissolving them and adding
        # their members to the aliases, then forming a new group from the
        # aliases
        push @alias, map { @{ $member{$_} } } @group;
        my %seen_member;
        @alias = grep { !$seen_member{$_}++ } @alias;
        delete @member{@group};
        my $new_group = $next_group++;
        $group{$_} = $new_group for @alias;
        $member{$new_group} = \@alias;
    }
    wantarray ? values %member : [ values %member ];
}
1;


__END__