File Coverage

blib/lib/Lingua/EN/Syllable.pm

Criterion	Covered	Total	%
statement	25	25	100.0
branch	10	12	83.3
condition			n/a
subroutine	4	4	100.0
pod	0	1	0.0
total	39	42	92.8

package Lingua::EN::Syllable;
$Lingua::EN::Syllable::VERSION = '0.30';
# ABSTRACT: count the number of syllables in English words

use 5.006;
use strict;
use warnings;

# note that this is not infallible.  it does fail for some percentage of
# words (10% seems a good guess)...  so it's useful for approximation, but
# don't use this for running your nuclear reactor...

require Exporter;

our @ISA        = qw/ Exporter /;
our @EXPORT     = qw/ syllable /;
our @EXPORT_OK  = qw/ @AddSyl @SubSyl /;
our @AddSyl;
our @SubSyl;

# basic algortithm:
# each vowel-group indicates a syllable, except for:
#  final (silent) e
#  'ia' ind two syl

# @AddSyl and @SubSyl list regexps to massage the basic count.
# Each match from @AddSyl adds 1 to the basic count, each @SubSyl match -1
# Keep in mind that when the regexps are checked, any final 'e' will have
# been removed, and all '\'' will have been removed.

@SubSyl = (
	   'cial',
	   'tia',
	   'cius',
	   'cious',
	   'giu',              # belgium!
	   'ion',
	   'iou',
	   'sia$',
	   '.ely$',             # absolutely! (but not ely!)
       '[^td]ed$',          # accused is 2, but executed is 4
	  );
@AddSyl = (
	   'ia',
	   'riet',
	   'dien',
	   'iu',
	   'io',
	   'ii',
       'microor',
	   '[aeiouym]bl$',     # -Vble, plus -mble
	   '[aeiou]{3}',       # agreeable
	   '^mc',
	   'ism$',             # -ism
	   'isms$',            # -isms
	   '([^aeiouy])\1l$',  # middle twiddle battle bottle, etc.
	   '[^l]lien',         # alien, salient [1]
           '^coa[dglx].',      # [2]
	   '[^gq]ua[^auieo]',  # i think this fixes more than it breaks
 	   'dnt$',           # couldn't
	  );

# (comments refer to titan's /usr/dict/words)
# [1] alien, salient, but not lien or ebbullient...
#     (those are the only 2 exceptions i found, there may be others)
# [2] exception for 7 words:
#     coadjutor coagulable coagulate coalesce coalescent coalition coaxial

#----------------------------------------
sub syllable {
    my $word = shift;
    my(@scrugg,$syl);

    $word =~ tr/A-Z/a-z/;
    return 2 if $word eq 'w';
    return 1 if length($word) == 1;
    $word =~ s/\'//g; # fold contractions.  not very effective.
    $word =~ s/e$//;
    @scrugg = split(/[^aeiouy]+/, $word); # '-' should perhaps be added?
    shift(@scrugg) unless ($scrugg[0]);
    $syl = 0;
    # special cases
    foreach (@SubSyl) {
      $syl-- if $word=~/$_/;
    }
    foreach (@AddSyl) {
      $syl++ if $word=~/$_/;
    }
    # count vowel groupings
    $syl += scalar(@scrugg);
    $syl=1 if $syl==0; # got no vowels? ("the", "crwth")
    return $syl;
}
# syllable


1;
__END__