65 lines
1.6 KiB
Plaintext
65 lines
1.6 KiB
Plaintext
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)
|
|
|
|
*******************************************************************************
|