Date Range Level Consumers -------------------------- ------- -------------------------- 13 Mar 2004 to 23 Mar 2004 7 AB, AT, DA, MS, RI, RR, RR 24 Mar 2004 to 31 Mar 2004 6 AB, DA, RC, RI, RR, SJ 01 Apr 2004 to 15 May 2004 3 Alan Po, Rohan Ito, Sam Jones 16 May 2004 to 31 Dec 2004 5 AP, PS, RC, RI, SJ #### $init{$_} = join '', ($_ =~ /\b\w/g) for @names; #### Date Range Level Consumers -------------------------- ------- -------------------------- 13 Mar 2004 to 23 Mar 2004 7 AB, AT, DA, MS, RI, RR, RaRa 24 Mar 2004 to 31 Mar 2004 6 AB, DA, RC, RI, RaRa, SJ 01 Apr 2004 to 15 May 2004 3 Alan Po, Rohan Ito, Sam Jones 16 May 2004 to 31 Dec 2004 5 AP, PS, RC, RI, SJ #### Alphonse Romeo-Smith => ARS Big Al Bundy => BAB Dilbert => D I Palindrome I => IPI James O'Leary => JOL Jimmy O'Brien => JOB John Smith => JS K9 => K Medhi Majesh => MedMaj Mickey Mouse => MicMou Minnie Mouse => MinMou Tiny Tim => TT Tom Demarco => TomDem Tom Denada => TomDen #### A A Milne => AAMilne A A Milner => AAMilner #### use strict; use warnings; MAIN: { my @names = ; 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 #### Adam Harper Alan Pfaff Alan Vanwinkle Alana Stutsman Albert Osterman Alison Sands Allan Goris Allan Razor Alma Ratcliffe Alvaro Cangemi Amanda Basile Annabelle Ducker Anthony Granado Anthony Mcdevitt Antonio Starnes April Kain Arlene Stephen Armand Stower Arthur Ragsdale Ashlee Hurtt Ballentine Beata Zar Bernice Turnage Bertha Schuck Billy Sundberg Binns Blanche Page Bobby Eaton Bobby Winkelman Brandon Dominick Brittanie Noviello Brittian Bulah Twombley Candace Cote Carey Balck Carey Grishaber Carey Twedell Chad Guarino Chandra Puffer Cheryl Langley Chris Creekmore Clare Milum Clayton Elbert Clinton Dahmen Clinton Ganley Clinton Mcnaught Cody Ridout Cody Vigo Dale Hernandes Dane Hasychak Daniel Colunga Darren Tacey Darren Vanaman Darryl Buchta Debbie Schlueter Doggett Doris Adkins Eileen Bard Elinor Rita Elizabeth Hendricks Elnora Hornbuckle Elwood Steketee Ericka Hodgin Erik Duley Ernest Cowley Ernest Frey Ernest Helmick Esmeralda Kardos Eve Goodfellow Ewa Villerreal Felicia Manson Fernando Outler Fidel Jacoway Fidel Paone Florence Lillie Fred Pyles Genna Tranbarger George Lamoureux Gerald Graziano Gerald Minnich Gina Nickelson Gladys Rothman Glenda Wheat Gregory Walls Guinn Guy Gatton Hannah Quijano Harold Houser Harriet Dreyer Heinricher Howard Sirois Hugh Charland Hugh Dipalma Hugh Fuselier Hugh Minaya Ida Noe Inez Marion James Angell James Cravens Jami Gula Jamie Brickhouse Jamie Huot Jason Willson Jeannette Macaluso Jerri Giesen Jerri Houseknecht Jerri Nickson Jessie Olah Ji Greenier Jonathan Matos Joyce Brian Julio Sepeda Karina Palka Katherine Holzer Kathryn Diaz Katie Lloyd Keila Brue Keith Berner Kelly Henegar Kenneth Caraballo Kevin Batchelder Kevin Poindexter Kimberly Cecil Kimberly Hare Kingsbury Koteles Kristina Kasper Lakisha Trees Larita Battisti Laura Mcfadden Laurie Carranza Lilia Fouse Linda Kavanaugh Linda Power Lonnie Sherrow Lori Stjohn Lorrie Lobdell Louis Leggett Louis Watterson Louisa Galyean Louisa Swingle Louise Belanger Lynda Knudsen Madelene Robasciotti Mae Brantley Maggie Fernandez Maggie Madore Mallory Brodbeck Mallory Sickels Manuel Trotter Marcel Avers Marcel Cuffia Marcel Merow Margaret Amey Maricela Bautch Marilyn Shumpert Mark Haynie Marlin Gryniuk Martin King Mathew Mayton Max Sprau Merrilee Garelick Mildred Colburn Ming Negro Nathan Shuster Neil Helbert Nelson Pinzon Nelson Rayo Nicholas Lowell Nicole Tillman Norman Thatcher Olivia Bridgeman Peggy Loggins Penelope Maize Peter Agee Peter Valadez Priscilla Katz Rachel Marchand Randy Frederickson Raphael Dumaine Raymond Nava Robyn Duvall Rod Schoneman Roger Goldman Ronald Looney Roy Kushner Royce Schrock Scott Obryan Shawn Ault Stanley Cleaver Sydow Sylvia Salazar Sylvia Walther Tabatha Goodsell Tari Windish Tarra Bellantuono Thomas Coleman Tia Drakeford Tina Palomo Tompkins Tony Haight Tyrone Crossett Tyrone Golub Victor Mcduffie Vincent Nowak Viola Mcnamee Wayne Maye Wayne Ulrich Yolanda Hood