1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
package Text::Soundex;
require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(&soundex $soundex_nocode);
# $Id: soundex.pl,v 1.2 1994/03/24 00:30:27 mike Exp $
#
# Implementation of soundex algorithm as described by Knuth in volume
# 3 of The Art of Computer Programming, with ideas stolen from Ian
# Phillips <ian@pipex.net>.
#
# Mike Stok <Mike.Stok@meiko.concord.ma.us>, 2 March 1994.
#
# Knuth's test cases are:
#
# Euler, Ellery -> E460
# Gauss, Ghosh -> G200
# Hilbert, Heilbronn -> H416
# Knuth, Kant -> K530
# Lloyd, Ladd -> L300
# Lukasiewicz, Lissajous -> L222
#
# $Log: soundex.pl,v $
# Revision 1.2 1994/03/24 00:30:27 mike
# Subtle bug (any excuse :-) spotted by Rich Pinder <rpinder@hsc.usc.edu>
# in the way I handles leasing characters which were different but had
# the same soundex code. This showed up comparing it with Oracle's
# soundex output.
#
# Revision 1.1 1994/03/02 13:01:30 mike
# Initial revision
#
#
##############################################################################
# $soundex_nocode is used to indicate a string doesn't have a soundex
# code, I like undef other people may want to set it to 'Z000'.
$soundex_nocode = undef;
sub soundex
{
local (@s, $f, $fc, $_) = @_;
push @s, '' unless @s; # handle no args as a single empty string
foreach (@s)
{
$_ = uc $_;
tr/A-Z//cd;
if ($_ eq '')
{
$_ = $soundex_nocode;
}
else
{
($f) = /^(.)/;
tr/AEHIOUWYBFPVCGJKQSXZDTLMNR/00000000111122222222334556/;
($fc) = /^(.)/;
s/^$fc+//;
tr///cs;
tr/0//d;
$_ = $f . $_ . '000';
s/^(.{4}).*/$1/;
}
}
wantarray ? @s : shift @s;
}
1;
__END__
=head1 NAME
Text::Soundex - Implementation of the Soundex Algorithm as Described by Knuth
=head1 SYNOPSIS
use Text::Soundex;
$code = soundex $string; # get soundex code for a string
@codes = soundex @list; # get list of codes for list of strings
# set value to be returned for strings without soundex code
$soundex_nocode = 'Z000';
=head1 DESCRIPTION
This module implements the soundex algorithm as described by Donald Knuth
in Volume 3 of B<The Art of Computer Programming>. The algorithm is
intended to hash words (in particular surnames) into a small space using a
simple model which approximates the sound of the word when spoken by an English
speaker. Each word is reduced to a four character string, the first
character being an upper case letter and the remaining three being digits.
If there is no soundex code representation for a string then the value of
C<$soundex_nocode> is returned. This is initially set to C<undef>, but
many people seem to prefer an I<unlikely> value like C<Z000>
(how unlikely this is depends on the data set being dealt with.) Any value
can be assigned to C<$soundex_nocode>.
In scalar context C<soundex> returns the soundex code of its first
argument, and in array context a list is returned in which each element is the
soundex code for the corresponding argument passed to C<soundex> e.g.
@codes = soundex qw(Mike Stok);
leaves C<@codes> containing C<('M200', 'S320')>.
=head1 EXAMPLES
Knuth's examples of various names and the soundex codes they map to
are listed below:
Euler, Ellery -> E460
Gauss, Ghosh -> G200
Hilbert, Heilbronn -> H416
Knuth, Kant -> K530
Lloyd, Ladd -> L300
Lukasiewicz, Lissajous -> L222
so:
$code = soundex 'Knuth'; # $code contains 'K530'
@list = soundex qw(Lloyd Gauss); # @list contains 'L300', 'G200'
=head1 LIMITATIONS
As the soundex algorithm was originally used a B<long> time ago in the US
it considers only the English alphabet and pronunciation.
As it is mapping a large space (arbitrary length strings) onto a small
space (single letter plus 3 digits) no inference can be made about the
similarity of two strings which end up with the same soundex code. For
example, both C<Hilbert> and C<Heilbronn> end up with a soundex code
of C<H416>.
=head1 AUTHOR
This code was implemented by Mike Stok (C<stok@cybercom.net>) from the
description given by Knuth. Ian Phillips (C<ian@pipex.net>) and Rich Pinder
(C<rpinder@hsc.usc.edu>) supplied ideas and spotted mistakes.
|
