На просторах интернета нашел вот такой старый модуль для нечеткого сравнения строк (в качестве результата число от 0 до 100):
unit FindCompare;
interface
//------------------------------------------------------------------------------
//Функция нечеткого сравнения строк БЕЗ УЧЕТА РЕГИСТРА
//------------------------------------------------------------------------------
//MaxMatching - максимальная длина подстроки (достаточно 3-4)
//strInputMatching - сравниваемая строка
//strInputStandart - строка-образец
// Сравнивание без учета регистра
// if IndistinctMatching(4, "поисковая строка", "оригинальная строка - эталон") > 40 then ...
function IndistinctMatching(MaxMatching : Integer;
strInputMatching: WideString;
strInputStandart: WideString): Integer;
function IndistinctMatching2(A,B: String): Real;
implementation
Uses SysUtils;
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;
end.
В Delphi 7 отлично работает (также заработало в VCL Berlina после небольших изменений связанных с AnsiString).
А вот чтобы заработало в Firemonkey (из-за отсутствия AnsiString) мне пришлось добавлять System.ByteStrings.dcu взятую отсюда. Так вот при запуске программы на Android я получаю более менее похожие на правду результаты, но они отличаются от тех что получаются в Delphi7. Число 100 не получается, даже если указать две одинаковые фразы (выдает около 75).
А если запускать программу под Windows, то в результате получаются самые разные рандомные числа.
Вопрос
Rusland
На просторах интернета нашел вот такой старый модуль для нечеткого сравнения строк (в качестве результата число от 0 до 100):
unit FindCompare; interface //------------------------------------------------------------------------------ //Функция нечеткого сравнения строк БЕЗ УЧЕТА РЕГИСТРА //------------------------------------------------------------------------------ //MaxMatching - максимальная длина подстроки (достаточно 3-4) //strInputMatching - сравниваемая строка //strInputStandart - строка-образец // Сравнивание без учета регистра // if IndistinctMatching(4, "поисковая строка", "оригинальная строка - эталон") > 40 then ... function IndistinctMatching(MaxMatching : Integer; strInputMatching: WideString; strInputStandart: WideString): Integer; function IndistinctMatching2(A,B: String): Real; implementation Uses SysUtils; 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; end.
В Delphi 7 отлично работает (также заработало в VCL Berlina после небольших изменений связанных с AnsiString).
А вот чтобы заработало в Firemonkey (из-за отсутствия AnsiString) мне пришлось добавлять System.ByteStrings.dcu взятую отсюда. Так вот при запуске программы на Android я получаю более менее похожие на правду результаты, но они отличаются от тех что получаются в Delphi7. Число 100 не получается, даже если указать две одинаковые фразы (выдает около 75).
А если запускать программу под Windows, то в результате получаются самые разные рандомные числа.
Что мешает функции нормально работать?
Изменено пользователем RuslandСсылка на комментарий
10 ответов на этот вопрос
Рекомендуемые сообщения
Присоединяйтесь к обсуждению
Вы можете написать сейчас и зарегистрироваться позже. Если у вас есть аккаунт, авторизуйтесь, чтобы опубликовать от имени своего аккаунта.