2013年9月10日火曜日

LevenshteinDistance

あんまりネタもないので、たまにはコードでも書いてみよう。

LevenshteinDistance については wiki 参照。

http://ja.wikipedia.org/wiki/レーベンシュタイン距離

書いては見たけど使わないことになってしまった。

まあたいしたものではないけど。
勿体ない気もするので晒しておきます。

NewBSD License のもと、ご自由に。

一応 Lazarus,FPC 用に書いたつもりですが、基本的に私はObjectPascal については Borland系 のコードしか書けないので Delphi でも動くはずです。
(FillByteはZeroMemoryにしてください)

課題とか。
とりあえず、arrayはとりましたが興味が失せてきたので終わりにします。
式を単純化したり変数やアドレスの計算も減らせそうです。

wikiのまんまの関数は基礎についての解説の一部なんだと思うんですが、おそらく

     // const  SignChars=[33..47,58..63,91..96,123..126];

        case  b1^-b2^ of
          0:
            cost:= 0; // 同じ文字

          -32,32:
            cost:= 2  // 大文字、小文字

          else        // 違う文字
            begin
              if (b1^ = 32) or (b2^ = 32) then
                cost:= 3   // どちらかが空白
              else
              if (b1^ in SignChars) and (b2^ in SignChars) then // *1
                cost:= 1   // どちらも記号
              else
              if (b1^ in SignChars) or (b2^ in SignChars) then
                cost:= 4   // 記号とAaZz
              else
              if (b1^ in [48..57]) and (b2^ in [48..57]) then
                cost:= 1   // どちらも数字
              else
              if (b1^ in [48..57]) or (b2^ in [48..57]) then
                cost:= 4   // 数値とAaZz
              else
                cost:= 5;  //その他(上記以外の文字)
            end;
        end;


のようにして使う事を前提に書かれた解説だと思うんですが、どうなんだろう。
実例が知りたいのだけど、ググっても海外含めて追加・削除・置換しか出てこないんでスッキリしない。
コスト判定が行動主体だけではあんまり意味ないような気がする。
(以下に組み込む場合は、dIns:= iptr^; // + 1; を  dIns:= iptr^+4; // + 5; ぐらいに調整。us-ascii しか考慮していません)

上のまんまなんだけど、例えば数字。
tes4 と入力して tes5 と tes3 は近いほうがいいと思いますし、test はそれより遠いほうがいいように思います。
まあやっぱその辺は状況に応じてカスタムするんだろうな。
そのまま使うわけないよな・・・。


以下コード。

function LevenshteinDistance(s1, s2: string): integer; experimental;
var
  arr : pointer;  // data

  isz : integer;  // size of integer
  sz  : integer;  // total size
  xlen,           // s1 length +1
  ylen: integer;  // s2 length +1

  x,y : integer;
  xptr,
  yptr,
  iptr: pinteger;
  b1,b2: pbyte;   // s1,s2 pointer

  dIns,           // insert cost
  dDel,           // delete cost
  dRpl,           // replace cost
  dRes,           // result
  cost: integer;  // cost

  dist1,           // distance of dIns,dDel address
  dist2: integer;  // distance of dDel,dRpl address
begin
  xlen:= Length(s1)+1;
  ylen:= Length(s2)+1;

  isz:= SizeOf(integer);
  sz:= (xlen * ylen) * isz;
  GetMem(arr,sz);
  try
  {$IFDEF DELPHI}
  ZeroMemory(arr,sz);  // Delphi, or Lazarus,FPC with Windows.pas
  {$ELSE}    
   FillByte(arr^,0,sz);
  {$ENDIF}

    //[x,0]
    xptr:= arr;
    for x:=0 to xlen-1 do
    begin
      xptr^:= x;
      inc(xptr);
    end;
    //[0,y]
    yptr:= arr;
    for y:=0 to ylen-1 do
    begin
      yptr^:= y;
      inc(yptr,xlen);
    end;

    for x:=0 to xlen-1 do
    begin
      for y:=0 to ylen-1 do
      begin
        //iptr := arr + ((x  ) + ((y  )*xlen))*isz;
        iptr := arr;
        inc(iptr, (x  ) + ((y  )*xlen));
      end;
    end;

    x:= 1;
    y:= 1;
    dist1:= ((x-1) + ((y  )*xlen)) - ((x  ) + ((y-1)*xlen));
    dist2:= ((x-1) + ((y-1)*xlen)) - ((x-1) + ((y  )*xlen));

    //b1:=PByte(PChar(s1));
    b1:=@s1[1];
    for x:=1 to xlen-1 do
    begin
      //b2:=PByte(PChar(s2));
      b2:=@s2[1];
      for y:=1 to ylen-1 do
      begin
          // 最後に足す事にして全ての cost から -1 する
          if b1^-b2^=0 then
             cost:= -1 // 0
          else
             cost:= 0; // 1;

        //iptr:= arr + ((x  ) + ((y-1)*xlen))*isz;
        iptr:= arr;
        inc(iptr,(x  ) + ((y-1)*xlen));
        dIns:= iptr^;  // + 1;

        //iptr:= arr + ((x-1) + ((y  )*xlen))*isz;
        //iptr:= arr;
        //inc(iptr,(x-1) + ((y  )*xlen));
        inc(iptr,dist1);
        dDel:= iptr^;  // + 1;

        //iptr:= arr + ((x-1) + ((y-1)*xlen))*isz;
        //iptr:= arr;
        //inc(iptr,(x-1) + ((y-1)*xlen));
        inc(iptr,dist2);
        dRpl:= iptr^ + cost;

        dRes:= dIns;
        if dRes>dDel then dRes:= dDel;
        if dRes>dRpl then dRes:= dRpl;

        //iptr := arr + ((x  ) + ((y  )*xlen))*isz;
        iptr:= arr;
        inc(iptr,(x  ) + ((y  )*xlen));

        //iptr^:=dRes;
        iptr^:=dRes + 1; //最後に足せばいい

        inc(b2);
      end;
      inc(b1);
    end;

    //iptr:= arr + ((xlen-1) + ((ylen-1)*xlen))*isz;
    iptr:= arr;
    inc(iptr,(xlen-1) + ((ylen-1)*xlen));

    Result := iptr^;
  finally
    FreeMem(arr,sz);
  end;
end;

補足
コメントアウトされたコードは最適化前のコードです。
直後のコードと等価です。

注意
inc で進むポインタのアドレスは isz 倍しなくても大丈夫です。
逆に iptr のアドレスを計算する際は arr から 進める分を isz 倍しないと、おかしくなります。

0 件のコメント:

コメントを投稿