unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Math;
type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Levenshtein matching gives the number of steps (single character replacement or addition)
// needed to transform StringA into String B.
function CompareStrings_Levenshtein(const A, B: String; CaseSensitive: Boolean = False): Integer;
function Minimum3(x, y, z: Integer): Integer;
begin
Result := Min(x, y);
Result := Min(Result, z);
end;
function iff(bool: Boolean; x, y: Integer): Integer;
begin
if bool then
Result := x
else
Result := y;
end;
var
D: array of array of Integer;
n, m, i, j, Cost: Integer;
AI, BJ: char;
A1, B1: String;
begin
n := Length(A);
m := Length(B);
if (n = 0) then
Result := m
else if m = 0 then
Result := n
else
begin
if CaseSensitive then
A1 := A
else
A1 := UpperCase(A);
if CaseSensitive then
B1 := B
else
B1 := UpperCase(B);
Setlength(D, n + 1, m + 1);
for i := 0 to n do
D[i, 0] := i;
for j := 0 to m do
D[0, j] := j;
for i := 1 to n do
begin
AI := A1[i];
for j := 1 to m do
begin
BJ := B1[j];
Cost := iff(AI = BJ, 0, 1);
D[i, j] := Minimum3(D[i - 1][j] + 1,
D[i][j - 1] + 1,
D[i - 1][j - 1] + Cost);
end;
end;
Result := D[n, m];
end;
end;
// Ratcliffe matching gives the percentage of possible character matches between StringA and
// StringB, based on the longest matching sequences and subsequences between the two strings
function CompareStrings_Ratcliff(const A, B: String; CaseSensitive: Boolean = False): Double;
var
A1, B1: String;
LenA, LenB: Integer;
function CSR_Sub(StartA, EndA, StartB, EndB: Integer): Integer;
var
a, b, i, Matches, NewStartA, NewStartB: Integer;
begin
Result := 0;
NewStartA := 0;
NewStartB := 0;
if (StartA > EndA) or (StartB > EndB) or (StartA <= 0) or (StartB <= 0) then
Exit;
for a := StartA to EndA do
begin
for B := StartB to EndB do
begin
Matches := 0;
i := 0;
while (a + i <= EndA) and (b + i <= EndB) and (A1[a + i] = B1[b + i]) do
begin
Inc(Matches);
if Matches > Result then
begin
NewStartA := a;
NewStartB := b;
Result := Matches;
end;
Inc(i);
end;
end;
end;
if Result > 0 then
begin
Inc( Result, CSR_Sub(NewStartA + Result, EndA, NewStartB + Result, EndB) );
Inc( Result, CSR_Sub(StartA, NewStartA - 1, StartB, NewStartB - 1) );
end;
end;
begin
if CaseSensitive then
A1 := A
else
A1 := UpperCase(A);
if CaseSensitive then
B1 := B
else
B1 := UpperCase(B);
LenA := Length(A1);
LenB := Length(B1);
if A1 = B1 then
Result := 100
else if (LenA = 0) or (LenB = 0) then
Result := 0
else
Result := CSR_Sub(1, LenA, 1, LenB) * 200 / (LenA + LenB);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(CompareStrings_Levenshtein(Edit1.Text, Edit2.Text, True))+'개의 틀린 부분이 있습니다');
ShowMessage(FloatToStr(CompareStrings_Ratcliff(Edit1.Text, Edit2.Text, True))+'% 일치합니다');
end;
end.
|
|
