If you want it to be even faster, add the following test as the second || condition on line 36.#!/usr/bin/perl use strict; use warnings; my %data = map { chomp; $_ => [ split ] } <DATA>; 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;
Cheers - L~Rindex($t_name->[$index], substr($name->[$index], 0, 1))
In reply to Re: Re: Re: Re: Re: Re: Re: Generate unique initials from a list of names
by Limbic~Region
in thread Generate unique initials from a list of names
by EdwardG
For: | Use: | ||
& | & | ||
< | < | ||
> | > | ||
[ | [ | ||
] | ] |