https://codeiq.jp/challenge.php?challenge_id=171

gistfile1.pl

#!/usr/bin/env perl

use strict;
use warnings;
use List::MoreUtils qw(uniq);

my %bucket;

while (<>) {
  tr/\r\n//d;
	my @member = split /=/;
	my $boss = (sort { $a cmp $b } @member)[0];
	$bucket{$boss} = [ uniq @{$bucket{$boss} || []}, @member ];
}

while (1) {
	my @original_bosses = keys %bucket;
	foreach my $boss_a (@original_bosses) {
		next unless exists $bucket{$boss_a};
		my @member_a = @{$bucket{$boss_a}};
		foreach my $boss_b (@original_bosses) {
			next unless exists $bucket{$boss_b};
			next if $boss_a eq $boss_b;
			my @member_b = @{$bucket{$boss_b}};
			my @member_ab = uniq @member_a, @member_b;	# a or b
			if (@member_a + @member_b > @member_ab) {
				my($winner, $loser) = sort { $a cmp $b } ($boss_a, $boss_b);
				$bucket{$winner} = \@member_ab;
				delete $bucket{$loser};
				last;
			}
		}
	}
	last if @original_bosses == scalar keys %bucket;
}

foreach my $boss (sort { $a cmp $b } keys %bucket) {
	my @member = sort @{$bucket{$boss}};
	print join('=', @member), "\n";
}

print "\n";
open my $ANSWER, '<:utf8', $0 or die $!;
print while <$ANSWER>;
close $ANSWER;

=encoding utf-8

=head1 NAME

answer.pl - a solution of L<CodeIQ|https://codeiq.jp/challenge.php?challenge_id=171> question by hyuki.

=head1 SYNOPSIS

  answer.pl < nick.txt > answer.txt

=head1 DEPENDENCIES

L<List::MoreUtils|http://search.cpan.org/~adamk/List-MoreUtils-0.33/>

=head1 AUTHOR

Shinsuke Ogawa

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2013, Shinsuke Ogawa.

This program is free software, you can redistribute it and/or modify it under
the terms of the Artistic License version 2.0.

=cut