Metaphone Beispiel

Phonetische Umformung von Nachnamen

Angepasst auf die deutsche Aussprache von Nachnamen und basierend auf dem Metaphone Algorithmus

Nachname: -> -> Phonetische Repräsentation:

Das Javascript dazu

Implementierung in Cold Fusion

<!--- Adapted Metaphone Algorithmus for names --->
  <!--- delete doubled letters --->
        <cfset phonname = #ReplaceList(lastname,"BB,CC,DD,FF,GG,HH,JJ,KK,LL,MM,NN,PP,RR,SS,TT,VV,WW,XX,ZZ","B,C,D,F,G,H,J,K,L,M,N,P,R,S,T,V,W,X,Z")#>
  <!--- delete special characters and whitespace --->
        <cfset phonname = #ReplaceList(phonname,"-,,.,_,;,:,+",",,,,,,")#>
  <!--- initial letter rules --->
        <cfset phonname = #REReplace(phonname,"^CH","K","ONE")#>
  <!--- multiple character rules  --->
        <cfset phonname = #ReplaceList(phonname,"SCH,CHS,CKS,CZ,KS,TS,TZ,SZ,CK,DT,PF,PH,CH,QU","S,S,S,S,S,S,S,S,K,T,F,F,0,KF")#>
  <!--- single character rules - Characters to delete must be last because of CF Bug --->
        <cfset phonname = #ReplaceList(phonname,"Z,X,ß,D,V,W,C,G,Y,J,H","S,S,S,T,F,F,K,K,I,I,")#>
  <!--- delete all vowels exept if it is the first letter (keep the first letter) --->
        <cfset phonname = #Leftlphonname,1)# &
#ReplaceList(Mid(phonname,2,40),"A,Ä,E,I,O,Ö,U,Ü",",,,,,,,")#>

Implementierung in PL/SQL

create or replace package metaphone is
procedure delete_double_char ( string in out varchar2 ) ;
procedure exchange_char      ( string in out varchar2 ) ;
procedure metaphone          ( string in out varchar2 ) ;
function metaphone          ( string in out varchar2 ) return varchar2;
end ; -- Package Defininition
/

create or replace package body metaphone is
-- delete all double characters in a string
procedure delete_double_char ( string in out varchar2 ) is
  i integer := 1;
  prev char := '';
  buffer varchar2(2000);
begin
  -- go through every character in the string
  for i in 1 .. length ( string)
  loop
    -- copy first character at start time
    if i = 1
    then
      buffer :=  substr(string, i , 1);
    end  if ;

    if i > 1
    then
      -- compare with previous character
      if upper( prev) = upper ( substr ( string, i , 1))
      then
        null ;
      else
        buffer := buffer || substr ( string, i, 1);
      end if ;
    end if ;
    -- store the actual one
    prev := substr(string, i , 1);
  end loop ;
  -- copy the condensed string
  string := buffer;
end ; -- end of delete_double_chars

procedure exchange_char ( string in out varchar2 ) is
  buffer varchar2(2000);
  first char ;
begin
  -- delete special characters and whitespace
  string := replace (string, '-','');
  string := replace (string, '+','');
  string := replace (string, ' ','');  --space
  string := replace (string, ' ','');  --tab

  -- initial letter rules
  buffer := substr ( string, 1, 2);
  if buffer = 'CH' then
    buffer := 'K' || substr ( string, 3, length ( string) - 2);
    string := buffer;
  end if ;
  -- multiple character rules
  string := replace ( string, 'SCH', 'S' );
  string := replace ( string, 'CHS', 'S' );
  string := replace ( string, 'CKS', 'S' );
  string := replace ( string, 'CZ', 'S' );
  string := replace ( string, 'KS', 'S' );
  string := replace ( string, 'TS', 'S' );
  string := replace ( string, 'TZ', 'S' );
  string := replace ( string, 'SZ', 'S' );
  string := replace ( string, 'CK', 'K' );
  string := replace ( string, 'DT', 'T' );
  string := replace ( string, 'PF', 'F' );
  string := replace ( string, 'PH', 'F' );
  string := replace ( string, 'CH', '0' );
  string := replace ( string, 'QU', 'KF' );
  -- single character rules
  string := replace ( string, 'Z', 'S' );
  string := replace ( string, 'X', 'S' );
  string := replace ( string, 'D', 'T' );
  string := replace ( string, 'V', 'F' );
  string := replace ( string, 'W', 'F' );
  string := replace ( string, 'C', 'K' );
  string := replace ( string, 'G', 'K' );
  string := replace ( string, 'H', '');
  string := replace ( string, 'J', 'I');
  string := replace ( string, 'Y', 'I');
  first := substr ( string , 1, 1 );
  string := substr ( string, 2, 100);

  -- replace all the vowels
  string := replace ( string, 'Ä','');
  string := replace ( string, 'A','');
  string := replace ( string, 'E','');
  string := replace ( string, 'I','');
  string := replace ( string, 'O','');
  string := replace ( string, 'Ö','');
  string := replace ( string, 'U','');
  string := replace ( string, 'Ü','');
  -- save fist character to prevent delete
  -- of a leading vowel
  string := first || string ;
end ; -- end of exchange_char

procedure metaphone ( string in out varchar2 ) is
begin
  delete_double_char ( string) ;
  exchange_char      ( string) ;
end ; -- metaphone

function metaphone ( string in out varchar2 ) return varchar2 is
begin
  delete_double_char ( string) ;
  exchange_char      ( string) ;
  return (string) ;
end ; -- metaphone
end ; -- implementation metaphone