From: Robert Minter Subject: Re: Metaphone To: Walt Hultgren {rmy} Date: Fri, 17 Nov 1995 14:06:40 -0800 (PST) * Michael Kuhn and I have been discussing his Metaphone 4GL code. He is going * to place a copy in the FTP archive that I maintain on mathcs.emory.edu. He * mentioned that you had sent him some of your code that implements the same * algorithm. I would like to have a copy of your code for the archive also * if you don't mind. If you would be willing to do that, please let me know. Sure, however, it is a (modified) version of the Metaphone routine. It works the basically the same as the original routine, though. Much simplier. --v-- SNIP --v-- SNIP --v-- SNIP --v-- SNIP --v-- SNIP --v-- SNIP --v-- #------------------------------------------------------------------------------ # Module: meta_ph.4gl # # Hacked version of metaphone routine #------------------------------------------------------------------------------ DEFINE meta_len SMALLINT, org_name CHAR(50) #---------------------------------------------------------------------------- # Metaphone() - Public function #---------------------------------------------------------------------------- FUNCTION Metaphone(pass_name) DEFINE pass_name CHAR(50), idx SMALLINT, new_char SMALLINT, ret_name CHAR(50) -- Initialization LET pass_name = UPSHIFT(pass_name) LET org_name = "" -- Parse out unwanted's FOR idx = 1 TO LENGTH(pass_name) IF pass_name[idx] MATCHES "[A-Za-z0-9]" THEN LET org_name = org_name CLIPPED, pass_name[idx] END IF END FOR -- If no length, return IF NOT LENGTH(org_name) THEN RETURN "" END IF -- More initialization LET meta_len = LENGTH(org_name) LET ret_name = org_name[1] -- Main loop to generate metaphone FOR idx = 2 TO meta_len IF org_name[idx] NOT MATCHES "[0-9]" THEN LET ret_name = ret_name CLIPPED, DoLogic(idx) END IF END FOR RETURN ret_name END FUNCTION #------------------------------------------------------------------------------ # do_logic - Private to module #------------------------------------------------------------------------------ FUNCTION DoLogic(this_idx) DEFINE this_idx SMALLINT, this_char CHAR, hard SMALLINT LET this_char = org_name[this_idx] CASE WHEN this_char = "B" IF this_idx = meta_len THEN IF org_name[this_idx - 1] != "M" THEN RETURN this_char END IF ELSE RETURN this_char END IF WHEN this_char = "C" IF this_idx + 1 <= meta_len THEN IF org_name[this_idx - 1] = "S" AND org_name[this_idx + 1] MATCHES "[EIY]" THEN RETURN "" END IF END IF IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 1] = "I" and org_name[this_idx + 2] = "A" then RETURN "X" END IF END IF IF this_idx < meta_len THEN IF org_name[this_idx + 1] MATCHES "[EIY]" THEN RETURN "S" END IF IF org_name[this_idx + 1] = "H" AND org_name[this_idx - 1] = "S" THEN RETURN "K" END IF IF org_name[this_idx + 1] = "H" THEN IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 2] MATCHES "[AEIOU]" THEN RETURN "K" ELSE RETURN "X" END IF ELSE RETURN "X" END IF END IF END IF RETURN "K" WHEN this_char = "D" IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 1] = "G" AND org_name[this_idx + 2] MATCHES "[EIY]" THEN RETURN "J" END IF END IF RETURN "T" WHEN this_char = "G" IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 1] = "H" AND org_name[this_idx + 2] MATCHES "[AEIOUT]" THEN RETURN "" END IF END IF IF this_idx + 1 = meta_len THEN IF org_name[this_idx + 1] = "N" THEN RETURN "" END IF END IF IF this_idx + 3 = meta_len THEN IF org_name[this_idx + 1] = "N" AND org_name[this_idx + 2] = "E" AND org_name[this_idx + 3] = "D" THEN RETURN "" END IF END IF IF this_idx + 1 <= meta_len THEN IF org_name[this_idx - 1] = "D" AND org_name[this_idx + 1] MATCHES "[EIY]" THEN RETURN "" END IF END IF IF this_idx < meta_len THEN IF org_name[this_idx + 1] MATCHES "[EIY]" THEN RETURN "J" END IF END IF RETURN "K" WHEN this_char = "H" IF this_idx = meta_len THEN RETURN "" END IF IF org_name[this_idx - 1] MATCHES "[CSPTG]" THEN RETURN "" END IF IF this_idx + 1 <= meta_len THEN IF org_name[this_idx + 1] MATCHES "[AEIOU]" THEN RETURN this_char END IF END IF WHEN this_char = "K" IF org_name[this_idx - 1] NOT MATCHES "[0-9]" THEN RETURN this_char END IF WHEN this_char = "P" IF this_idx < meta_len THEN IF org_name[this_idx + 1] = "H" THEN RETURN "F" END IF END IF RETURN this_char WHEN this_char = "Q" RETURN "K" WHEN this_char = "S" IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 1] = "I" AND org_name[this_idx + 2] MATCHES "[AO]" THEN RETURN "X" END IF END IF IF this_idx < meta_len THEN IF org_name[this_idx + 1] = "H" THEN RETURN "X" END IF END IF RETURN this_char WHEN this_char = "T" IF this_idx + 2 <= meta_len THEN IF org_name[this_idx + 1] = "I" AND org_name[this_idx + 2] MATCHES "[AO]" THEN RETURN "X" END IF IF org_name[this_idx + 1] = "C" AND org_name[this_idx + 2] = "H" THEN RETURN "" END IF END IF IF this_idx < meta_len THEN IF org_name[this_idx + 1] = "H" THEN IF org_name[this_idx - 1] = "T" THEN RETURN "" ELSE RETURN "O" END IF END IF END IF RETURN this_char WHEN this_char = "W" OR this_char = "Y" IF this_idx < meta_len THEN IF org_name[this_idx + 1] MATCHES "[AEIOU]" THEN RETURN this_char END IF END IF OTHERWISE IF this_char MATCHES "[A-Z]" AND this_char NOT MATCHES "[AEIOU]" THEN RETURN this_char END IF END CASE RETURN "" END FUNCTION --^-- SNIP --^-- SNIP --^-- SNIP --^-- SNIP --^-- SNIP --^-- SNIP --^-- Robert Minter Data Systems Support \\\_/// Senior Software Engineer A Client Technologies Company ( _ _ ) E-Mail: rob@dssmktg.com Tel: 714.771.0454 (| ^ |) #include Fax: 714.771.3028 \`-'/ De Colores - Emmaus OC-13 SURF'S UP \_/