File Coverage

blib/lib/Text/GenderFromName.pm

Criterion	Covered	Total	%
statement	150	170	88.2
branch	93	164	56.7
condition	15	35	42.8
subroutine	14	14	100.0
pod	8	8	100.0
total	280	391	71.6

package Text::GenderFromName;

# Text::GenderFromName.pm
#
# Originally by Jon Orwant,
# Created 10 Mar 97
#
# Version 0.30 - Jul 29 2003 by
# Eamon Daly,

use Carp;
use strict;
use warnings;
require Exporter;
use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);

@ISA = qw(Exporter);
@EXPORT = qw(&gender);
@EXPORT_OK = qw(&gender_init);
$VERSION = '0.33';

=head1 NAME

Text::GenderFromName - Guess the gender of an American first name.

=head1 SYNOPSIS

    use Text::GenderFromName;

    print gender("Jon");    # prints 'm'

    See EXAMPLES for additional uses.

=head1 DESCRIPTION

This module provides C, which takes a name and returns one
of three values: 'm' for male, 'f' for female, or undef for unknown.

=head1 CHANGES

Version 0.30 is a significant departure from previous versions. By
default, version 0.30 uses the U.S. Social Security Administration's
"Most Popular Names of the 1980's" list of 1001 male first names and
1013 female first names. See CAVEATS below for details on this list.

Version 0.30 also allows for arbitrary female and male hashed lists to
be provided at run-time, and includes several built-ins to provide
matches based on exclusivity, weight, metaphones, and both version
0.20 and version 0.10 regexp-style matching. The user can also specify
additional match subroutines and change the match order at run-time.

=head1 EXPORT

The single exported function is:

=over 4

=item gender ($name [, $looseness])

Returns one of three values: 'm' for male, 'f' for female, or undef
for unknown. C also accepts a "looseness" level: the higher
the looseness value, the broader the match. See THE MATCH LIST below
for details.

=back

=head1 NON-EXPORT

The non-exported matching subs are:

=over 4

=item one_only ($name)

Returns 'm' or 'f' if and only if $name is found in only one of the
two lists.

=item either_weight ($name)

Returns 'm' or 'f' if $name is found in either list. If $name is in
both lists, it returns the more heavily weighted of the two.

=item one_only_metaphone ($name)

Uses Text::DoubleMetaphone for comparison. Returns 'm' or 'f' if and
only if the metaphone for $name is found in only one of the two lists.

Note that this function builds a copy of the female/male name lists to
speed up the metaphone lookup.

=item either_weight_metaphone ($name)

Uses Text::DoubleMetaphone for comparison. Returns 'm' or 'f' if $name
is found in either list. If $name is in both lists, it sums the
weights of all matching metaphones and returns the larger of the two.

Note that this function builds a copy of the female/male name lists to
speed up the metaphone lookup.

=item v2_rules ($name)

Uses Jon Orwant's v0.20 rules for matching.

=item v1_rules ($name)

Uses Jon Orwant's adaptation of Scott Pakin's awk script from v0.10
for matching.

=back

If you wish to use your own hash refs containing names and weights,
you should explicitly import:

=over 4

=item gender_init ($female_names_ref, $male_names_ref)

Initializes the male and female hashes. This package calls
C internally: without arguments it uses the table
provided by the U.S. Social Security Administration. Don't call this
function unless you want to override the supplied lists. See THE
FEMALE/MALE HASHES below for details.

=back

=head1 THE MATCH LIST

C<@MATCH_LIST> contains the list of subs C will use to
determine the gender of a given name.

By default, there are 6 items in @MATCH_LIST, corresponding to the
non-exported functions above. Strictly matching subs should go first,
loosely matching subs should go last, as C will iterate over
the list from 0 to the specified looseness value or the number of subs
in C<@MATCH_LIST>, whichever comes first.

You may override this like so:

    @Text::GenderFromName::MATCH_LIST = ('main::my_matching_routine');

=head1 THE FEMALE/MALE HASHES

