#!/usr/bin/perl use strict; use warnings; my %data = map { chomp; $_ => [ split ] } ; my $last = 0; for ( keys %data ) { $last = @{$data{$_}} if @{$data{$_}} > $last; $_ = ucfirst lc $_ for @{$data{$_}}; } for my $index ( 0 .. $last ) { for my $name ( map { $data{$_} } keys %data ) { next if ! $name->[$index]; for my $length ( 1 .. length $name->[$index] ) { if ( ! Match( $name, $index, $length ) ) { $name->[$index] = substr( $name->[$index], 0, $length ) ; last; } } } } sub Short { my ( $name, $index, $length ) = @_; return join " ", @{$name}[ grep $_ < $index, 0 .. $#$name ], substr( $name->[$index], 0, $length ), @{$name}[ grep $_ > $index, 0 .. $#$name]; } sub Match { my ( $name, $index, $length ) = @_; my $s_name = Short( $name, $index, $length ); for my $t_name ( map { $data{$_} } keys %data ) { next if @$name != @$t_name || $name eq $t_name; my $s_test = Short( $t_name, $index, $length ); return 1 if $s_name eq $s_test; } return 0; } print "@{ $data{$_} } => $_\n" for sort keys %data; #### index($t_name->[$index], substr($name->[$index], 0, 1))