use strict; use warnings; my %pairs; while () { chomp; next if ! length; my @pair = sort split; ++$pairs{$pair[0]}{$pair[1]}; } for my $first (sort keys %pairs) { my @hits; my $count = 0; my @implied; for my $second (keys %{$pairs{$first}}) { next if $pairs{$first}{$second} < 2; push @implied, $second; ++$count; if (exists $pairs{$second}{$first}) { delete $pairs{$second}{$first}; ++$count; } print "$first $second\n"; } next if ! $count; @implied = sort @implied; if (@implied == 2 && $pairs{$implied[0]}{$implied[1]}) { ++$count; delete $pairs{$implied[0]}{$implied[1]}; @implied = (); } print "$count"; print " [not present in @implied]" if @implied == 2; print "\n\n" } __DATA__ AP_01 AP_02 AP_02 AP_01 AP_01 AP_03 AP_03 AP_01 NP_01 NP_02 NP_02 NP_01 NP_01 NP_03 NP_03 NP_01 NP_02 NP_03 NP_03 NP_02 NP_04 NP_05 NP_06 NP_07 NP_07 NP_06 #### AP_01 AP_02 AP_01 AP_03 2 [not present in AP_02 AP_03] NP_01 NP_03 NP_01 NP_02 3 NP_06 NP_07 1