German Soundex „Kölner Phonetik“ SQL implementation

To all my english fellows: Since the topic discussed in this article is for the german language only I’ll post it in german language. Sorry.

Zur Ähnlichkeitssuche von Zeichenketten existieren mehrere Verfahren. Das bekannteste ist wohl Soundex, welches unter anderem auch im Advantage Database Server als Funktion implementiert ist (Online-Hilfe in der Advantage Devzone). Ein weiteres Verfahren wäre die Distanz (zB Levenstein-Distanz) zwischen zwei Zeichenketten zu messen, um so eine Ähnlichkeit festzustellen. Beide Verfahren sind aber für die deutsche Sprache wenig geeignet: Soundex ist für englisch optimiert, Levenstein würde zwei so unterschiedlich klingende Worte wie „Tier“ und „Tor“ als 2 angeben, was quasi einer Übereinstimmung entspricht.
Bereits 1969 veröffentlichte Hans Joachim Postel die „Kölner Phonetik“.

Kölner Phonetik

Die Kölner Phonetik ist ein Algorithmus, der Wörter nach Ihrem Sprachklang einen Code (Zahlenfolge) zuordnet. Er ist ähnlich dem bekannten Soundex-Verfahren, aber für die deutsche Sprache optimiert. Mehr zur Kölner Phonetik sowie dem zugrundeliegenden Algorithmus gibt es auf Wikipedia.
Über die Wikipedia stieß ich auch auf einen Link zu einer SQL Implementierung der Kölner Phonetik für Oracle. Nun war die Herausforderung, diese in eine UDF (User Defined Function) für den Advantage Database Server zu übersetzen.

Schritt 1: Umwandeln in Kleinbuchstaben und Ersetzen

Lt dem Algorithmus ist der resultierende Code unabhängig von der Schreibweise, weshalb alles in Kleinbuchstaben gewandelt wird. Zuvor wird jedoch geprüft, ob überhaupt eine verwertbare Zeichenkette (iow Länge muss größer 0 sein) vorliegt und wieviel davon ausgewertet werden soll.

checklen=coalesce(intlen,255);
Word = lower(substring(strWord,1,checkLen));
if length(Word) < 1 then return '0'; end if;

Danach werden ähnlich klingende Buchstaben und -Kombinationen sowie Umlaute ersetzt.

word=replace(word,'v','f');
word=replace(word,'w','f');
word=replace(word,'j','i');
word=replace(word,'y','i');
word=replace(word,'ph','f');
word=replace(word,'ä','a');
word=replace(word,'ö','o');
word=replace(word,'ü','u');
word=replace(word,'ß','ss');
word=replace(word,'é','e');
word=replace(word,'è','e');
word=replace(word,'à','a');
word=replace(word,'ç','c');

Schritt 2: Anlaut-Prüfung

Anlaute (also das erste Zeichen) werden gesondert behandelt und bekommen ihren Code abhängig von dem folgenden Zeichen.

If WordLen=1 Then Word=Word+' ' ; End If;
if substring(Word,1,1) = 'c' then
  -- vor a,h,k,l,o,q,r,u,x
  if position(substring(Word,2,1) in 'ahkloqrux')>0 then
    Code=Code+'4';
  else
    Code=Code+'8';
  end if;     
  intX = 2;
else
  intX = 1;
end if;

Schritt 3: Code gemäß Ersetzungstabelle erstellen

Nun wird die Zeichenkette Zeichen für Zeichen durchgegangen um anhand einer Ersetzungstabelle den Code zu erweitern. Bei manchen Zeichen gibt es je nach folgendem oder vorangegangenen Zeichen eine Sonderbehandlung.

while intx<=wordlen do
  
    if position(substring(Word,intx,1) in 'aeiou')>0 then
      Code=Code+'0';
    endif;
 
    if position(substring(Word,intx,1) in 'bp')>0 then
      Code=Code+'1';
    endif;
 
    if position(substring(Word,intx,1) in 'dt')>0 then
      -- Sonderbehandlung
      if intX<wordlen then
        if position(substring(word,intx+1,1) in 'csz')>0 then
   Code=Code+'8';
 else
   Code=Code+'2';
 end if;
      else
        Code=Code+'2';
      end if;
    endif;

    if position(substring(Word,intx,1) in 'f')>0 then
      Code=Code+'3';
    endif;

    if position(substring(Word,intx,1) in 'gkq')>0 then
      Code=Code+'4';
    endif;
 
    if position(substring(Word,intx,1) in 'c')>0 then
      -- Sonderbehandlung
      if intX<wordlen then
        if position(substring(word,intx+1,1) in 'ahkoqux')>0 then
   if position(substring(word,intx-1,1) in 'sz')>0 then
     Code=Code+'8';
   else
     Code=Code+'4';
   endif;
 else
   Code=Code+'8';
 end if;
      else
        Code=Code+'8';
      end if;
    endif;

    if position(substring(Word,intx,1) in 'x')>0 then
      -- Sonderbehandlung
      if intX>1 then
        if position(substring(word,intx-1,1) in 'ckx')>0 then
          Code=Code+'8';
 else
   Code=Code+'48';
 end if;
      else
        Code=Code+'48';
      end if;
    endif;
 
    if position(substring(Word,intx,1) in 'l')>0 then
      Code=Code+'5';
    endif;

    if position(substring(Word,intx,1) in 'mn')>0 then
      Code=Code+'6';
    endif;

    if position(substring(Word,intx,1) in 'r')>0 then
      Code=Code+'7';
    endif;

    if position(substring(Word,intx,1) in 'sz')>0 then
      Code=Code+'8';
    endif;
 
    intx=intx+1;
  end while; 

Schritt 4: Code bereinigen

Zum Schluß wird der ermittelte Code bereinigt: Es werden alle doppelt vorkommenden Codes sowie alle mit dem Wert 0 entfernt – mit Ausnahme einer 0 als erster Stelle im Code (daher ist es wichtig, dass der Rückgabewert der Function eine Zeichenkette und keine Zahl ist).

  intx=1;
  wordlen=length(code);
  phoneticcode='';
  word='';
  while intx<=wordlen do
    -- '0'-Codes entfernen
    if substring(code,intx,1)<>'0' then
      -- doppelte Codes entfernen
      if substring(code,intx,1)<>word then
        phoneticcode=phoneticcode+substring(code,intx,1);
      end if;
      word=substring(code,intx,1);
    end if;
    intx=intx+1;
  end while;

  -- '0'-Code am Wortanfang bleibt aber bestehen!
  if substring(code,1,1)='0' then
    phoneticcode='0'+phoneticcode;
  end if;

Die komplette Implementierung

--  Implementiert die Kölner Phonetic für ADS

if not exists (select * from system.functions where name like 'KoelnerPhon') then

