Модификация UDF

avenger · Сообщение **avenger** » 21 авг 2006, 16:54

Привет всем!

Помогите ускорить udf, которая возращает в процентах "похожесть" строки и прототипа строки.

SQL:

declare external function IndistinctMatching
smallint, cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatching' module_name 'udfIndistinctMatching';

declare external function IndistinctMatching3
cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatching3' module_name 'udfIndistinctMatching';

declare external function IndistinctMatching4
cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatching4' module_name 'udfIndistinctMatching';

declare external function IndistinctMatchingEx
smallint, cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatchingEx' module_name 'udfIndistinctMatching';

declare external function IndistinctMatchingEx3
cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatchingEx3' module_name 'udfIndistinctMatching';

declare external function IndistinctMatchingEx4
cstring(254), cstring(254)
returns smallint by value
entry_point 'udf_IndistinctMatchingEx4' module_name 'udfIndistinctMatching';

Delphi udfIndistinctMatching.dpr :

Код: Выделить всё

{$SOPREFIX ''}
library udfIndistinctMatching;

uses
  FindCompare, RegExpr, SysUtils;

function Normalize(s: String): String;
var
  regexpr: TRegExpr;
begin
  regexpr := TRegExpr.Create;
  try
    with regexpr do
      begin
        ModifierI := True;
        ModifierR := True;

        Expression := '[^a-zA-Z└-▀р- и╕0-9]';
        s := Replace(s, '', True);

        Expression := '(.)\1+';
        s := Replace(s, '$1', True);
      end;
  finally
    regexpr.Free;
  end;
  Result := AnsiUpperCase(s);
end;

function udf_IndistinctMatching(MaxMatching: SmallInt; strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  Result := IndistinctMatching(MaxMatching, strInputMatching, strInputStandart);
end;

function udf_IndistinctMatching3(strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  Result := IndistinctMatching(3, strInputMatching, strInputStandart);
end;

function udf_IndistinctMatching4(strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  Result := IndistinctMatching(4, strInputMatching, strInputStandart);
end;

(*
################################################################################
### Normalize
################################################################################
*)
function udf_IndistinctMatchingEx(MaxMatching: SmallInt; strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  strInputMatching := PChar( Normalize(strInputMatching) );
  strInputStandart := PChar( Normalize(strInputStandart) );
  Result := IndistinctMatching(MaxMatching, strInputMatching, strInputStandart);
end;

function udf_IndistinctMatchingEx3(strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  strInputMatching := PChar( Normalize(strInputMatching) );
  strInputStandart := PChar( Normalize(strInputStandart) );
  Result := IndistinctMatching(3, strInputMatching, strInputStandart);
end;

function udf_IndistinctMatchingEx4(strInputMatching, strInputStandart: PChar): SmallInt; cdecl; export;
begin
  strInputMatching := PChar( Normalize(strInputMatching) );
  strInputStandart := PChar( Normalize(strInputStandart) );
  Result := IndistinctMatching(4, strInputMatching, strInputStandart);
end;

exports
  udf_IndistinctMatching,
  udf_IndistinctMatching3,
  udf_IndistinctMatching4,
  udf_IndistinctMatchingEx,
  udf_IndistinctMatchingEx3,
  udf_IndistinctMatchingEx4;

begin

end.

Delphi FindCompare.pas:

Код: Выделить всё

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.

RegExp http://anso.da.ru/

Все работает, но медленно. Может можно как-то подтюнить... тип поменять, потоки добавить?

P.S. Извиняюсь за столь большой пост.

С уважением, Иван.

Сообщение **kdv** » 21 авг 2006, 17:36

собственно, я бы предложил взять AQTime в руки, и попрофилировать код. Помогает сильно, как в смысле обнаружения кривостей в алгоритме, так и в смысле "не тех" вызовов. На глаз такие вещи обнаружить сложно, а иной раз просто невозможно, не зная "потрохов" используемых функций.

"потоки добавить" - думаю вряд ли.

CyberMax · Сообщение **CyberMax** » 21 авг 2006, 17:37

1. Параметры строк без const.
2. Попробуй возвращать Integer, а не SmallInt.
3. Packed record работает медленнее, чем просто record.
4. И т.д.
Зайди на http://www.peganza.com и скачай Pascal Analyzer. Протесть им свой проект. Можешь много нового узнать. И поищи доки по оптимизации кода.

P.S. 2 Avenger. Пиши о своей проблеме на сайтах, посвященных Delphi. Тему завтра закрою, как не относящуюся к IB/FB. У желающих высказаться есть время.

hvlad · Сообщение **hvlad** » 21 авг 2006, 23:12

avenger писал(а):

Код: Выделить всё

//------------------------------------------------------------------------------
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 }

RegExp http://anso.da.ru/

Все работает, но медленно. Может можно как-то подтюнить... тип поменять, потоки добавить?

Канешна медленно.
Ты посчитай, сколько раз Copy вызывается.
Потом подумай о том, что в AnsiCompareText совсем не получится WideString'и передать,
следовательно компилятор их в AnsiString'и сам преобразовывает.

Разберись, в общем, с алгоритмом и с WideString'ами в нём

WildSery · Сообщение **WildSery** » 22 авг 2006, 10:35

CyberMax писал(а):1. Параметры строк без const.

В данном случае никак не повлияет, скрытый try...finally всё равно будет - потому что локальные переменные строковые объявлены.

iBase.ru Forum

Модификация UDF

Модификация UDF

Re: Модификация UDF