Moin Allerseits,
nachdem ich nun lang genug "gewildert" habe (gelesen und je meinen Senf ab zu geben),
werd ich mal eine Funktion zur Verfügung stellen, die ich heut Nachmittag gedengelt hab und
für ein Projekt von mir (was ich evtl. mal Vorstelle) benötige.
Spoiler anzeigen
Code
Func _soundex_koelner ($inString) ; Gibt den SoundEx-Code nach Kölner Phonetik zurück; !!! Keine Beachtung von mehreren Worten !!!
Local $q,$ret_code="",$chr_array
;Alles in Kleinbuchstaben
$inString=StringLower($inString)
;Umwandlung: v->f, w->f, j->i, y->i, ph->f, ä->a, ö->o, ü->u, ß->ss, é->e, è->e, ê->e, à->a, á->a, â->a, ë->e
Local Const $trans_from[17]=["ç","v","w","j","y","ph","ä","ö","ü","ß","é","è","ê","à","á","â","ë"]
Local Const $trans_to[17]=["c","f","f","i","i","f","a","o","u","ss","e","e","e","a","a","a","e"]
For $q=0 To 16
$inString=StringReplace($inString,$trans_from[$q],$trans_to[$q])
Next
; Nur Buchstaben (keine Zahlen, keine Sonderzeichen)
$inString=StringRegExpReplace($inString,'[^a-zA-Z]', '');
;$inString in Array teilen
$chr_array=StringSplit($inString,"")
; Sonderfälle bei Wortanfang (Anlaut); aber nur, wenn auch min. 2 Zeichen in $inString
If $chr_array[0]>1 And $chr_array[1]="c" Then
; vor a,h,k,l,o,q,r,u,x
Switch $chr_array[2]
Case "a","h","k","l","o","q","r","u","x"
$ret_code="4"
case Else
$ret_code="8"
EndSwitch
$q=2;
Else
$q=1;
EndIf
; SoundEx Kölner Phonetik selber
For $q=$q To $chr_array[0]
Switch $chr_array[$q]
Case 'a','e','i','o','u'
$ret_code&="0"
Case 'b','p'
$ret_code&="1"
Case 'd','t'
If $q+1<$chr_array[0] Then
Switch $chr_array[$q+1]
Case 'c','s','z'
$ret_code&="8"
Case Else
$ret_code&="2"
EndSwitch
Else
$ret_code&="2"
EndIf
Case 'f'
$ret_code&="3"
Case 'g','k','q'
$ret_code&="4"
Case 'c'
If $q+1<$chr_array[0] Then
Switch $chr_array[$q+1]
Case 'a','h','k','o','q','u','x'
Switch $chr_array[$q-1]
Case 's','z'
$ret_code&="8"
Case Else
$ret_code&="4"
EndSwitch
Case Else
$ret_code&="8"
EndSwitch
Else
$ret_code&="8"
EndIf
Case 'x'
If $q>1 Then
Switch $chr_array[$q-1]
Case 'c','k','q'
$ret_code&="8"
Case Else
$ret_code&="48"
EndSwitch
Else
$ret_code&="48"
EndIf
Case 'l'
$ret_code&="5"
Case 'm','n'
$ret_code&="6"
Case 'r'
$ret_code&="7"
Case 's','z'
$ret_code&="8"
EndSwitch
Next
; entfernen aller "0" ausser am Anfang
$ret_code=StringLeft($ret_code,1)&StringReplace(StringMid($ret_code,2),"0","")
; mehrfache Ziffern entfernen
$ret_code=StringRegExpReplace($ret_code,"(.)\1+","\1")
Return $ret_code
EndFunc ; => _soundex_koelnerVieleicht findet ja mal einer Verwendung.
Verbesserungen und Kommentare sind erwünscht.
