Delphi World - Функция приблизительного (нечеткого) сравнения строк
Delphi World - это проект, являющийся сборником статей и малодокументированных возможностей  по программированию в среде Delphi. Здесь вы найдёте работы по следующим категориям: delphi, delfi, borland, bds, дельфи, делфи, дэльфи, дэлфи, programming, example, программирование, исходные коды, code, исходники, source, sources, сорцы, сорсы, soft, programs, программы, and, how, delphiworld, базы данных, графика, игры, интернет, сети, компоненты, классы, мультимедиа, ос, железо, программа, интерфейс, рабочий стол, синтаксис, технологии, файловая система...
Функция приблизительного (нечеткого) сравнения строк


Автор: Дмитрий Кузан

Недавно в поисках информации по интеллектуальным алгоритмам сравнения я нашел такой алгоритм — алгоритм сравнения (совпадения) двух строк, Так как он был написан на VBA, я под свои нужды переписал его на Delphi

Уважаемые пользователи проекта DelphiWorld, я думаю данная функция пригодится тем, кто часто пишет функции поиска, особенно когда поиск приблизителен. То есть, например, в БД забито "Иванав Иван" - с ошибкой при наборе, а ищется "Иванов". Так вот, данный алгоритм может вам найти "Иванав" при вводе "Иванов",а также при "Иван Иванов" - даже наоборот с определенной степенью релевантности при сравнении. А используя сравнение в процентном отношении, вы можете производить поиск по неточным данным с более-менее степенью похожести.

Еще раз повторяю, алгоритм не мой, я только его портировал на 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;
Проект Delphi World © Выпуск 2002 - 2017
Автор проекта: Эксклюзивные курсы программирования