Handelt es sich zweimal um denselben Straßennamen?[meta]Strassennamen, Strasse, Straße[/meta]
Es handelt sich hier um einen Algorithmus, der überprüft ob zwei (Post-)Adressen trotz unterschiedlicher Schreibweise dieselben sind.
Das Einsatzszenario kann man wiefolgt erklären: Es gibt einen ganzen Wirtschaftszweig der sich auf das Verkaufen von Adressen verkauft hat. So gibt es bspw. Firmen, bei denen man eine Adressdatenbank mit 1000 Einträgen kaufen kann. An diese Adressen kann man dann z.B. Werbebriefe schicken. Meistens stammen die Adressen aus Gewinnspielen. Sprich jeder der bei einem Gewinnspiel teilgenommen hat, und seine Adresse angegeben hat, landet auf einer solchen Liste. Die Gewinnspielzettel werden maschinell ausgelesen und die Adresse wird in eine Datenbank geschrieben. Dabei kommt es sehr häufig vor, dass sich zwei Adressen zwar in der Schreibweise unterscheiden, es sich aber trotzdem um denselben Haushalt handelt.
Beispiel:
Quelltext
1: 2: 3: 4:
| Delphistrasse 5-1 Delphistr. 5-1 Delphistrasse 5/1 Delphistrasse 5 1 |
Hier gibt es bereits vier mögliche Schreibweisen. Noch verzwickter wird das ganze, wenn die Adressen z.B. aus einer Kundendatenbank stammen, die von Reklamationsmitarbeitern o.ä. gefüttert wird. Häufig stammt die Strasseneingabe aus einem Telefongespräch. Im schlimmsten Fall hat sich auch noch ein Tippfehler eingeschlichen, den der Briefträger zwar problemlos erkennt, durch den der Computer aber nicht mehr weiss, dass er diese Adresse schonmal hatte.
Beispiel:
Quelltext
1: 2: 3: 4: 5: 6: 7: 8: 9:
| Stephansstrasse Stephansstraße Stefansstrasse Stefansstraße Stefansstr. Stefanstr Stefans-Str Stefans-Strasse Stefans-Straße |
Es gibt unzählige Möglichkeiten wie ein Reklamationsmitarbeiter am Telefon eine Strasse erfassen kann. An sich ist soetwas nicht schlimm - erst wenn man sich z.B. am Jahresende entschließt seinen Kunden Werbebriefe oder was auch immer zu schicken. Auf der einen Seite zahlt man unnötiges Porto. Was aber noch viel schlimmer ist der Eindruck, den der Empfänger vom Werbetreibenden bekommt, wenn er zweimal den gleichen Brief erhält - einmal an die Teststrasse 1 und nocheinmal an die Teststr. 1.
Diese Situation erkennt der Algorithmus:
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36:
| Teststrasse 5-1 Teststrasse 5/1 Teststrasse 5 1 Teststrasse 5_1
Test-Strasse Teststrasse
Teststr. Teststrasse
In der Testrasse Teststrasse
Am Testeck Testeck
<weitere führende Wörter sind: 'in', 'im', 'an', 'am', 'der', 'dem'>
Tsetstrasse Teststrasse
Hochhäußerstr Hochhäusserstr
Hochhäußerstr Hochhaeußerstr
<selbiges gilt für ü und ö>
Stephansweg Stefansweg
Pfalzgraf-Otto Strasse Pfalzgrafotto Strasse |
Natürlich funktioniert das alles auch wenn es kombiniert auftritt:
z.B. bei:
Quelltext
1: 2:
| Pflaz-Graf-Otto Straße 5-1 (mit Tippfehler) Pfalzgrafottostr. 5/1 |
Nun zum Quellcode. Alles verpackt in Einzelteile.
1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174:
| function ExtractHausNummer(a : String) : String; var an : String; i,ii : Integer; begin an:=''; ii:=0; for i := length(a) downto 1 do if not (a[i] in ['0'..'9','/','-',' ']) then break else an := a[i] + an;
trim(an);
for i := 1 to length(an) do if an[i] = ' ' then inc(ii) else break;
if ii > 0 then delete(an, 1, ii); for i := 1 to length(an) do if not (an[i] in ['/', ' ', '-']) then result := result + an[i] else result := result + '-'; end;
function CompareStringsWithoutSpecialCharacters(a, b : String) : boolean; function CreateStringWithoutSpecialCharacters(a:string):string; var i : Integer; begin for i := 1 to length(a) do case a[i] of 'f': result := result + 'ph'; 'ä': result := result + 'ae'; 'ß': result := result + 'ss'; 'ü': result := result + 'ue'; 'ö': result := result + 'oe'; else result := result + a[i]; end; end; begin result := CreateStringWithoutSpecialCharacters(a) = CreateStringWithoutSpecialCharacters(b); end;
function ExtractStreetnameWithoutLeadingArticles(a : String) : String; function isInArray(s : String) : Boolean; var i : Integer; const lA : Array[1..6] of String = ('in', 'im', 'an', 'am', 'der', 'dem'); begin result:=true; for i := 1 to 6 do if ansilowercase(s) = lA[i] then exit; result:=false; end; var sta : TStringList; i : Integer; begin sta := TStringList.Create;
ExtractStrings([#32], [#32], PChar(a), sta); for i := 0 to sta.count-1 do if not IsInArray(sta[i]) then result := result + sta[i];
sta.free; end;
function ExtractStreetName(s : String) : String; var sn : String; begin sn := ExtractHausNummer(s); result := ExtractStreetNameWithoutLeadingArticles( Trim(Copy(s,1, length(s) - length(Trim(sn))))); end;
function CompareStringsWithCharTolerance(a, b : String) : Boolean; var i :Integer; begin result:=false; if length(a) <> length(b) then exit; for i := 1 to length(a) do if a[i] <> b[i] then begin if (i = 1) and (length(a) > 1) then if (a[i] = b[i+1]) then else exit else if i < length(a) then if (a[i] = b[i-1]) xor (a[i] = b[i+1]) then else exit else if a[i] = b[i-1] then else exit; end; result:=true; end;
function CompareStringsWithTolerance(a, b : String) : Boolean; var ax, bx : String; i : Integer; begin ax := ''; bx := ''; trim(a); trim(b);
for i := 1 to length(a) do if not (a[i] in ['/', '.', '-', '_', ' ']) then ax := ax + a[i];
for i := 1 to length(b) do if not (b[i] in ['/', '.', '-', '_', ' ']) then bx := bx + b[i];
if bx <> ax then if not CompareStringsWithCharTolerance(ax, bx) then Result := CompareStringsWithoutSpecialCharacters(ax, bx) else Result := true else Result := true; end;
function IsStreetNameEqual(a, b : String) : Boolean; var ta, tb : String; i : Integer; an, bn : Integer; sa, sb : String; begin a:=ansilowercase(a); b:=ansilowercase(b);
for i := length(a) downto 1 do if a[i] <> ' ' then ta := ta + a[i];
for i := length(b) downto 1 do if b[i] <> ' ' then tb := tb + b[i];
if (pos('rts', ta) > 0) and (pos('rts', tb) > 0) then begin an := pos('rts', ta); bn := pos('rts', tb); result := CompareStringsWithTolerance(copy(a, 1, length(a)-an-2), (copy(b, 1, length(b)-bn-2))); end; end;
function AreEqualAdresses(a, b : String) : Boolean; begin if ExtractHausNummer(a) = extractHausNummer(b) then if CompareStringsWithTolerance(ExtractStreetName(a), ExtractStreetName(b)) then result := true else if IsStreetNameEqual(ExtractStreetName(a), ExtractStreetName(b)) then result := true else result := false else result := false; end; |
Evt. können die einzelnen Funktionen auch nochmal für jemanden zu gebrauchen sein, daher fand ich es sinnvoller mehrere kleine Funktionen als eine riesiggrosse zu erstellen. Außerdem ist es so wesetlich übersichtlicher
Wenn ihr den Algorithmus per Copy und Paste übernehmt, achtet bitte darauf dass sie in der richtigen Reihenfolge bleiben, dafür muss auch nichts geforwardet werden.
Aufzurufen ist die Abfrage über die Hauptfunktion
AreEqualAdresses, z.B. so:
Delphi-Quelltext
1: 2: 3: 4: 5:
| procedure TForm1.Button1Click(Sender: TObject); begin if AreEqualAdresses(edit1.text, edit2.text) then showmessage('Die Adressen sind gleich!') else Showmessage('Die Adressen sind nicht gleich'); end; |
Ein Durchlauf dauert auf meinem System zwischen 0 und 10 ms. Bei Bedarf kann wahrscheinlich noch einiges optimiert werden.
Wenn ihr viele Adressen auf einmal prüft (was wohl auch der einzige Einsatzzweck sein wird) solltet ihr mit Fortschrittsanzeige und Application.Processmessages arbeiten.
Die Funktionsnamen sind teilweise in widerlichem Deutsch-englisch Gemisch. Ich gebs zu
Aber mein Gehirn ist einfach nicht in der Lage treffende und pregnante Aufrufnamen auf Deutsch zu formulieren.
Für Anfänger: Zum implentieren einfach den gesamten von mir geposteten Quellcode kopieren und in euere Unit einfügen.
Vorsicht: Algorithmen dieser Art sind nie fehlerfrei: Ich rate dringend davon ab mit diesem Algorithmus als Grundlage Adressen automatisch zu löschen. Zeigt die gefundenen Adressen am Ende lieber nocheinmal an und lasst den User entscheiden ob und welche Adresse er löschen will.
Nach bestem Gutdünken von mir getestet: Will heißen: Ich hab wahrscheinlich 3423 Milliarden Fälle getestet, aber ich schließe nicht aus, dass es zu Fehler kommen kann
Mit der Hoffnung, dass nicht der erste Antwortpost auf einen Fehler aufmerksam macht
,
Lieben Gruss!
ps.: Wer Tippfehler in dem Text hier findet kann sie getrost behalten, es ist halb 7 und ich bin nicht mehr gewillt darauf zu achten