Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re: Generate unique initials from a list of names

by Limbic~Region (Chancellor)
on Mar 12, 2004 at 13:48 UTC ( [id://336144]=note: print w/replies, xml ) Need Help??


in reply to Generate unique initials from a list of names

EdwardG,
Do you mean something like this:
#!/usr/bin/perl use strict; use warnings; my %name = map {chomp; $_ => undef} <DATA>; for my $person ( keys %name ) { my $p_case = $person; $p_case =~ s/(\w+)/\u$1/g; $name{$p_case} = delete $name{$person}; } my $finished = 0; while ( ! $finished ) { my $update = 0; for my $person ( keys %name ) { my @shorter = split " " , $person; $_ =~ s/(\w+)\w/$1/ for @shorter; my $new_name = join " " , @shorter; if ( ! exists $name{$new_name} ) { $update = 1; $name{$new_name} = delete $name{$person}; } } $finished = 1 if ! $update; }
Cheers - L~R

Replies are listed 'Best First'.
Re: Re: Generate unique initials from a list of names
by EdwardG (Vicar) on Mar 12, 2004 at 14:23 UTC

    Nice and short :)

    But I'm uncertain it works as I intend. For example, try these names:

    __DATA__ Adam Harper Alan Harper

    With your code I get this:

    d:\tmp>test.pl $VAR1 = { 'A H' => undef, 'A Ha' => undef };

    Both of these are ambiguous.

      EdwardG,
      You are right - I only had a minimal chance to test it. I think it works to your satisfacation. Sorry it took a while to get back to you - stupid thing called work ;-)
      #!/usr/bin/perl use strict; use warnings; my %name = map {chomp; $_ => undef} <DATA>; my $num_names = 0; for my $person ( keys %name ) { my @names = split " " , $person; $num_names = @names if @names > $num_names; $_ = ucfirst lc $_ for @names; $name{ $person } = \@names; } my $finished = 0; my $index = 0; while ( ! $finished ) { my $update = 0; for my $person ( keys %name ) { next if ! $name{$person}[$index]; if ( $name{$person}[$index] =~ /(\w+)\w/ ) { my $new_name = $1; if ( ! grep { $new_name eq $_ } map { $name{$_}[$index] } grep { @{$name{$_}} == @{$name{$person}} } keys %name ) { $update = 1; $name{$person}[$index] = $new_name; } } } $index++ if ! $update; $finished = 1 if $index > $num_names; } print "$_ => @{ $name{$_} }\n" for keys %name;
      Cheers - L~R
        Alan Harper => A H <-- AMBIGUOUS! Adam Harper => Ad Ha

        The requirement is that all derived 'initials' should be unambiguous in which name they refer to.

        'A H' could refer to Alan or Adam.

        My code does this:

        Adam Harper => AdHa Alan Harper => AlHa

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://336144]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others surveying the Monastery: (2)
As of 2024-04-25 21:52 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found