'===========================================================================
' Subject: PHONETIC SEARCH                    Date: 01-30-98 (17:19)       
'  Author: Ian Campbell                       Code: QB, QBasic, PDS        
'  Origin: dm.campbell@ns.sympatico.ca      Packet: ALGOR.ABC
'===========================================================================
'PHONETIC SEARCH
'Ian Campbell
'30/1/98
'
'       This is a phonetic search, similar to the SOUNDEX algorithm... I
' made a few changes (First letter coded) so that it would match "phone" and
' "fone"
'
'       It isn't perfect, it won't get "best" and "west", but it works for
' the majority of cases...
'
' For better or for worse, here's the Phonetic Search

code1$ = "nbfpv"                        ' Change
code2$ = "cgjkqsxz"                     ' These
code3$ = "dt"                           ' If
code4$ = "l"                            ' You
code5$ = "m"                            ' Want
code6$ = "r"                            ' Different
notcode$ = "aeiouwhy"                   ' Results


word1$ = "best"
word2$ = "west"

FOR x = 1 TO LEN(word1$)
temp$ = MID$(word1$, x, 1)
IF temp$ = oldtemp$ THEN GOTO label
IF INSTR(code1$, temp$) THEN code$ = code$ + "1"
IF INSTR(code2$, temp$) THEN code$ = code$ + "2"
IF INSTR(code3$, temp$) THEN code$ = code$ + "3"
IF INSTR(code4$, temp$) THEN code$ = code$ + "4"
IF INSTR(code5$, temp$) THEN code$ = code$ + "5"
IF INSTR(code6$, temp$) THEN code$ = code$ + "6"
IF INSTR(notcode$, temp$) THEN GOTO label

label:
oldtemp$ = temp$

NEXT
PRINT code$