home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / clarion / library / soundx / soundex.cla < prev    next >
Text File  |  1989-01-31  |  2KB  |  93 lines
  1.     member ('test')
  2.  
  3.  
  4.   omit ('**end**')
  5. ------------------------------------------------------------------------------
  6.  
  7. Name        soundex - determines soundex value for a given string
  8.  
  9. Usage        func (soundex), string
  10.  
  11. Description    This soundex value will be the same as values for
  12.         similar sounding names. The code consists of the first
  13.         letter of the name, followed by three digits.
  14.  
  15.         Developed with Clarion 2.0, batch 2006
  16.  
  17. Return value    soundex returns a string(5) containing the
  18.         computed soundex value of the string passed.
  19.  
  20. Example        s1#=soundex ('MacKew')
  21.         s2#=soundex ('McQue')
  22.         if s1# <> s2#        ! should sound alike
  23.           mem:msg='Does NOT sound alike'
  24.         else
  25.           mem:msg='Do sound alike'
  26.         .
  27.  
  28.  
  29. Author        Paul Giroux  01-Feb-89
  30.           BIX: pgiroux
  31.           CompuServe: 72007,3677
  32.           FidoNet: 1:167/106.0
  33.  
  34. ------------------------------------------------------------------------------
  35. **end**
  36.  
  37.  
  38. soundex function (str)
  39. str string(30)
  40.  
  41. str_i byte, dim (30), over (str)
  42.  
  43. sound    string (5)
  44. snd_i    byte, dim (5), over (sound)
  45.  
  46. strlen    long
  47.  
  48. !         ABCDEFGHIJKLMNOPQRSTUVWXYZ
  49. sndx    string ('01230120022455012623010202')
  50. sndx_i    byte, dim (26), over (sndx)
  51.  
  52.  
  53.  
  54.     code
  55.  
  56.     sound = 'A0000'                    ! initialize return string
  57.  
  58.     str = upper(str)                ! convert to upper case
  59.     strlen# = len (clip(str))
  60.  
  61.     snd_i[1] = str_i[1]                ! assign first char to result
  62.     cnt#=2                        ! initialize count
  63.     loop i# = 2 to strlen#                ! loop for length of string
  64.  
  65.         d# = str_i[i#]                ! eliminate double letters
  66.         if d# = str_i[i#+1]            ! such as tt, rr, ss..
  67.             cycle
  68.         .
  69.  
  70.         k# = d# - 65 + 1            ! 65 = val ('A'); get
  71.         if (k# < 1) or (k# > 26)        ! position in sndx array;
  72.           cycle                    ! check for bounds overflow
  73.         .
  74.  
  75.         c# = sndx_i[k#]                ! get element of sndx array
  76.         if c# <> 48                ! 48=val ('0')=don't care
  77.             snd_i[cnt#] = c#        ! assign to result
  78.             cnt# += 1            ! inc count
  79.         .
  80.         if cnt# = 6 then break.;        ! we want 5 chars in all
  81.     .
  82.     return (sound)                    ! return soundex string
  83.  
  84.  
  85.  
  86.  
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.