home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / qtawk / soundx4.exp < prev    next >
Encoding:
Text File  |  1990-04-23  |  2.9 KB  |  87 lines
  1. # QTAwk Soundix Algorithm
  2. #
  3. # Optimized Soundix Algorithm. Adapted for QTAwk from article in:
  4. # "The C Gazette", Vol. 4, No. 2, Autumn 1989, page 29, by Joe Celko
  5. #
  6. BEGIN {
  7.     sl = 4; # set code length
  8. }
  9.  
  10.     {
  11.     for ( i = 1 ; i <= NF ; i++ ) printf(" Result: %s ==> %s\n",$i,soundix4($i,sl));
  12. }
  13.  
  14. function soundix4(inname,len) {
  15.     local workbuf;
  16.     local leading_letter;
  17.  
  18.     #* make a working copy
  19.     workbuf = strupr(inname);
  20.  
  21.     #* convert all vowels to 'A'
  22.     gsub(/[AEIOUY]/,'A',workbuf);
  23.  
  24.     #* prefix transformations: done only once on the front of a name
  25.     sub(/^MAC/,"MCC",workbuf);      # MAC -> MCC
  26.     sub(/^KN/ ,"NN" ,workbuf);      # KN  -> NN
  27.     sub(/^PF/ ,"FF" ,workbuf);      # PF  -> FF
  28.     sub(/^SCH/,"SSS",workbuf);      # SCH -> SSS
  29.     sub(/^K/  ,'C'  ,workbuf);      # K   -> C
  30.  
  31.     #* preserve leading letter
  32.     leading_letter = substr(workbuf,1,1);
  33.     workbuf = substr(workbuf,2);
  34.  
  35.     #* infix transformations: done after the first letter
  36.     #* and are from left to right on the name
  37.     gsub(/DG/  ,"GG"  ,workbuf);    # DG   -> GG
  38.     gsub(/CAAN/,"TAAN",workbuf);    # CAAN -> TAAN
  39.     gsub(/D/   ,'T'   ,workbuf);    # D    -> T
  40.     gsub(/NST/ ,"NSS" ,workbuf);    # NST  -> NSS
  41.     gsub(/AV/  ,"AF"  ,workbuf);    # AV   -> AF
  42.     gsub(/Q/   ,'G'   ,workbuf);    # Q    -> G
  43.     gsub(/Z/   ,'S'   ,workbuf);    # Z    -> S
  44.     gsub(/M/   ,'N'   ,workbuf);    # M    -> N
  45.     gsub(/KN/  ,"NN"  ,workbuf);    # KN   -> NN
  46.     gsub(/K/   ,'C'   ,workbuf);    # K    -> C
  47.     gsub(/AH/  ,"AA"  ,workbuf);    # AH   -> AA
  48.     gsub(/HA/  ,"AA"  ,workbuf);    # HA   -> AA
  49.     gsub(/AW/  ,"AA"  ,workbuf);    # AW   -> AA
  50.     gsub(/PH/  ,"FF"  ,workbuf);    # PH   -> FF
  51.     gsub(/SCH/ ,"SSS" ,workbuf);    # SCH  -> SSS
  52.  
  53.     #* suffix transformations: done on the end of the word going right to left
  54.     #* (1) remove terminal A's and S's
  55.     sub(/[AS]+$/,"",workbuf);
  56.  
  57.     #* (2) terminal NT-> TT
  58.     sub(/NT$/,"TT",workbuf);
  59.  
  60.     #* now strip out all vowels except the first - remember that all vowels
  61.     #* were transformed to 'A' earlier
  62.     gsub(/A/,"",workbuf);
  63.  
  64.     #* remove all duplicate letters.
  65.     #* Note this is different from the Soundex3 duplicate cleanup because
  66.     #* the letter transforms can create duplicates at the front of the
  67.     #* output name
  68.     gsub(/B+/,'B',workbuf);
  69.     gsub(/C+/,'C',workbuf);
  70.     gsub(/F+/,'F',workbuf);
  71.     gsub(/H+/,'H',workbuf);
  72.     gsub(/G+/,'G',workbuf);
  73.     gsub(/J+/,'J',workbuf);
  74.     gsub(/L+/,'L',workbuf);
  75.     gsub(/N+/,'N',workbuf);
  76.     gsub(/P+/,'P',workbuf);
  77.     gsub(/R+/,'R',workbuf);
  78.     gsub(/S+/,'S',workbuf);
  79.     gsub(/T+/,'T',workbuf);
  80.     gsub(/V+/,'V',workbuf);
  81.     gsub(/W+/,'W',workbuf);
  82.     gsub(/X+/,'X',workbuf);
  83.  
  84.     #* return proper length code
  85.     return leading_letter ∩ (len ? substr(workbuf,1,len - 1) : workbuf);
  86. }
  87.