Mega Code Archive
Soundex Searching Strings by the way they sound
<![CDATA[
Title: Soundex - Searching Strings by the way they sound
Question: Did you ever want to find a string - But were not sure of it's spelling? A typical case would be names (Micael/Maical/Michael/Maichael) all sound same but differ in spelling!
Answer:
Most of you may already be familiar with the magical "Soundex" function which is present in many Db environments ranging from FoxPro to Oracle/SQL Server. Few of you may wonder how it works! Well, here is the implementation of the Soundex function in Pascal based on an algorithm that I found in a computer magazine long time back. The original program worked in Turbo Pascal, but I have modified it for Delphi (The only change being use of ShortString instead of String!)
The function seems to return the same values as does SQL Server for the little tests that I conducted. However, as you will have already guessed, I provide you no gurantee that it will provide same values for all strings.
Please save the code below in a file called Soundx.pas. You will need to include the file in your source (Uses Soundx) and then you will have access to the Soundex() function.
For the example given in the Question/Problem/Abstract, Soundex returns the same value (M240) for each of Micael/Maical/Michael/Maichael
Wishing you all a "Sound" search (Ha!)
PS: I have since improved this program which can be found at http://www.delphi3000.com/article.asp?ID=1607
{******************************************************}
{* Description: Implementation of Soundex function *}
{******************************************************}
{* Last Modified : 12-Nov-2000 *}
{* Author : Paramjeet Singh Reen *}
{* eMail : Paramjeet.Reen@EudoraMail.com *}
{******************************************************}
{* This program is based on the algorithm that I had *}
{* found in a magazine. I do not gurantee the fitness *}
{* of this program. Please use it at your own risk. *}
{******************************************************}
{* Category :Freeware. *}
{******************************************************}
unit Soundx;
interface
type
SoundexStr = String[4];
//Returns the Soundex code for the specified string.
function Soundex(const InpStr :ShortString):SoundexStr;
implementation
const
Alphs :array['A'..'Z'] of Char = ('0','1','2','3','0','1','2','0','0','2','2',
'4','5','5','0','1','2','6','2','3','0','1',
'0','2','0','2');
function Soundex(const InpStr :ShortString) :SoundexStr;
var
vStr :ShortString;
vCh1 :Char;
i :Word;
begin
//Store the given InpStr in local variable in uppercase
vStr := '';
for i := 1 to Length(InpStr) do vStr := vStr + UpCase(InpStr[i]);
//Replace all occurances of "PH" with "F"
i := Pos('PH',vStr);
while(i 0) do
begin
Delete(vStr,i,2);
Insert('F',vStr,i);
i := Pos('PH',vStr);
end;
//Replace all occurances of "CHR" with "CR"
i := Pos('CHR',vStr);
while(i 0) do
begin
Delete(vStr,i,3);
Insert('CR',vStr,i);
i := Pos('CHR',vStr);
end;
//Replace all occurances of "Z" with "S"
for i := 1 to Length(vStr) do
if(vStr[i] = 'Z')
then vStr[i] := 'S';
//Replace all occurances of "X" with "KS"
i := Pos('X',vStr);
while(i 0) do
begin
Delete(vStr,i,1);
Insert('KS',vStr,i);
i := Pos('X',vStr);
end;
//Remove all adjacent duplicates
i := 2;
while(i if(vStr[i] = vStr[i-1])
then Delete(vStr,i,1)
else Inc(i);
//Starting from 2nd char, remove all chars mapped to '0' in Alphs table
i := 2;
while(i if(Alphs[vStr[i]] = '0')
then Delete(vStr,i,1)
else Inc(i);
//Assemble Soundex string from Alphs table
vCh1 := vStr[1];
for i := 1 to Length(vStr) do vStr[i] := Alphs[vStr[i]];
//Remove all adjacent duplicates from assembled Soundex string
i := 2;
while(i if(vStr[i] = vStr[i-1])
then Delete(vStr,i,1)
else Inc(i);
//Final assembly of Soundex string
vStr := vCh1 + Copy(vStr,2,255);
for i := Length(vStr) to 3 do vStr := vStr + '0';
Soundex := vStr;
end;
end.
]]>