Soundex is an algorithm for creating indices for words based on their pronunciation.



Task

The goal is for homophones to be encoded to the same representation so that they can be matched despite minor differences in spelling   (from the   soundex   Wikipedia article).

Caution

There is a major issue in many of the implementations concerning the separation of two consonants that have the same soundex code! According to the official Rules [[1]]. So check for instance if Ashcraft is coded to A-261.

 If a vowel (A, E, I, O, U) separates two consonants that have the same soundex code, the consonant to the right of the vowel is coded. Tymczak is coded as T-522 (T, 5 for the M, 2 for the C, Z ignored (see "Side-by-Side" rule above), 2 for the K). Since the vowel "A" separates the Z and K, the K is coded.
 If "H" or "W" separate two consonants that have the same soundex code, the consonant to the right of the vowel is not coded. Example: Ashcraft is coded A-261 (A, 2 for the S, C ignored, 6 for the R, 1 for the F). It is not coded A-226.


code CrLf=9, Text=12;
string 0;               \use zero-terminated strings
 
func Soundex(S1);       \Convert name to Soundex string (e.g: Rubin = R150)
char S1;
char S2(80), Tbl;
int  I, J, Char, Dig, Dig0;
[     \abcdefghijklmnopqrstuvwxyz
Tbl:= "01230120022455012623010202";
I:= 0;  J:= 0;                                  \convert all letters to digits
repeat  Char:= S1(I);  I:= I+1;
        if Char>=^A & Char<=^Z then             \convert letter to lowercase
            Char:= Char + $20;
        if Char>=^a & Char<=^z &                \eliminate non letters
           Char#^h & Char#^w then               \eliminate h and w
            [Dig:= Tbl(Char-^a);                \convert letter to digit
            if Dig#^0 & Dig#Dig0 ! J=0 then     \filter out zeros and doubles
                [S2(J):= Dig;  J:= J+1];        \ but always store first digit
            Dig0:= Dig;                         \save digit to detect doubles
            ];
until   S1(I) = 0;
while J<4 do [S2(J):= ^0;  J:= J+1];            \pad with zeros to get 3 digits
S2(0):= S1(0) & ~$20;  S2(4):= 0;               \insert first letter & terminate
return S2;                                      \BEWARE: very temporary string
];
 
int I, Name;
[Name:=["Ashcraft", "Ashcroft", "de la Rosa", "Gauss", "Ghosh", "Heilbronn",
        "Hilbert", "Knuth", "Lee", "Lloyd", "Moses", "O'Hara", "Pfister",
        "R2-D2", "Robert", "Rubin", "Rupert", "Tymczak", "Soundex", "Example"];
for I:= 0 to 20-1 do
        [Text(0, Soundex(Name(I)));  Text(0, " ");
        Text(0, Name(I));  CrLf(0);
        ];
]