home *** CD-ROM | disk | FTP | other *** search
/ Programming Tool Box / SIMS_2.iso / bp_6_93 / bonus / winer / soundex.bas < prev    next >
BASIC Source File  |  1992-05-12  |  2KB  |  82 lines
  1. '********** SOUNDEX.BAS - Soundex routines and example
  2.  
  3. 'Copyright (c) 1992 Ethan Winer
  4.  
  5. DEFINT A-Z
  6.  
  7. DECLARE FUNCTION ASoundex$ (Word$)
  8. DECLARE FUNCTION ISoundex% (Word$)
  9.  
  10. CLS
  11. DO
  12.   PRINT "press Enter alone to exit"
  13.   INPUT "What is the first word"; FWord$
  14.   IF LEN(FWord$) = 0 THEN EXIT DO
  15.   INPUT "What is the second word"; SWord$
  16.   PRINT
  17.  
  18.   'Test by alph-numeric soundex
  19.   PRINT "Alpha-Numeric Soundex: "; FWord$; " and "; SWord$; " do ";
  20.   IF ASoundex$(FWord$) <> ASoundex$(SWord$) THEN PRINT "NOT ";
  21.   PRINT "sound the same."
  22.   PRINT
  23.  
  24.   'Test by numeric soundex
  25.   PRINT "      Numeric Soundex: "; FWord$; " and "; SWord$; " do ";
  26.   IF ISoundex%(FWord$) <> ISoundex%(SWord$) THEN PRINT "NOT ";
  27.   PRINT "sound the same."
  28.   PRINT
  29. LOOP
  30.  
  31. FUNCTION ASoundex$ (InWord$) STATIC
  32.  
  33.   Word$ = UCASE$(InWord$)
  34.   Work$ = LEFT$(Word$, 1) + "000"
  35.   WkPos = 2
  36.   PrevCode = 0
  37.  
  38.   FOR L = 2 TO LEN(Word$)
  39.     Temp = INSTR("BFPVCGJKQSXZDTLMNR", MID$(Word$, L, 1))
  40.     IF Temp THEN
  41.       Temp = ASC(MID$("111122222222334556", Temp, 1))
  42.       IF Temp <> PrevCode THEN
  43.         MID$(Work$, WkPos) = CHR$(Temp)
  44.         PrevCode = Temp
  45.         WkPos = WkPos + 1
  46.         IF WkPos > 4 THEN EXIT FOR
  47.       END IF
  48.     ELSE
  49.       PrevCode = 0
  50.     END IF
  51.   NEXT
  52.  
  53.   ASoundex$ = Work$
  54.  
  55. END FUNCTION
  56.  
  57. FUNCTION ISoundex% (InWord$) STATIC
  58.  
  59.   Word$ = UCASE$(InWord$)
  60.   Work$ = "0000"
  61.   WkPos = 1
  62.   PrevCode = 0
  63.  
  64.   FOR L = 1 TO LEN(Word$)
  65.     Temp = INSTR("BFPVCGJKQSXZDTLMNR", MID$(Word$, L, 1))
  66.     IF Temp THEN
  67.       Temp = ASC(MID$("111122222222334556", Temp, 1))
  68.       IF Temp <> PrevCode THEN
  69.         MID$(Work$, WkPos) = CHR$(Temp)
  70.         PrevCode = Temp
  71.         WkPos = WkPos + 1
  72.         IF WkPos > 4 THEN EXIT FOR
  73.       END IF
  74.     ELSE
  75.       PrevCode = 0
  76.     END IF
  77.   NEXT
  78.  
  79.   ISoundex% = VAL(Work$)
  80.  
  81. END FUNCTION
  82.