Дмитрий Кузан
дата публикации 02-12-2002 14:06 Функция приблизительного/нечеткого сравнения строк
Недавно в поисках информации по интеллектуальным алгоритмам сравнения
я нашел такой алгоритм — алгоритм сравнения (совпадения) двух
строк, Так как он был написан на VBA, я под свои нужды переписал его на Delphi
Уважаемые жители Королевства, я думаю данная функция пригодится тем, кто
часто пишет
функции поиска, особенно когда поиск приблизителен. То есть,
например, в БД забито "Иванав Иван" - с ошибкой при наборе,
а ищется "Иванов".
Так вот, данный алгоритм может вам найти "Иванав" при
вводе
"Иванов",а также при
"Иван Иванов" - даже наоборот с определенной
степенью релевантности при
сравнении. А используя сравнение в процентном отношении, вы можете
производить поиск
по неточным данным с более-менее степенью похожести.
Еще раз повторяю, алгоритм не мой, я только его портировал на Delphi.
А метод был предложен Владимиром Кива, за что ему огромное спасибо.
|
 |
Скачать проект Compare.Zip (356 K)
Функция нечеткого сравнения строк БЕЗ УЧЕТА РЕГИСТРА
//------------------------------------------------------------------------------
//MaxMatching - максимальная длина подстроки (достаточно 3-4)
//strInputMatching - сравниваемая строка
//strInputStandart - строка-образец
// Сравнивание без учета регистра
// if IndistinctMatching(4, "поисковая строка", "оригинальная строка - эталон") > 40 then ...
Type
TRetCount = packed record
lngSubRows : Word;
lngCountLike : Word;
end;
//------------------------------------------------------------------------------
function Matching(StrInputA: WideString;
StrInputB: WideString;
lngLen: Integer) : TRetCount;
Var
TempRet : TRetCount;
PosStrB : Integer;
PosStrA : Integer;
StrA : WideString;
StrB : WideString;
StrTempA : WideString;
StrTempB : WideString;
begin
StrA := String(StrInputA);
StrB := String(StrInputB);
For PosStrA:= 1 To Length(strA) - lngLen + 1 do
begin
StrTempA:= System.Copy(strA, PosStrA, lngLen);
PosStrB:= 1;
For PosStrB:= 1 To Length(strB) - lngLen + 1 do
begin
StrTempB:= System.Copy(strB, PosStrB, lngLen);
If SysUtils.AnsiCompareText(StrTempA,StrTempB) = 0 Then
begin
Inc(TempRet.lngCountLike);
break;
end;
end;
Inc(TempRet.lngSubRows);
end; // PosStrA
Matching.lngCountLike:= TempRet.lngCountLike;
Matching.lngSubRows := TempRet.lngSubRows;
end; { function }
//------------------------------------------------------------------------------
function IndistinctMatching(MaxMatching : Integer;
strInputMatching: WideString;
strInputStandart: WideString): Integer;
Var
gret : TRetCount;
tret : TRetCount;
lngCurLen: Integer ; //текущая длина подстроки
begin
//если не передан какой-либо параметр, то выход
If (MaxMatching = 0) Or (Length(strInputMatching) = 0) Or
(Length(strInputStandart) = 0) Then
begin
IndistinctMatching:= 0;
exit;
end;
gret.lngCountLike:= 0;
gret.lngSubRows := 0;
// Цикл прохода по длине сравниваемой фразы
For lngCurLen:= 1 To MaxMatching do
begin
//Сравниваем строку A со строкой B
tret:= Matching(strInputMatching, strInputStandart, lngCurLen);
gret.lngCountLike := gret.lngCountLike + tret.lngCountLike;
gret.lngSubRows := gret.lngSubRows + tret.lngSubRows;
//Сравниваем строку B со строкой A
tret:= Matching(strInputStandart, strInputMatching, lngCurLen);
gret.lngCountLike := gret.lngCountLike + tret.lngCountLike;
gret.lngSubRows := gret.lngSubRows + tret.lngSubRows;
end;
If gret.lngSubRows = 0 Then
begin
IndistinctMatching:= 0;
exit;
end;
IndistinctMatching:= Trunc((gret.lngCountLike / gret.lngSubRows) * 100);
end;
| |
Кузан Дмитрий
[Поиск и сортировка] [Функции для работы со строками ] [Нечеткое сравнение]
 Обсуждение материала [ 11-06-2004 12:47 ] 9 сообщений |