By default, these hashes are built using data from the U.S. SSA. You
may override them by calling C with your own female and male
hash refs, like so:

    use Text::GenderFromName qw( :DEFAULT &gender_init );

    my %females = ('barbly' => 4.1, 'bar' => 2.3, ...);
    my %males   = ('foobly' => 4.5, 'foo' => 1.3, ...);

    &gender_init(\%females, \%males);

The hash keys are lowercase names, and their values are their relative
weights. This allows for names that could be male or female, but are
more often one or the other.

=head1 EXAMPLES

Very strict usage:

    use Text::GenderFromName;

    my @names = ('Josephine', 'Michael', 'Dondi', 'Jonny',
                 'Pascal', 'Velvet', 'Eamon', 'FLKMLKSJN');

    for (@names) {
        # Use strict matching
        my $gender = &gender($_) || '';

        if    ($gender eq 'f') { print "$_: Female\n" }
        elsif ($gender eq 'm') { print "$_: Male\n"   }
        else                   { print "$_: UNSURE\n" }
    }

returns:

    Josephine: Female
    Michael: UNSURE
    Dondi: UNSURE
    Jonny: UNSURE
    Pascal: UNSURE
    Velvet: UNSURE
    Eamon: UNSURE
    FLKMLKSJN: UNSURE

