home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / ipl / procs / soundex1.icn < prev    next >
Text File  |  2000-07-29  |  3KB  |  86 lines
  1. ############################################################################
  2. #
  3. #    File:     soundex1.icn
  4. #
  5. #    Subject:  Procedures for Soundex algorithm
  6. #
  7. #    Author:   John David Stone
  8. #
  9. #    Date:     April 30, 1993
  10. #
  11. ############################################################################
  12. #
  13. #   This file is in the public domain.
  14. #
  15. ############################################################################
  16. #
  17. #  When names are communicated by telephone, they are often transcribed
  18. #  incorrectly.  An organization that has to keep track of a lot of names has
  19. #  a need, therefore, for some system of representing or encoding a name that
  20. #  will mitigate the effects of transcription errors.  One idea, originally
  21. #  proposed by Margaret K. Odell and Robert C. Russell, uses the following
  22. #  encoding system to try to bring together occurrences of the same surname,
  23. #  variously spelled:
  24. #
  25. #  Encode each of the letters of the name according to the
  26. #  following equivalences:
  27. #
  28. #        a, e, h, i, o, u, w, y -> *
  29. #        b, f, p, v             -> 1
  30. #        c, g, j, k, q, s, x, z -> 2
  31. #        d, t                   -> 3
  32. #        l                      -> 4
  33. #        m, n                   -> 5
  34. #        r                      -> 6
  35. #
  36. #
  37. #  If any two adjacent letters have the same code, change the code for the
  38. #  second one to *.
  39. #
  40. #  The Soundex representation consists of four characters: the initial letter
  41. #  of the name, and the first three digit (non-asterisk) codes corresponding
  42. #  to letters after the initial.  If there are fewer than three such digit
  43. #  codes, use all that there are, and add zeroes at the end to make up the
  44. #  four-character representation.
  45. #
  46. ############################################################################
  47.  
  48. procedure soundex(name)
  49. local coded_name, new_name
  50.  
  51.     coded_name := encode(strip(name))
  52.     new_name := name[1]
  53.     every pos := 2 to *coded_name do {
  54.         if coded_name[pos] ~== "*" then
  55.             new_name := new_name || coded_name[pos]
  56.         if *new_name = 4 then
  57.             break
  58.     }
  59.     return new_name || repl ("0", 4 - *new_name)
  60. end
  61.  
  62. procedure encode(name)
  63.  
  64.     name := map(name, &ucase, &lcase)
  65.     name := map(name, "aehiouwybfpvcgjkqsxzdtlmnr",
  66.         "********111122222222334556")
  67.     every pos := *name to 2 by -1 do
  68.         if name[pos - 1] == name[pos] then
  69.             name[pos] := "*"
  70.     return name
  71. end
  72.  
  73. procedure strip(name)
  74. local result, ch
  75.  
  76. static alphabet
  77.  
  78. initial alphabet := string(&letters)
  79.  
  80.     result := ""
  81.     every ch := !name do
  82.         if find(ch, alphabet) then
  83.             result ||:= ch
  84.     return result
  85. end
  86.