TEXT
Code with SOUNDEX
Urk! I thought a SOUNDEX example came with FBII... but I just searched my drive and can't find one...
So, I dug around in some _old_ programming books, and found this explanation;
1) Retain the first letter of the name
2) Drop all letters A,E,I,O,U,W,H, and Y, and one each of double letters.
3) For the next three letters remaining, assign the following numbers;
B,F,P,V : 1
C,G,J,K,Q,S,X,Z : 2
D,T : 3
L : 4
M,N : 5
R : 6
4) If less than 3 consonants are left, fill with 0's.
5) Ignore adjacent equivalent letters with the same number.
Examples: MURPHY becomes M610
WARRICK becomes W620 (RR treated as one letter, CK treated as one letter)
ANDERS, ANDERSON, ANDRESEN and AMITER all become A536.
Now, I guess you'd like _code_ to go with that... okay!
Bill
COMPILE 0,_dimmedVarsOnly _noReDimVars
DIM gt$
END GLOBALS
TRON ON
' FN zap$ completely removes ALL occurrences of zap$ from the
' source string. It is part of FnJnII, by Ariel Publishing.
' If you don't have it, you'll have to write your own...
' INPUTS: src$ - STR255: the original string
' zap$ - STR255: the string to be removed
' OUTPUT: src$ - STR255: the new "clean" string
LOCAL MODE
DIM c%, zLen%
LOCAL FN zap$(src$,zap$)
'guts removed!!! Buy FnJnII or "do it yourself!" :-)
END FN = src$
LOCAL FN Soundex$(t$)
DIM rslt$, temp$, l%, i%
t$ = UCASE$(t$)
rslt$ = LEFT$(t$,1)
t$ = RIGHT$(t$,LEN(t$)-1)
t$ = FN zap$(t$,"A")
t$ = FN zap$(t$,"E")
t$ = FN zap$(t$,"I")
t$ = FN zap$(t$,"O")
t$ = FN zap$(t$,"U")
t$ = FN zap$(t$,"W")
t$ = FN zap$(t$,"H")
t$ = FN zap$(t$,"Y")
l% = LEN(t$)
i% = 1
DO 'remove double letters
LONG IF MID$(t$,i%+1,1) = MID$(t$,i%,1)
t$ = LEFT$(t$,i%-1) + RIGHT$(t$,l%-i%)
l% = LEN(t$)
END IF
INC(i%)
UNTIL i% >= l%
l% = LEN(t$)
WHILE l% > 0
temp$ = LEFT$(t$,1)
SELECT temp$
CASE "B","F","P","V"
rslt$ = rslt$ + "1"
CASE "C","G","J","K","Q","S","X","Z"
rslt$ = rslt$ + "2"
CASE "D","T"
rslt$ = rslt$ + "3"
CASE "L"
rslt$ = rslt$ + "4"
CASE "M","N"
rslt$ = rslt$ + "5"
CASE "R"
rslt$ = rslt$ + "6"
CASE ELSE
'skip the "invalid" letter!
END SELECT
t$ = RIGHT$(t$,l%-1)
l% = LEN(t$)
WEND
t$ = rslt$ 'just so we don't have to change this code
l% = LEN(t$)
i% = 1
DO 'remove double numbers
LONG IF MID$(t$,i%+1,1) = MID$(t$,i%,1)
t$ = LEFT$(t$,i%-1) + RIGHT$(t$,l%-i%)
l% = LEN(t$)
END IF
INC(i%)
UNTIL i% >= l%
LONG IF LEN(t$) > 4
rslt$ = LEFT$(t$,4)
XELSE
t$ = t$ + "000"
rslt$ = LEFT$(t$,4)
END IF
END FN = rslt$
WINDOW 1,"TEST",(0,0)-(500,350),_docNoGrow
TEXT _geneva,12
CLS
PRINT "Testing!": PRINT
PRINT " Murphy; ";: gt$ = FN Soundex$("Murphy") : PRINT gt$
PRINT " Warrick; ";: gt$ = FN Soundex$("Warrick") : PRINT gt$
PRINT " Anders; ";: gt$ = FN Soundex$("Anders") : PRINT gt$
PRINT " Anderson; ";: gt$ = FN Soundex$("Anderson") : PRINT gt$
PRINT " Andresen; ";: gt$ = FN Soundex$("Andresen") : PRINT gt$
PRINT " Amiter; ";: gt$ = FN Soundex$("Amiter") : PRINT gt$
DO
HANDLEEVENTS
UNTIL MOUSE(_down) 'or cmd-period...
END