Levenshtein - Distanz

Pepp3r · Beiträge: 82

Hier mein Lückenfüllerprojekt "Levenshtein". Kein großes Ding, aber vielleicht wird es ja mal jemand brauchen.
Das Programm berechnet die minimale benötigte Anzahl an Operationen um den String1 in den Strin2 zu überführen.
In der Praxis kommt der Levenshtein-Algorithmus bei Suchvorgängen (zB google o.ä.) zum Einsatz.
de.wikipedia.org/wiki/Levenshtein-Distanz

Gruß
Pepp3r

Einloggen, um Attachments anzusehen!

Pepp3r · Beiträge: 82

Hatte leider nen kleinen Fehler. Wurde verbessert. Hier vollständige Unit:

markieren

Delphi-Quelltext

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:

unit Levenshtein;

interface

uses
  classes, SysUtils, Variants;

type
  TLevenshtein = Class
    private
    protected
      zeile1: Array of Byte;
      zeile2: Array of Byte;
      m: Byte;
      a, b: String;
    public
      constructor create(text1, text2: String);
      destructor free;
      function calc: Integer;
  end;

implementation

uses
  Unit1;

constructor TLevenshtein.create(text1, text2: String);
var
  i: Byte;
begin
  a := text1;
  b := text2;
  m := length(a);
  setlength( zeile1, m+1);
  setlength( zeile2, m+1);
  for i := 1 to m do
    zeile1[i] := i;
end;

destructor TLevenshtein.free;
begin
  setlength(zeile1, 0);
  setlength(zeile2, 0);
end;

function TLevenshtein.calc: Integer;
var
  i, j, k: Byte;
  min: Byte;
begin
    // rechnen
    for i := 1 to length(b) do
    begin
      zeile1[0] := i-1;
      zeile2[0] := i;
      for j := 1 to m do
      begin
        if (a[j] = b[i]) then
        begin
          zeile2[j] := zeile1[j-1];
          continue;
        end;
        min := zeile1[j-1];
        // Minimum finden
        if (zeile1[j] < min) then
          min := zeile1[j];
        if (zeile2[j-1] < min) then
          min := zeile2[j-1];
        // Operation addieren
          zeile2[j] := min+1
      end;
      // Zeilen überführen
      for k := 0 to m do
        zeile1[k] := zeile2[k];
    end;
    result := zeile1[m];
end;

end.

Anwendungsbeispiel:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:

procedure TForm1.Button1Click(Sender: TObject);
begin
  levenshtein := TLevenshtein.create(Edit1.Text, Edit2.Text);
  Label2.Caption := (inttostr(levenshtein.calc));
  Levenshtein.free;
end;

Gruß
Pepp3r

Einloggen, um Attachments anzusehen!

glotzer · Beiträge: 393 Erhaltene Danke: 49 Win 7 Lazarus

Zitat:

destructor free;

Der destructor heißt IMMER Destroy, das muss

markieren

Delphi-Quelltext

1:	destructor Destroy; override;

heißen.

_________________
ja, ich schreibe grundsätzlich alles klein und meine rechtschreibfehler sind absicht

Pepp3r · Beiträge: 82

Moderiert von Narses: Komplett-Zitat des letzten Beitrags entfernt.

Wieso?

Nersgatt · Verfasst: Fr 16.12.11 17:45

Weil die Klasse, von der Du Deine Klasse ableitest, evtl. noch irgendwelche Arbeiten (z.B. Aufräumen) im Destructor machen muss. Daher ist es auch wichtig, nicht nur Overridezu verwenden, sondern im eigenen Destructor auch inherited aufzurufen.
Und auch wenn Du Deine Klasse nicht explizit von einer anderen ableitest, sie wird immer mindestens von TObject abgeleitet.

_________________
Gruß, Jens
Zuerst ignorieren sie dich, dann lachen sie über dich, dann bekämpfen sie dich und dann gewinnst du. (Mahatma Gandhi)

baka0815 · Verfasst: Di 20.12.11 12:53

Man ruft bei einem Objekt zwar die Free-Funktion auf um das Objekt freizugeben, diese hingegen ruft den eigentlichen Desturktor Destroy auf.

Wenn du deinen Destruktor jetzt anders nennst, funktioniert z.B. FreeAndNil nicht mehr. Außerdem macht die Free-Funktion noch eine Prüfung ob das freizugebende Objekt nil, und somit bereits freigegeben, ist. Dies ist beides nicht mehr (uneingeschränkt) möglich, wenn der Destruktor anders heißt.

bummi · Verfasst: Di 20.12.11 13:02

@baka0815

wie kommst Du darauf?

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:

var
 b:TButton;
begin
  b:=TButton.Create(self);
  {
  b.Free; 
  b.Free; // das knallt
  }

  FreeAndNil(b);
  FreeAndNil(b); // das geht
end;

aber das hat mit dem Destruktor nur bedingt zu tun, das knallt ebenfalls

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:

var
 b,c:TButton;
begin
  b:=TButton.Create(self);
  c := b;
  FreeAndNil(b);
  FreeAndNil(c);
end;

_________________
Das Problem liegt üblicherweise zwischen den Ohren H₂♂
DRY DRY KISS

baka0815 · Verfasst: Di 20.12.11 14:06

Wenn er den Destruktor Free nennt, funktioniert FreeAndNil noch, da dies das Free aufruft. Ein anderer Name, wie z.B. Destruktor würde dann nicht mehr funktionieren, bzw. der eigene Destruktor halt nicht aufgerufen.

Blup · Beiträge: 174 Erhaltene Danke: 43

"Free" ist eine normale Methode von TObject, noch nicht einmal virtual.
Es gibt eigentlich kaum einen Grund diese zu verdecken.
FreeAndNil ruft immer diese Methode von TObject auf und interessiert sich überhaupt nicht für einen nachträglich hinzugefügten Destructor gleichen Namens.
Deshalb ist es wichtig "Destroy" zu überschreiben:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:

procedure TObject.Free;
begin
  if Self <> nil then
    Destroy;
end;

// Damit funktioniert so etwas ohne Fehler
var
  b: TObject;
begin
  b := nil;
  b.Free; 
end;

Falls man tatsächlich einen Destructor mit anderem Namen braucht, sollte man sicherstellen, das auch Destroy weiterhin ordentlich funktioniert.

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:

destructor TMyObject.Destroy; {override}
begin
  MyDestroy;
end;
 
destructor TMyObject.MyDestroy;
begin
  {...}
  inherited Destroy;
end;

Für TLevenshtein muss aber weder Destroy überschrieben, noch ein neuer Destructor hinzugefügt werden. Jeder Destructor (auch der von TObject) enthält unsichtbaren Code, der String-, Array- und Interface-Member bzw. den dadurch belegten Speicher automatisch freigibt.

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme