Недавно добавленные исходники

•  TDictionary Custom Sort  3 225

•  Fast Watermark Sources  2 991

•  3D Designer  4 750

•  Sik Screen Capture  3 259

•  Patch Maker  3 467

•  Айболит (remote control)  3 528

•  ListBox Drag & Drop  2 904

•  Доска для игры Реверси  80 778

•  Графические эффекты  3 843

•  Рисование по маске  3 171

•  Перетаскивание изображений  2 544

•  Canvas Drawing  2 672

•  Рисование Луны  2 500

•  Поворот изображения  2 092

•  Рисование стержней  2 120

•  Paint on Shape  1 525

•  Генератор кроссвордов  2 183

•  Головоломка Paletto  1 730

•  Теорема Монжа об окружностях  2 158

•  Пазл Numbrix  1 649

•  Заборы и коммивояжеры  2 016

•  Игра HIP  1 262

•  Игра Go (Го)  1 200

•  Симулятор лифта  1 422

•  Программа укладки плитки  1 177

•  Генератор лабиринта  1 512

•  Проверка числового ввода  1 297

•  HEX View  1 466

•  Физический маятник  1 322

•  Задача коммивояжера  1 357

 
скрыть


Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Функция приблизительного (нечеткого) сравнения строк




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

Недавно в поисках информации по интеллектуальным алгоритмам сравнения я нашел такой алгоритм — алгоритм сравнения (совпадения) двух строк, Так как он был написан на 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;







Copyright © 2004-2024 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте