← Back to branch summary

~ubuntu-branches/ubuntu/trusty/horae/trusty

« back to all changes in this revision

Viewing changes to 0CPAN/perlindex-1.301/lib/Text/English.pm

  • Committer: Bazaar Package Importer
  • Author(s): Carlo Segre
  • Date: 2008-02-23 23:13:02 UTC
  • mfrom: (2.1.2 hardy)
  • Revision ID: james.westby@ubuntu.com-20080223231302-mnyyxs3icvrus4ke
Tags: 066-3
Apply patch to athena_parts/misc.pl for compatibility with 
perl-tk 804.28.

Show diffs side-by-side

added added

removed removed

Lines of Context:
0CPAN/perlindex-1.301/lib/Text/English.pm
1
 
#!/usr/local/ls6/bin/perl
2
 
#                              -*- Mode: Perl -*- 
3
 
# English.pm -- 
4
 
# ITIID           : $ITI$ $Header $__Header$
5
 
# Author          : Ulrich Pfeifer
6
 
# Created On      : Thu Feb  1 13:47:58 1996
7
 
# Last Modified By: Ulrich Pfeifer
8
 
# Last Modified On: Thu Feb  1 13:52:38 1996
9
 
# Language        : Perl
10
 
# Update Count    : 4
11
 
# Status          : Unknown, Use with caution!
12
 
# 
13
 
# (C) Copyright 1996, Universit�t Dortmund, all rights reserved.
14
 
# 
15
 
# $Locker:  $
16
 
# $Log: English.pm,v $
17
 
# Revision 1.1.1.1  2003/06/18 17:12:09  upf
18
 
# perlindex-1.200.tar.gz
19
 
#
20
 
# Revision 1.1.1.1  1996/02/22 15:43:31  pfeifer
21
 
# patch2:
22
 
#
23
 
# 
24
 
 
25
 
package Text::English;
26
 
 
27
 
$VERSION = $VERSION = '0.01';
28
 
 
29
 
sub stem {
30
 
    my @parms = @_;
31
 
    foreach( @parms ) {
32
 
        $_ = lc $_;
33
 
 
34
 
        # Step 0 - remove punctuation
35
 
        s/'s$//; s/^[^a-z]+//; s/[^a-z]+$//;
36
 
        next unless /^[a-z]+$/;
37
 
 
38
 
        # step1a_rules
39
 
        if( /[^s]s$/ ) { s/sses$/ss/ || s/ies$/i/ || s/s$// }
40
 
       
41
 
        # step1b_rules. The business with rule==106 is embedded in the
42
 
        # boolean expressions here.
43
 
        (/[aeiouy][^aeiouy].*eed$/ && s/eed$/ee/ ) || 
44
 
            ( s/([aeiou].*)ed$/$1/ || s/([aeiouy].*)ing$/$1/ ) &&
45
 
            ( # step1b1_rules
46
 
                s/at$/ate/      || s/bl$/ble/   || s/iz$/ize/   || s/bb$/b/     ||
47
 
                s/dd$/d/        || s/ff$/f/     || s/gg$/g/     || s/mm$/m/     ||
48
 
                s/nn$/n/        || s/pp$/p/     || s/rr$/r/     || s/tt$/t/     ||
49
 
                s/ww$/w/        || s/xx$/x/     ||
50
 
                # This is wordsize==1 && CVC...addanE...
51
 
                s/^[^aeiouy]+[aeiouy][^aeiouy]$/$&e/
52
 
            )
53
 
#DEBUG      && warn "step1b1: $_\n"
54
 
            ;
55
 
        # step1c_rules
56
 
#DEBUG  warn "step1c: $_\n" if
57
 
        s/([aeiouy].*)y$/$1i/;
58
 
 
59
 
        # step2_rules
60
 
 
61
 
        if (    s/ational$/ate/ || s/tional$/tion/      || s/enci$/ence/        ||
62
 
                s/anci$/ance/   || s/izer$/ize/         || s/iser$/ise/         ||
63
 
                s/abli$/able/   || s/alli$/al/          || s/entli$/ent/        ||
64
 
                s/eli$/e/       || s/ousli$/ous/        || s/ization$/ize/      ||
65
 
                s/isation$/ise/ || s/ation$/ate/        || s/ator$/ate/         ||
66
 
                s/alism$/al/    || s/iveness$/ive/      || s/fulnes$/ful/       ||
67
 
                s/ousness$/ous/ || s/aliti$/al/         || s/iviti$/ive/        ||
68
 
                s/biliti$/ble/
69
 
            ) {
70
 
            my ($l,$m) = ($`,$&);
71
 
#DEBUG      warn "step 2: l=$l m=$m\n";
72
 
            $_ = $l.$m unless $l =~ /[^aeiou][aeiouy]/;
73
 
        }
74
 
        # step3_rules
75
 
        if (    s/icate$/ic/    || s/ative$//   || s/alize$/al/ ||
76
 
                s/iciti$/ic/    || s/ical$/ic/  || s/ful$//     ||
77
 
                s/ness$//
78
 
            ) {
79
 
            my ($l,$m) = ($`,$&);
80
 
#DEBUG      warn "step 3: l=$l m=$m\n";
81
 
            $_ = $l.$m unless $l =~ /[^aeiou][aeiouy]/;
82
 
        }
83
 
 
84
 
        # step4_rules
85
 
        if (    s/al$//         || s/ance$//    || s/ence$//    || s/er$//      ||
86
 
                s/ic$//         || s/able$//    || s/ible$//    || s/ant$//     ||
87
 
                s/ement$//      || s/ment$//    || s/ent$//     || s/sion$/s/   ||
88
 
                s/tion$/t/      || s/ou$//      || s/ism$//     || s/ate$//     ||
89
 
                s/iti$//        || s/ous$//     || s/ive$//     || s/ize$//     ||
90
 
                s/ise$//
91
 
            ) {
92
 
            my ($l,$m) = ($`,$&);
93
 
        # Look for two consonant/vowel transitions
94
 
        # NB simplified...
95
 
#DEBUG      warn "step 4: l=$l m=$m\n";
96
 
            $_ = $l.$m unless $l =~ /[^aeiou][aeiouy].*[^aeiou][aeiouy]/;
97
 
        }
98
 
 
99
 
        # step5a_rules
100
 
#DEBUG  warn("step 5a: $_\n") &&
101
 
        s/e$// if ( /[^aeiou][aeiouy].*[^aeiou][aeiouy].*e$/ ||
102
 
                ( /[aeiou][^aeiouy].*e/ && ! /[^aeiou][aeiouy][^aeiouwxy]e$/) );
103
 
 
104
 
        # step5b_rules
105
 
#DEBUG  warn("step 5b: $_\n") &&
106
 
        s/ll$/l/ if /[^aeiou][aeiouy].*[^aeiou][aeiouy].*ll$/;
107
 
 
108
 
        # Cosmetic step 
109
 
        s/(.)i$/$1y/;
110
 
    }
111
 
    @parms;
112
 
}
113
 
 
114
 
1;
115
 
 
116
 
__END__
117
 
 
118
 
=head1 NAME
119
 
 
120
 
Text::English - Porter's stemming algorithm
121
 
 
122
 
=head1 SYNOPSIS
123
 
 
124
 
    use Text::English;
125
 
    @stems = Text::English::stem( @words );
126
 
 
127
 
=head1 DESCRIPTION
128
 
 
129
 
This routine applies the Porter Stemming Algorithm to its parameters,
130
 
returning the stemmed words.
131
 
It is derived from the C program "stemmer.c"
132
 
as found in freewais and elsewhere, which contains these notes:
133
 
 
134
 
   Purpose:    Implementation of the Porter stemming algorithm documented 
135
 
               in: Porter, M.F., "An Algorithm For Suffix Stripping," 
136
 
               Program 14 (3), July 1980, pp. 130-137.
137
 
   Provenance: Written by B. Frakes and C. Cox, 1986.
138
 
 
139
 
I have re-interpreted areas that use Frakes and Cox's "WordSize"
140
 
function. My version may misbehave on short words starting with "y",
141
 
but I can't think of any examples.
142
 
 
143
 
The step numbers correspond to Frakes and Cox, and are probably in
144
 
Porter's article (which I've not seen).
145
 
Porter's algorithm still has rough spots (e.g current/currency, -ings words),
146
 
which I've not attempted to cure, although I have added
147
 
support for the British -ise suffix.
148
 
 
149
 
=head1 NOTES
150
 
 
151
 
This is version 0.1. I would welcome feedback, especially improvements
152
 
to the punctuation-stripping step.
153
 
 
154
 
=head1 AUTHOR
155
 
 
156
 
Ian Phillipps <ian@unipalm.pipex.com>
157
 
 
158
 
=head1 COPYRIGHT
159
 
 
160
 
Copyright Public IP Exchange Ltd (PIPEX).
161
 
Available for use under the same terms as perl.
162
 
 
163
 
=cut
164