ファジーマッチで文字列内の部分文字列の位置を見つける方法

Question

OCRで認識された文字列に一致する文字列を見つけ出し、間違った、紛失した、余分な文字。結果は、マッチした部分文字列の長さをもった可能性があります（必ずしも必要ではありません）。例えば

：

String: 9912, 1.What is your name? 
Substring: 1. What is your name? 
Tolerance: 1 
Result: match on character 7 

String: Where is our caat if any? 
Substring: your cat 
Tolerance: 2 
Result: match on character 10 

String: Tolerance is t0o h1gh. 
Substring: Tolerance is too high; 
Tolerance: 1 
Result: no match 

私はLevensteinアルゴリズムを適応させることを試みたが、それは部分文字列のために正しく動作しないと位置を返しません。

デルファイのアルゴリズムが優先されますが、実装または疑似ロジックはどちらでも構いません。

Answer 1

これは動作する再帰的な実装ですが、十分に速くない可能性があります。最悪のシナリオは、一致が見つからない場合と、Whereの最後の文字以外のすべてがWhereの各インデックスで一致する場合です。その場合、アルゴリズムはWhereの各charに対してLength（What）-1 + Toleranceの比較を行い、許容値ごとに1回の再帰呼び出しを行います。許容値と長さの両方がconstnatsなので、アルゴリズムはO（n）だと言います。パフォーマンスは「What」と「Where」の長さに比例して直線的に低下します。場合について

procedure TForm18.Button1Click(Sender: TObject); 
var AtIndex, OfLength:Integer; 
begin 
    if BrouteFindFirst(Edit2.Text, Edit1.Text, ComboBox1.ItemIndex, AtIndex, OfLength) then 
    Label3.Caption := 'Found @' + IntToStr(AtIndex) + ', of length ' + IntToStr(OfLength) 
    else 
    Label3.Caption := 'Not found'; 
end; 

：

​​

それは文字9で一致を示し、長さについて6のI機能をテストするために、次のコードを使用した

function BrouteFindFirst(What, Where:string; Tolerance:Integer; out AtIndex, OfLength:Integer):Boolean; 
    var i:Integer; 
     aLen:Integer; 
     WhatLen, WhereLen:Integer; 

    function BrouteCompare(wherePos, whatPos, Tolerance:Integer; out Len:Integer):Boolean; 
    var aLen:Integer; 
     aRecursiveLen:Integer; 
    begin 
     // Skip perfect match characters 
     aLen := 0; 
     while (whatPos <= WhatLen) and (wherePos <= WhereLen) and (What[whatPos] = Where[wherePos]) do 
     begin 
     Inc(aLen); 
     Inc(wherePos); 
     Inc(whatPos); 
     end; 
     // Did we find a match? 
     if (whatPos > WhatLen) then 
     begin 
      Result := True; 
      Len := aLen; 
     end 
     else if Tolerance = 0 then 
     Result := False // No match and no more "wild cards" 
     else 
     begin 
      // We'll make an recursive call to BrouteCompare, allowing for some tolerance in the string 
      // matching algorithm. 
      Dec(Tolerance); // use up one "wildcard" 
      Inc(whatPos); // consider the current char matched 
      if BrouteCompare(wherePos, whatPos, Tolerance, aRecursiveLen) then 
      begin 
       Len := aLen + aRecursiveLen; 
       Result := True; 
      end 
      else if BrouteCompare(wherePos + 1, whatPos, Tolerance, aRecursiveLen) then 
      begin 
       Len := aLen + aRecursiveLen; 
       Result := True; 
      end 
      else 
      Result := False; // no luck! 
     end; 
    end; 

    begin 

    WhatLen := Length(What); 
    WhereLen := Length(Where); 

    for i:=1 to Length(Where) do 
    begin 
     if BrouteCompare(i, 1, Tolerance, aLen) then 
     begin 
     AtIndex := i; 
     OfLength := aLen; 
     Result := True; 
     Exit; 
     end; 
    end; 

    // No match found! 
    Result := False; 

    end; 

他の2つの例では、期待される結果が得られます。