create function KoelnerPhon(strWord string, intLen integer)
returns cichar(100)
begin
  declare Word string;
  declare WordLen integer;
  declare checkLen integer;
  declare Code string;
  declare PhoneticCode string;
  declare intX integer;
  
  checklen=coalesce(intlen,255);
  Word = lower(substring(strWord,1,checkLen));
  if length(Word) < 1 then return '0'; end if;

  -- Ersetzen von einzelnen Sonderzeichen/Kombinationen
  word=replace(word,'v','f');
  word=replace(word,'w','f');
  word=replace(word,'j','i');
  word=replace(word,'y','i');
  word=replace(word,'ph','f');
  word=replace(word,'ä','a');
  word=replace(word,'ö','o');
  word=replace(word,'ü','u');
  word=replace(word,'ß','ss');
  word=replace(word,'é','e');
  word=replace(word,'è','e');
  word=replace(word,'à','a');
  word=replace(word,'ç','c');

  WordLen=length(Word);
  Code='';

  -- Anlautprüfung
  If WordLen=1 Then Word=Word+' ' ; End If;
  if substring(Word,1,1) = 'c' then
    -- vor a,h,k,l,o,q,r,u,x
    if position(substring(Word,2,1) in 'ahkloqrux')>0 then
      Code=Code+'4';
    else
      Code=Code+'8';
    end if;     
    intX = 2;
  else
    intX = 1;
  end if;
  
  -- Code gemäß Ersetzungstabelle
  while intx<=wordlen do
  
    if position(substring(Word,intx,1) in 'aeiou')>0 then
      Code=Code+'0';
    endif;
 
    if position(substring(Word,intx,1) in 'bp')>0 then
      Code=Code+'1';
    endif;
 
    if position(substring(Word,intx,1) in 'dt')>0 then
      -- Sonderbehandlung
      if intX<wordlen then
        if position(substring(word,intx+1,1) in 'csz')>0 then
   Code=Code+'8';
 else
   Code=Code+'2';
 end if;
      else
        Code=Code+'2';
      end if;
    endif;

    if position(substring(Word,intx,1) in 'f')>0 then
      Code=Code+'3';
    endif;

    if position(substring(Word,intx,1) in 'gkq')>0 then
      Code=Code+'4';
    endif;
 
    if position(substring(Word,intx,1) in 'c')>0 then
      -- Sonderbehandlung
      if intX<wordlen then
        if position(substring(word,intx+1,1) in 'ahkoqux')>0 then
   if position(substring(word,intx-1,1) in 'sz')>0 then
     Code=Code+'8';
   else
     Code=Code+'4';
   endif;
 else
   Code=Code+'8';
 end if;
      else
        Code=Code+'8';
      end if;
    endif;

    if position(substring(Word,intx,1) in 'x')>0 then
      -- Sonderbehandlung
      if intX>1 then
        if position(substring(word,intx-1,1) in 'ckx')>0 then
          Code=Code+'8';
 else
   Code=Code+'48';
 end if;
      else
        Code=Code+'48';
      end if;
    endif;
 
    if position(substring(Word,intx,1) in 'l')>0 then
      Code=Code+'5';
    endif;

    if position(substring(Word,intx,1) in 'mn')>0 then
      Code=Code+'6';
    endif;

    if position(substring(Word,intx,1) in 'r')>0 then
      Code=Code+'7';
    endif;

    if position(substring(Word,intx,1) in 'sz')>0 then
      Code=Code+'8';
    endif;

 
    intx=intx+1;
  end while;

  -- alle '0'- und mehrfach-Codes entfernen
  intx=1;
  wordlen=length(code);
  phoneticcode='';
  word='';
  while intx<=wordlen do
    -- '0'-Codes entfernen
    if substring(code,intx,1)<>'0' then
      -- doppelte Codes entfernen
      if substring(code,intx,1)<>word then
        phoneticcode=phoneticcode+substring(code,intx,1);
      end if;
      word=substring(code,intx,1);
    end if;
    intx=intx+1;
  end while;

  -- '0'-Code am Wortanfang bleibt aber bestehen!
  if substring(code,1,1)='0' then
    phoneticcode='0'+phoneticcode;
  end if;
  
  return phoneticcode;
end;

end if;  -- not exists

Verwenden der Function

Die Function kann nun eingebunden werden, um entweder in einem Trigger den Code für einen Namen, Vornamen oder ähnliches zu ermitteln und zu speichern oder um über eine gesamte Datenbank hinweg nach Dupletten zu suchen.
Folgendes Beispiel ermittelt, ob Dupletten im Feld „Account“ der Tabelle „Account“ vorkommen:

select KoelnerPhon(account,null), count(*) as anz from account
group by 1
having anz>1

Das Ergebnis kann man in eine Unterabfrage verpacken, um die einzelnen Datensätze dazu zu finden:

select KoelnerPhon(account,null), rowid, account from account
where KoelnerPhon(account,null) in
(
select KoelnerPhon(account,null) from account
group by 1
having count(*)>1
)
order by 1