#! perl -slw use strict; use Data::Dump qw[ pp ]; my %names = map{ my( $name, $rest ) = split; $name, { map{ $_, undef } split ',', $rest }; } ; my @sortedKeys = sort keys %names; print "\t", join "\t", @sortedKeys; for my $i ( @sortedKeys ) { printf "%s\t", $i; for my $j ( @sortedKeys ) { my $nCitiesI = keys %{ $names{ $i } }; my $nMatchingCitiesJ = grep{ exists $names{ $j }{ $_ } } keys %{ $names{ $i } }; printf "%d\t", $nCitiesI - $nMatchingCitiesJ; } print ''; } __DATA__ Name1 USA,Canada,Yemen Name2 Canada,Portugal,India Name3 China,HongKong,Canada Name4 London,Amsterdam,Ireland,USA Name5 India,USA,Canada