American Soundex

[rdonnay]

Does anyone have Xbase++ code for the American Soundex algorithm? - https://en.wikipedia.org/wiki/Soundex

I am helping convert an old Clipper app that also shares data with FoxPro 2.6 and VFP apps.
They rely on Soundex for fast search, whereas the only Soundex code I have is wrong about 10% of the time.

[rdonnay]

I followed the algorithm as much as I could understand it and now the below code seems to match the Foxpro and VFP implementions nearly 100%.

Code: Select all

FUNCTION Soundex(cWord)

LOCAL cSoundex, i, nLast, cChar, nCode, nZero := 0, nFill := 0,  cVowel := ''

cWord:=ALLTRIM(UPPER(cWord))

cSoundex:=LEFT(cWord, 1)        // first letter is first char

cWord := Strtran(cWord,'SCH','S')

nLast := SoundexCode(cSoundex)

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
     cVowel += '0'
     LOOP
   ENDIF

   IF nCode#nLast .OR. Len(cVowel) > 1
     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)