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
![Antworten [gesperrt]](./graphics/navbar/reply.png)
