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