Soundex is an algorithm for creating indices for words based on their pronunciation.



Task

The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling   (from the   soundex   Wikipedia article).

Caution

There is a major issue in many of the implementations concerning the separation of two consonants that have the same soundex code! According to the official Rules [[1]]. So check for instance if Ashcraft is coded to A-261.

 If a vowel (A, E, I, O, U) separates two consonants that have the same soundex code, the consonant to the right of the vowel is coded. Tymczak is coded as T-522 (T, 5 for the M, 2 for the C, Z ignored (see "Side-by-Side" rule above), 2 for the K). Since the vowel "A" separates the Z and K, the K is coded.
 If "H" or "W" separate two consonants that have the same soundex code, the consonant to the right of the vowel is not coded. Example: Ashcraft is coded A-261 (A, 2 for the S, C ignored, 6 for the R, 1 for the F). It is not coded A-226.


FUNCTION Soundex(cWord)
 
 /*
 
 This is a Clipper/XBase++ implementation of the standard American Soundex procedure. 
 
 */
LOCAL cSoundex, i, nLast, cChar, nCode
 
cWord:=ALLTRIM(UPPER(cWord))
cSoundex:=LEFT(cWord, 1)        // first letter is first char
nLast:=-1
FOR i:=2 TO LEN(cWord)
   cChar:=SUBSTR(cWord, i, 1)   // get char
   nCode:=SoundexCode(cChar)    // get soundex code for char
   IF nCode=0                   // if 0, ignore
      LOOP
   ENDIF
   IF nCode#nLast               // if not same code, add to soundex
      nLast:=nCode              // and replace the last one
      cSoundex+=STR(nCode, 1)
   ENDIF
NEXT
cSoundex:=PADR(cSoundex, 4, "0")
 
RETURN(cSoundex)
 
*******************************************************************************
STATIC FUNCTION SoundexCode(cLetter)
LOCAL aCodes:={"BFPV", "CGJKQSXZ", "DT", "L", "MN", "R"}, i, nRet:=0
 
FOR i:=1 TO LEN(aCodes)
   IF cLetter $ aCodes[i]
      nRet:=i
      EXIT
   ENDIF
NEXT
 
RETURN(nRet)
 
*******************************************************************************
FUNCTION SoundexDifference(cSound1, cSound2)
LOCAL nMatch:=0, nLen1, nLen2, i
 
nLen1:=LEN(cSound1)
nLen2:=LEN(cSound2)
 
// make the two words the same length.  This is a safety.  They both should be 4 characters long.
IF nLen1 > nLen2
   cSound2:=PADR(cSound2, nLen1-nLen2, "0")
ELSEIF nLen1 < nLen2
   cSound1:=PADR(cSound1, nLen2-nLen1, "0")
ENDIF
 
// compare the corresponding characters between the two words
FOR i:=1 TO LEN(cSound1)
   IF SUBSTR(cSound1, i, 1) == SUBSTR(cSound2, i, 1)
      ++nMatch
   ENDIF
NEXT
 
RETURN(nMatch)
 
*******************************************************************************