#!/usr/bin/perl -l use strict; use warnings; no warnings qw/uninitialized/; for ( [ "1,7", "2,6", "2,7", "5,4", "6,7" ], [ "1,7", "2,6", "2,7", "3,4", "6,7" ], [ "1,7", "2,6", "2,7", "3,4", "9,8" ], [ "a,b", "c,b", "d,f", "e,b", "f,g" ], ) { my @pairs = @$_; my $count = 0; my %sets; my %sets2; for my $p (@pairs) { my ($l, $r) = split /\s*,\s*/, $p; # print "P = $p, L = $l, R = $r, \$sets{\$l} = $sets{$l}, \$sets{\$r} = $sets{$r}"; if ($sets{$l} and $sets{$r} and $sets{$l} != $sets{$r}) { # $sets{$l} and $sets{$r} can now be linked my $old_set = $sets{$r}; for my $s (keys %sets) { if ($sets{$s} == $old_set) { if (exists $sets2{ $sets{$s} }) { push @{ $sets2{ $sets{$l} } }, @{ $sets2{ $sets{$s} } }; delete $sets2{ $old_set }; } $sets{$s} = $sets{$l}; } } } elsif ($sets{$l}) { $sets{$r} = $sets{$l}; } elsif ($sets{$r}) { $sets{$l} = $sets{$r}; } else { $count++; $sets{$l} = $sets{$r} = $count; } push @{ $sets2{ $sets{$l} } }, $p; } print "SETS FOR: " . join(", ", @pairs); my $i = 0; for my $key (keys %sets2) { print "\tSET $i: " . join(", ", @{ $sets2{ $key} }); $i++; } print ""; } __END__ Output: SETS FOR: 1,7, 2,6, 2,7, 5,4, 6,7 SET 0: 5,4 SET 1: 2,6, 1,7, 2,7, 6,7 SETS FOR: 1,7, 2,6, 2,7, 3,4, 6,7 SET 0: 3,4 SET 1: 2,6, 1,7, 2,7, 6,7 SETS FOR: 1,7, 2,6, 2,7, 3,4, 9,8 SET 0: 9,8 SET 1: 3,4 SET 2: 2,6, 1,7, 2,7 SETS FOR: a,b, c,b, d,f, e,b, f,g SET 0: a,b, c,b, e,b SET 1: d,f, f,g