5
\$\begingroup\$

The soundex algorithm maps several spellings of a name to a 4 character term. (hopefully mapping all different transcriptions to the same term) The steps as described in Introduction to information retrieval are:

  • Keep first Letter for the rest:
  • Change any of 'A', 'E', 'I', 'O', 'U', 'H', 'W', 'Y' to zero
  • Change all other characters to 1-6, see below
  • remove consecutive doubles
  • remove all zeros, right pad with 0s, keep first 3

I implemented a working solution, but can it be implemented more readable?

import Data.Char

soundex :: String -> String
soundex []      = []
soundex (n:ame) = result
  where 
    compr  = map (compress . toUpper) ame
    noDoub = remDoubles compr
    noZero = filter (/='0') noDoub
    result = n: take 3 (noZero++"000")

remDoubles :: String -> String
remDoubles []       = []
remDoubles (a:[])   = [a]
remDoubles (a:b:bs) | a==b      = remDoubles   (b:bs)
                    | otherwise = a:remDoubles (b:bs)

compress :: Char -> Char
compress char | char `elem` "AEIOUHWY" = '0'
              | char `elem` "BFPV"     = '1'
              | char `elem` "CGJKQSXZ" = '2'
              | char `elem` "DT"       = '3'
              | char `elem` "L"        = '4'
              | char `elem` "MN"       = '5'
              | char `elem` "R"        = '6'
              | otherwise              = char
\$\endgroup\$
4
\$\begingroup\$

Correctness

The algorithm is actually quite tricky to implement correctly. Your algorithm gives the wrong results for some examples in the Wikipedia article:

$$\begin{array}{l|l|l} \textrm{Name} & \textrm{Correct Soundex} & \textrm{Your result} \\ \hline \textrm{Ashcroft} & \textrm{A261} & \textrm{A226} \\ \textrm{Pfister} & \textrm{P236} & \textrm{P123} \\ \end{array}$$

Specifically, note the following rule:

Two letters with the same number separated by 'h' or 'w' are coded as a single number, whereas such letters separated by a vowel are coded twice. This rule also applies to the first letter.

As a consequence, the code must…

  • … treat "H" and "W" differently from the vowels, so char `elem` "AEIOUHWY" = '0' is wrong. I recommend using '0' to temporarily indicate the presence of a vowel, and dropping 'H' and 'W' unless it is in the initial position.
  • … lookup the digit for the first character too, to see if the next nonzero digit should be discarded. Therefore, compr = map (compress . toUpper) ame is wrong.

Style

ame and noDoub are pretty weird variable names. For a clear and idiomatic function definition, I suggest

soundex name@(n:ns) = n : take 3 (noZero ++ "000")
  where
    …

Note that result should probably be eliminated.

remDoubles could be simplified to map head . group, using the group function from Data.List. I would rename remDoubles to dedup.

compress is oddly named, as it maps one Char to exactly one Char.

I prefer imports to be more explicit about what functions are imported.

Suggested solution

import Data.Char (toUpper)
import Data.List (group)

soundex :: String -> String
soundex []   = []
soundex name = (toUpper $ head name) : nnn
  where
    dedup = map head . group
    nnn = take 3 $ (++ "000") $ filter (/= '0') $ tail $ dedup $ digitize name

digitize :: String -> String
digitize name = d : filter (/= '-') ds
  where
    digitFor c
      | c `elem` "AEIOUY"   = '0'
      | c `elem` "BFPV"     = '1'
      | c `elem` "CGJKQSXZ" = '2'
      | c `elem` "DT"       = '3'
      | c `elem` "L"        = '4'
      | c `elem` "MN"       = '5'
      | c `elem` "R"        = '6'
      | otherwise           = '-'   -- 'H', 'W', and punctuation
    (d:ds) = map (digitFor . toUpper) name

Note that the order of the chain of functions used to define nnn is critical. Yours was closer to…

nnn = take 3 $ (++ "000") $ filter (/= '0') $ dedup $ digitize $ tail name

… which explains the "Pfister" bug.

To address the "Ashcroft" bug, I've rewritten compress as digitize, which can return a shorter string that drops output corresponding to a non-initial 'H' and 'W'.

\$\endgroup\$
6
  • \$\begingroup\$ I added a link to the textbook I'm using. The author admits, hidden in "References", to using his own version. \$\endgroup\$
    – user2740
    Jan 27 '16 at 0:19
  • \$\begingroup\$ I can't change only 2 chars, so I comment: I strongly believe it has to be dedup = map head $ group \$\endgroup\$
    – user2740
    Jan 27 '16 at 0:26
  • \$\begingroup\$ No, it is written as intended. It's the point-free style of dedup str = map head $ group str. \$\endgroup\$ Jan 27 '16 at 0:27
  • \$\begingroup\$ Oh, I see. I tried map head . group "Missisippi" in ghci, but I have to try (map head . group) "Missisippi" of course. \$\endgroup\$
    – user2740
    Jan 27 '16 at 0:30
  • \$\begingroup\$ I would replace digitize by lpaste.net/940008100159553536 , though note that your d might be '-', which isn't possible for me. \$\endgroup\$
    – Gurkenglas
    Jan 27 '16 at 13:50

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.