VPF::Как сравнить текст и получить процент схожести

Alex103

Дата 11.1.2005, 02:21 (ссылка)

(нет голосов)

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 416
Регистрация: 5.1.2005
Где: Украина, г. Харьк ов

Репутация: нет
Всего: нет

Как мне сравнить текст и получить процент схожести между текстами если они похожи по смыслу и в них есть одинаковые слова!!!!!!!!Плиз помогите очнь нужно!!!!!!!!

--------------------

Мой адресс не дом и не улица, мой адресс WWW

Vit

Дата 11.1.2005, 03:36 (ссылка)

(нет голосов)

Загрузка ...

Vitaly Nevzorov

Профиль
Группа: Экс. модератор
Сообщений: 10964
Регистрация: 25.3.2002
Где: Chicago

Репутация: 48
Всего: 207

Смысл сравнить? Это круто... очень круто... берусь написать такую программу, нужно лет пять времени и группа из 30 программистов неслабого уровня, ну и примерно 10-20 миллионов долларов на разработку...

--------------------

With the best wishes, Vit
I have done so much with so little for so long that I am now qualified to do anything with nothing
Самый большой Delphi FAQ на русском языке здесь: www.drkb.ru

Dimich

Дата 11.1.2005, 12:39 (ссылка)

(нет голосов)

Загрузка ...

Бывалый

Профиль
Группа: Участник
Сообщений: 247
Регистрация: 25.8.2004
Где: Брянск

Репутация: 1
Всего: 7

Конечно не так круто, как Вам хотелось, однако может это подойдет для начала?:

Код


unit FindCompare;

interface

//------------------------------------------------------------------------------
//Функция нечеткого сравнения строк БЕЗ УЧЕТА РЕГИСТРА
//------------------------------------------------------------------------------
//MaxMatching - максимальная длина подстроки (достаточно 3-4)
//strInputMatching - сравниваемая строка
//strInputStandart - строка-образец

// Сравнивание без учета регистра
// if IndistinctMatching(4, "поисковая строка", "оригинальная строка - эталон") > 40 then ...

function IndistinctMatching(MaxMatching : Integer;
                            strInputMatching: WideString;
                            strInputStandart: WideString): Integer;
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.

пример использования:

Код


begin 
  Relevant := FindCompare.IndistinctMatching (3, edFind.Text, edOriginal.Text);
  if Relevant > 40 then ShowMessage('IMHO похожи!');
  //....
end;

--------------------

Не работает - исправь, работает - не трогай!!!

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »