home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / soundex.cmd < prev    next >
OS/2 REXX Batch file  |  1994-08-16  |  4KB  |  115 lines
  1. /*        */
  2. /* 
  3. Soundex.cmd :  A REXX program that takes a name and reduces it to a 
  4. token based on the fact that some letters seem to 'sound' alike. It 
  5. was used in a name search for a corporate mail pilot based on a REXX 
  6. Gopher server and DB2/2. The results of this routine were stored in the 
  7. database along with the name.
  8.  
  9.         usage is : SOUNDEX nnnnnnn ddd
  10.             where: nnnnnnn is the name to be tokenized
  11.                  : ddd is the debug flag  Y or Yes displays intermediate
  12.                                              steps 
  13.                                           N or No doesn't display anything. 
  14.                  : SOUNDEX
  15.                     displays this text.
  16.         
  17.                    Command entered       Returns
  18.                    ===============       =========
  19.         Example  : SOUNDEX BILL  Y       B44
  20.                  : SOUNDEX BILLY Y       B44
  21.                  : SOUNDEX BILLIE Y      B44
  22.                  : SOUNDEX BILLY-RAY     B446
  23.                  : SOUNDEX LORI Y        L4
  24.                  : SOUNDEX LAURIE Y      L4
  25.  
  26.         It only 'works' for english although you could tailor it to 
  27.         another language by re-weighting the tokens. I have also used
  28.         it by converting a substring and matching it using a LIKE in 
  29.         DB2/2.
  30.  
  31.         Authors:Bill Dickenson/Valerie Dickenson
  32.                 Random Software
  33.                 118 North Dillwyn Rd
  34.                 Newark, De 19711
  35.                 (302) 737-9123
  36.  
  37.        No warrenty expressed or implied. It may not work at all for you 
  38.        but could be interesting. If you think up some improvements on this
  39.        I'd appreciate seeing a re-post.
  40. */
  41.  
  42. YES = 'Y'; NO = 'N';NULL = ''
  43. Alpha = xrange('A','Z')
  44. AllChars = Alpha||xrange('00'x, 'FF'x)
  45. dlen = 25
  46. arg in_name debug .
  47.  
  48. if strip(in_name) = NULL
  49. then signal showhelp
  50.  
  51. debug = translate(substr(debug,1,1))
  52. if debug <> YES then debug = NO
  53.  
  54. name.0 = NULL
  55. name.1 = translate(in_name)            /*   Make it all upper case   */
  56. fchar = substr(name.1,1,1)             /*   Take the first character */
  57.                                        /*   Must be alpha            */
  58. name.2 = substr(name.1,2)              /*   Get rest of name         */
  59.  
  60. /* Eliminate AEHIOUWY from string. Keeps the sound simple  */
  61.  
  62. name.2 = STRIP(translate(name.2,,'AEHIOUWY'))
  63.  
  64. /*   dump non-alpha characters  */
  65. /*   Thanks to  Tom Bridgman, Watson Systems Engineering Services (OS/2)
  66.      for clearing up some points around translate and for suggesting 
  67.      xrange to create Alpha and AllChars
  68. */
  69. name.3 = name.2
  70. rc = verify(name.2,alpha)
  71. if rc <> 0 
  72. then do
  73.     name.0 = 'Special Characters found'
  74.     name.3 = NULL
  75.     name.22 = translate(name.2, Alpha, AllChars)
  76.     wordloop = words(name.22)
  77.     do x = 1 to wordloop
  78.        name.3 = name.3||word(name.22,x)
  79.     end
  80. end
  81.  
  82. /*    create the weights and create the string     */
  83.  
  84. name.4 = translate(name.3,'1111','BFPV')
  85. name.4 = translate(name.4,'22222222','CGJKQSXZ')
  86. name.4 = translate(name.4,'33','DT')
  87. name.4 = translate(name.4,'4','L')
  88. name.4 = translate(name.4,'55','MN')
  89. name.4 = translate(name.4,'6','R')
  90.  
  91.  
  92. name.5 = fchar||name.4
  93.  
  94. if debug = YES 
  95. then do
  96.      say Left('Input was ',dlen) in_name
  97.      say left('Convert upper case',dlen) name.1
  98.      say Left('First letter',dlen) fchar
  99.      say left('Drop vowels',dlen) name.2
  100.      if name.0 <> NULL then say left('Drop special characters',dlen) name.3
  101.      say left('Tokenize rest',dlen) name.4
  102.      say left('Build Result',dlen)  name.5
  103. end
  104. return(name.5)
  105.  
  106. showhelp:
  107.  
  108. do x = 9 to 20
  109.     say sourceline(x)
  110. end
  111. say 
  112. do x = 31 to 36
  113.     say sourceline(x)
  114. end
  115. return(0)