Loose matching:

    for (@names) {
        # Use loose matching
        my $gender = &gender($_, 9) || '';
    ...

returns:

    Josephine: Female
    Michael: Male
    Dondi: Male
    Jonny: Male
    Pascal: Male
    Velvet: Female
    Eamon: UNSURE
    FLKMLKSJN: UNSURE

Turn on debugging:

    $Text::GenderFromName::DEBUG = 1;

returns:

    Matching "josephine":
            one_only...
            ==> HIT (f)

    Matching "michael":
            one_only...
            either_weight...
            F: 0.0271266376105491, M: 3.4091409099979
            ==> HIT (m)

    Matching "dondi":
            one_only...
            either_weight...
            one_only_metaphone...
            M: dondi => dante => TNT: 0.020568
            ==> HIT (m)

    Matching "jonny":
            one_only...
            either_weight...
            one_only_metaphone...
            F: jonny => jenna => JN: 0.193945
            M: jonny => john => JN: 1.629871
            either_weight_metaphone...
            F: jonny => jenna => JN: 0.193945
            F: jonny => joanna => JN: 0.118652
            F: jonny => jenny => JN: 0.104875
            ...
            M: jonny => john => JN: 1.629871
            M: jonny => juan => JN: 0.309234
            M: jonny => johnny => JN: 0.127193
            ...
            ==> HIT (m)

    Matching "pascal":
            one_only...
            either_weight...
            one_only_metaphone...
            either_weight_metaphone...
            v2_rules...
            ==> HIT (m)

    Matching "velvet":
            one_only...
            either_weight...
            one_only_metaphone...
            either_weight_metaphone...
            v2_rules...
            v1_rules...
            ==> HIT (f)

    Matching "eamon":
            one_only...
            either_weight...
            one_only_metaphone...
            either_weight_metaphone...
            v2_rules...
            v1_rules...

    Matching "flkmlksjn":
            one_only...
            either_weight...
            one_only_metaphone...
            either_weight_metaphone...
            v2_rules...
            v1_rules...

    Josephine: Female
    Michael: Male
    Dondi: Male
    Jonny: Male
    Pascal: Male
    Velvet: Female
    Eamon: UNSURE
    FLKMLKSJN: UNSURE

Add your own match sub:

    push @Text::GenderFromName::MATCH_LIST, 'main::eamon_hack';

    sub eamon_hack {
        my $name = shift;
        return 'm' if $name =~ /^eamon/;
    }

returns:

    ...
    Matching "eamon":
            one_only...
            either_weight...
            one_only_metaphone...
            either_weight_metaphone...
            v2_rules...
            v1_rules...
            main::eamon_hack...
            ==> HIT (m)

    Eamon: Male

Don't use metaphones:

    @Text::GenderFromName::MATCH_LIST =
      grep !/metaphone/, @Text::GenderFromName::MATCH_LIST;

Use your own female/male hash lists:

    use Text::GenderFromName qw( :DEFAULT &gender_init );

    my %females = ('josephine' => 2.1);
    my %males = ('dondi' => 4.5);
    &gender_init(\%females, \%males);

Use female/male hash lists from a database:

    use Text::GenderFromName qw( :DEFAULT &gender_init );

    use Tie::RDBM;
    tie my %females, 'Tie::RDBM', {db       => 'mysql:common',
                                   table    => 'females',
                                   key      => 'name',
                                   value    => 'weight'};
    tie my %males,   'Tie::RDBM', {db       => 'mysql:common',
                                   table    => 'males',
                                   key      => 'name',
                                   value    => 'weight'};
    &gender_init(\%females, \%males);

=head1 COMPATIBILITY

To run v0.30 in a (mostly) backward compatible mode, override the
MATCH_LIST like so:

    @Text::GenderFromName::MATCH_LIST = ('v2_rules', 'v1_rules');

and set the looseness to any value greater than 1:

    &gender($_, 9);

Note that v0.30 uses significantly different lists than before. If
you'd like to use the v0.20 name lists, you may download a previous
version of C, cut out the hashes, and use the
&gender_init() function to use those lists instead. To minimize the
size of this module, they are not included in this module.

=head1 CAVEATS

=head2 REGARDING THIS MODULE

Rules are now case-insensitive, which is a departure from earlier
versions of this module. Also, Orwant's v0.20 rules no longer fall
through, though v0.10's do.

Version 0.30 was a complete overhaul by someone who's never submitted a
module to CPAN before. Please consider this fact when using
C module in a production environment.

Also note that the matching routines in this module are strongly
biased toward American first names. None of the methods included in
this module correctly identify the v0.30 author's gender (m) from his
first name (Eamon).

=head2 REGARDING THE DEFAULT LIST

From http://www.ssa.gov/OACT/babynames/1999/top1000of80s.html:

"The data comes from a 5% sampling of Social Security card
applications with dates of birth from January 1980 through December
1989."

"All names which occurred at least five times in the sample are
included in the table below. The total number of males in the sample
is 977,255 and the total number of females is 936,349. Criteria to be
included in the sample is simply that a Social Security card
application was filed, that the year of birth was between 1980 and
1989, and that the birth was on US soil. As always each unique
spelling is considered a unique name. It may be appropriate for
purposes of ranking popularity of names to combine similar spellings
of the same name. This kind of grouping, however, is subjective and
time consuming, and is beyond the scope of this document. The 2000
edition of the World Almanac lists the top 10 names of each decade
based on this data after combining different spellings of the same
name."

"No effort has been made to edit the data and as a result some coding
errors are obvious. For example initials like "A" are included in the
lists. Another common problem, especially for the earlier decades is
females coded as being male. For example Jessica is the ranked 647
among male names. Finally entries like "Unknown" and "Baby" are not
removed from the lists."

=head2 REGARDING HENRY

m (0.111843889261247)

=head1 BUGS

Did I mention this module doesn't match the v0.30 author's name?

=head1 AUTHOR

Originally by Jon Orwant , v0.30 by Eamon Daly
.

This is an adaptation of an 8/91 awk script by Scott Pakin in the
December 91 issue of Computer Language Monthly.

Small contributions by Andrew Langmead and John Strickler.  Thanks to
Bob Baldwin, Matt Bishop, Daniel Klein, and the U.S. SSA for their
lists of names.

=head1 SEE ALSO

L

=cut

our ($Males, $Females);

our $DEBUG = 0;

our @MATCH_LIST = ('one_only',
                   'either_weight',
                   'one_only_metaphone',
                   'either_weight_metaphone',
                   'v2_rules',
                   'v1_rules');

eval "use Text::DoubleMetaphone qw(double_metaphone)";

if ($@) {
    @MATCH_LIST = grep !/metaphone/, @MATCH_LIST;
}

my $DEBUG_MSG = '';

&gender_init();

sub gender_init {
    my ($females_ref, $males_ref) = @_;

    if (!$females_ref || !$males_ref) {
        my $eval = join '', ();
        eval $eval;
    }
    elsif ($males_ref && !$females_ref) {
        carp "Male hash supplied, but not female!";
    }
    elsif ($females_ref && !$males_ref) {
        carp "Female hash supplied, but not male!";
    }
    else {
        $Males = $males_ref;
        $Females = $females_ref;
    }
}

sub gender {
    my $name = lc(shift);
    my $looseness = shift || 1;
    my $gender = undef;

    if (!$name) {
        carp "No name specified";
        return undef;
    }

    $DEBUG_MSG = qq{Matching "$name":\n} if $DEBUG;

    no strict 'refs';

    for (my $i = 0; $i < $looseness; $i++) {
        last if !$MATCH_LIST[$i];

        $DEBUG_MSG .= "\t$MATCH_LIST[$i]...\n" if $DEBUG;

        $gender = &{ $MATCH_LIST[$i] }($name);

        $DEBUG_MSG .= "\t==> HIT ($gender)\n" if $DEBUG && $gender;

        last if $gender;
    }

    print STDERR "$DEBUG_MSG\n" if $DEBUG;

    return $gender;
}

sub one_only {
    my $name = shift;
    my $gender = undef;

    # Match one list only

    my $male_hit = $Males->{$name};
    my $female_hit = $Females->{$name};

    if ($female_hit && !$male_hit) {
        $gender = 'f';
    }
    elsif ($male_hit && !$female_hit) {
        $gender = 'm';
    }

    return $gender;
}

sub either_weight {
    my $name = shift;
    my $gender = undef;

    # Match either, weight

    my $male_hit = $Males->{$name};
    my $female_hit = $Females->{$name};

    if ($female_hit || $male_hit) {
        $gender = ($female_hit > $male_hit) ? 'f' : 'm';
    }

    $DEBUG_MSG .= "\tF: $female_hit, M: $male_hit\n" if $DEBUG && $gender;

    return $gender;
}

sub one_only_metaphone {
    my $name = shift;
    my $gender = undef;

    # Match one list only, use DoubleMetaphone

    my $meta_name = &double_metaphone($name);
    my $metaphone_hit = '';

    # Copy $Females and $Males to speed sorting.

    my %females_copy = %{ $Females };
    my %males_copy = %{ $Males };

    my $male_hit = 0;
    my $female_hit = 0;

    foreach my $list_name (sort
                           { $females_copy{$b} <=> $females_copy{$a} }
                           keys %females_copy) {
        last if $female_hit;

        my $meta_list_name = double_metaphone($list_name);

        if ($meta_name eq $meta_list_name) {
            $female_hit = $females_copy{$list_name};

            $DEBUG_MSG .= sprintf "\tF: %s => %s => %s: %f\n",
              $name, $list_name, $meta_list_name, $females_copy{$list_name}
                if $DEBUG;
        }
    }

    foreach my $list_name (sort
                           { $males_copy{$b} <=> $males_copy{$a} }
                           keys %males_copy) {
        last if $male_hit;

        my $meta_list_name = double_metaphone($list_name);

        if ($meta_name eq $meta_list_name) {
            $male_hit = $males_copy{$list_name};

            $DEBUG_MSG .= sprintf "\tM: %s => %s => %s: %f\n",
              $name, $list_name, $meta_list_name, $males_copy{$list_name}
                if $DEBUG;
        }
    }

    if ($female_hit && !$male_hit) {
        $gender = 'f';
    }
    elsif ($male_hit && !$female_hit) {
        $gender = 'm';
    }

    return $gender;
}

sub either_weight_metaphone {
    my $name = shift;
    my $gender = undef;

    # Match either, weight, use DoubleMetaphone

    my $meta_name = &double_metaphone($name);

    # Copy $Females and $Males to speed sorting.

    my %females_copy = %{ $Females };
    my %males_copy = %{ $Males };

    my $male_hit = 0;
    my $female_hit = 0;

    foreach my $list_name (sort
                           { $females_copy{$b} <=> $females_copy{$a} }
                           keys %females_copy) {
        my $meta_list_name = double_metaphone($list_name);

        if ($meta_name eq $meta_list_name) {
            $female_hit += $females_copy{$list_name};

            $DEBUG_MSG .= sprintf "\tF: %s => %s => %s: %f\n",
              $name, $list_name, $meta_list_name, $females_copy{$list_name}
                if $DEBUG;
        }
    }

    foreach my $list_name (sort
                           { $males_copy{$b} <=> $males_copy{$a} }
                           keys %males_copy) {
        my $meta_list_name = double_metaphone($list_name);

        if ($meta_name eq $meta_list_name) {
            $male_hit += $males_copy{$list_name};

            $DEBUG_MSG .= sprintf "\tM: %s => %s => %s: %f\n",
              $name, $list_name, $meta_list_name, $males_copy{$list_name}
                if $DEBUG;
        }
    }

    if ($female_hit || $male_hit) {
        $gender = ($female_hit > $male_hit) ? 'f' : 'm';
    }

    return $gender;
}

sub v2_rules {
    my $name = shift;
    my $gender = undef;

    # Match using Orwant's rules from v0.20 of Text::GenderFromName

    # Note that this no longer 'falls through' as in v0.20. Jon makes
    # mention of the fact that the v0.10 rules are ordered, but Jon's
    # additions appear to be exclusive.

    # jon and john
    if ($name =~ /^joh?n/) { $gender = 'm' }
    # tom and thomas and tomas and toby
    elsif ($name =~ /^th?o(m|b)/) { $gender = 'm' }
    elsif ($name =~ /^frank/) { $gender = 'm' }
    elsif ($name =~ /^bil/) { $gender = 'm' }
    elsif ($name =~ /^hans/) { $gender = 'm' }
    elsif ($name =~ /^ron/) { $gender = 'm' }
    elsif ($name =~ /^ro(z|s)/) { $gender = 'f' }
    elsif ($name =~ /^walt/) { $gender = 'm' }
    elsif ($name =~ /^krishna/) { $gender = 'm' }
    elsif ($name =~ /^tri(c|sh)/) { $gender = 'f' }
    # pascal and pasqual
    elsif ($name =~ /^pas(c|qu)al$/) { $gender = 'm' }
    elsif ($name =~ /^ellie/) { $gender = 'f' }
    elsif ($name =~ /^anfernee/) { $gender = 'm' }

    return $gender;
}

sub v1_rules {
    my $name = shift;
    my $gender = undef;

    # Match using rules from v0.10 of Text::GenderFromName

    # most names ending in a/e/i/y are female
    $gender = 'f' if $name =~ /^.*[aeiy]$/;
    # allison and variations
    $gender = 'f' if $name =~ /^all?[iy]((ss?)|z)on$/;
    # cathleen, eileen, maureen
    $gender = 'f' if $name =~ /een$/;
    # barry, larry, perry
    $gender = 'm' if $name =~ /^[^s].*r[rv]e?y?$/;
    # clive, dave, steve
    $gender = 'm' if $name =~ /^[^g].*v[ei]$/;
    # carolyn, gwendolyn, vivian
    $gender = 'f' if $name =~ /^[^bd].*(b[iy]|y|via)nn?$/;
    # dewey, stanley, wesley
    $gender = 'm' if $name =~ /^[^ajklmnp][^o][^eit]*([glrsw]ey|lie)$/;
    # heather, ruth, velvet
    $gender = 'f' if $name =~ /^[^gksw].*(th|lv)(e[rt])?$/;
    # gregory, jeremy, zachary
    $gender = 'm' if $name =~ /^[cgjwz][^o][^dnt]*y$/;
    # leroy, murray, roy
    $gender = 'm' if $name =~ /^.*[rlr][abo]y$/;
    # abigail, jill, lillian
    $gender = 'f' if $name =~ /^[aehjl].*il.*$/;
    # janet, jennifer, joan
    $gender = 'f' if $name =~ /^.*[jj](o|o?[ae]a?n.*)$/;
    # duane, eugene, rene
    $gender = 'm' if $name =~ /^.*[grguw][ae]y?ne$/;
    # fleur, lauren, muriel
    $gender = 'f' if $name =~ /^[flm].*ur(.*[^eotuy])?$/;
    # lance, quincy, vince
    $gender = 'm' if $name =~ /^[clmqtv].*[^dl][in]c.*[ey]$/;
    # margaret, marylou, miri;
    $gender = 'f' if $name =~ /^m[aei]r[^tv].*([^cklnos]|([^o]n))$/;
    # clyde, kyle, pascale
    $gender = 'm' if $name =~ /^.*[ay][dl]e$/;
    # blake, luke, mi;
    $gender = 'm' if $name =~ /^[^o]*ke$/;
    # carol, karen, shar;
    $gender = 'f' if $name =~ /^[cks]h?(ar[^lst]|ry).+$/;
    # pam, pearl, rachel
    $gender = 'f' if $name =~ /^[pr]e?a([^dfju]|qu)*[lm]$/;
    # annacarol, leann, ruthann
    $gender = 'f' if $name =~ /^.*[aa]nn.*$/;
    # deborah, leah, sarah
    $gender = 'f' if $name =~ /^.*[^cio]ag?h$/;
    # frances, megan, susan
    $gender = 'f' if $name =~ /^[^ek].*[grsz]h?an(ces)?$/;
    # ethel, helen, gretchen
    $gender = 'f' if $name =~ /^[^p]*([hh]e|[ee][lt])[^s]*[ey].*[^t]$/;
    # george, joshua, theodore
    $gender = 'm' if $name =~ /^[^el].*o(rg?|sh?)?(e|ua)$/;
    # delores, doris, precious
    $gender = 'f' if $name =~ /^[dp][eo]?[lr].*s$/;
    # anthony, henry, rodney
    $gender = 'm' if $name =~ /^[^jpswz].*[denor]n.*y$/;
    # karin, kim, kristin
    $gender = 'f' if $name =~ /^k[^v]*i.*[mns]$/;
    # bradley, brady, bruce
    $gender = 'm' if $name =~ /^br[aou][cd].*[ey]$/;
    # agnes, alexis, glynis
    $gender = 'f' if $name =~ /^[acgk].*[deinx][^aor]s$/;
    # ignace, lee, wallace
    $gender = 'm' if $name =~ /^[ilw][aeg][^ir]*e$/;
    # juliet, mildred, millicent
    $gender = 'f' if $name =~ /^[^agw][iu][gl].*[drt]$/;
    # ari, bela, ira
    $gender = 'm' if $name =~ /^[abeiuy][euz]?[blr][aeiy]$/;
    # iris, lois, phyllis
    $gender = 'f' if $name =~ /^[egilp][^eu]*i[ds]$/;
    # randy, timothy, tony
    $gender = 'm' if $name =~ /^[art][^r]*[dhn]e?y$/;
    # beatriz, bridget, harriet
    $gender = 'f' if $name =~ /^[bhl].*i.*[rtxz]$/;
    # antoine, jerome, tyrone
    $gender = 'm' if $name =~ /^.*oi?[mn]e$/;
    # danny, demetri, dondi
    $gender = 'm' if $name =~ /^d.*[mnw].*[iy]$/;
    # pete, serge, shane
    $gender = 'm' if $name =~ /^[^bg](e[rst]|ha)[^il]*e$/;
    # angel, gail, isabel
    $gender = 'f' if $name =~ /^[adfgim][^r]*([bg]e[lr]|il|wn)$/;

    return $gender;
}

1;

__DATA__