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.


    PROC soundex = (STRING s) STRING:
    BEGIN
        PROC encode = (CHAR c) CHAR:
        BEGIN
            # We assume the alphabet is contiguous. #
            "-123-12*-22455-12623-1*2-2"[ABS to lower(c) - ABS "a" + 1]
        END;
        INT soundex code length = 4;
        STRING result := soundex code length * "0";
        IF s /= "" THEN
            CHAR previous;
            INT  j;
            result[j := 1] := s[1];
            previous := encode(s[1]);
            FOR i FROM 2 TO UPB s WHILE j < soundex code length
            DO
                IF is alpha(s[i]) THEN
                    CHAR code = encode(s[i]);
                    IF is digit(code) AND code /= previous THEN
                        result[j +:= 1] := code;
                        previous := code
                    ELIF code = "-" THEN
                        # Only vowels (y counts here) hide the last-added character #
                        previous := code
                    FI
                FI
            OD
        FI;
        result
    END;
 
    # Test code to persuade one that it does work. #
 
    MODE TEST = STRUCT (STRING input, STRING expected output);
 
    [] TEST soundex test = (
        ("Soundex",    "S532"), ("Example",     "E251"),
        ("Sownteks",   "S532"), ("Ekzampul",    "E251"),
        ("Euler",      "E460"), ("Gauss",       "G200"),
        ("Hilbert",    "H416"), ("Knuth",       "K530"),
        ("Lloyd",      "L300"), ("Lukasiewicz", "L222"),
        ("Ellery",     "E460"), ("Ghosh",       "G200"),
        ("Heilbronn",  "H416"), ("Kant",        "K530"),
        ("Ladd",       "L300"), ("Lissajous",   "L222"),
        ("Wheaton",    "W350"), ("Burroughs",   "B620"),
        ("Burrows",    "B620"), ("O'Hara",      "O600"),
        ("Washington", "W252"), ("Lee",         "L000"),
        ("Gutierrez",  "G362"), ("Pfister",     "P236"),
        ("Jackson",    "J250"), ("Tymczak",     "T522"),
        ("VanDeusen",  "V532"), ("Ashcraft",    "A261")
    );
 
    #
      Apologies for the magic number in the padding of the input
      and the wired-in heading.
    #
 
    print(("Test name   Code Got", newline, "----------------------", newline));
    FOR i FROM LWB soundex test TO UPB soundex test
    DO
        STRING output = soundex(input OF soundex test[i]);
        printf(($g, n (12 - UPB input OF soundex test[i]) x$, input OF soundex test[i]));
        printf(($g, 1x, g, 1x$, expected output OF soundex test[i], output));
        printf(($b("ok", "not ok"), 1l$, output = expected output OF soundex test[i]))
    OD