use strict;
use warnings;

MAIN: {

    my @names = <DATA>;
    chomp @names;
    my $initref = &DistinctInitials( @names );

    # Sorted by Name
    print "$_ => $$initref{$_}\n" for (sort keys %$initref);

    # Sorted by Initials
    for my $init (sort values %$initref) {
        print "$init => $_\n" for (grep {$$initref{$_} eq $init} keys %$initref);
    }
}

exit;

sub DistinctInitials {

    # Derive unique "initials" for each name in a list

    # 1. Get simple initials using the first letter of each word in name
    # 2. For non-unique initials, insert a sufficient quantity of letters from
    #    the original name to make the initial unique among all initials

    my @names = @_; # A copy to be modified 
    
    # capitalise words
    s/\b(\w)(\w+)\b/\u$1\L$2\E/g for @names;
    
    # remove duplicates
    my %seen;
    @names = grep { ! $seen{$_}++ } @names;    
    
    # derive initial of each name
    my %init;
    $init{$_} = join '', ($_ =~ /\b\w/g) for @names;

    # identify non-unique initials
    my %nonu;
    for my $nonu_v (grep {$seen{$_}++} values %init) {
        map {push @{$nonu{$nonu_v}},$_ } grep {$init{$_} eq $nonu_v} keys %init;
    }
    
    # remove duplicates
    %seen=();
    @{$nonu{$_}} = grep { ! $seen{$_} ++ } @{$nonu{$_}} for keys %nonu; 

    for my $init (keys %nonu) {
        # determine minimum additional characters from each 
        # name that make all these initials unique

        my $c = 2; # start with one extra character
        my $notunique = 1;

        while ($notunique) {
            my %tryuniq;
            
            for my $name (@{$nonu{$init}}) {
                $tryuniq{ join '', ($name =~ /\b\w{1,$c}/g) } = $name;  # greedy {1,$c}
            }

            if (scalar keys %tryuniq == scalar @{$nonu{$init}}) {
                
                undef $notunique; # success, all initials are now unique
                
                # update the initial hash with our newfound initials
                while (my ($tryinit,$tryname) = each %tryuniq) {
                    $init{$tryname} = $tryinit;
                } 
            } else { 
                # failed to make them all unique
                $c += 1;                
            }
        }
        
    }
    
    \%init;

}    

# Hand-crafted test names follows...
__DATA__
John Smith
Medhi Majesh
Mickey Mouse
Minnie Mouse
A A Milne
A A Milne
A A Milner
Jimmy O'Brien
James O'Leary
Dilbert
Alphonse Romeo-Smith
I Palindrome I
tiny tim
BIG AL BUNDY
Tom DeMarco
Tom DeNada
K9