［３００’］求一字符串匹配算法！

这个函数有歧义吧?
字串
str1:abcdefgabcdefghi
str2:abaaacdkkkcdefga
答案?
由此,这样的函数是没意义的.

除非规定得更细致,更形式化.

嗯，我也觉得这个函数的功能没有说清楚。
s1:='夫人反对法然而入阿富'
s2:='11212夫3人445反对法然而4343入阿富54'
答案:
err:=15?

Kingron 的猛料我珍藏了，谢谢

下面是我的一个测试过程，匆忙编写，可能有错误，尤其是对边界情况可能出现的
错误没有处理，希望大家指正！
这个帖子我已经回复了三次，不能再回复了，希望大家继续讨论procedure TForm1.CompareStr(s1,s2:string;var Total,Err:integer);
var
s2P:PChar;
s2Pos,s2Len,i,j,CHeckNum:Integer;
s1Str,s2Single:String;
begin
Total:=Length(s1);
if Length(s2)=0 then
begin
  Err:=Total;
  Exit;
end;
GetMem(s2P,255);
StrPCopy(s2P,s2);
s1Str:=s1;
s2Pos:=0;
s2Len:=Length(s2);
CheckNum:=0;
while (s2Pos<=s2Len-1) do
begin
  j:=Ord(s2P[s2Pos]);
  if j>128 then
  begin
   s2Single:=Copy(s2,s2Pos+1,2);
   s2Pos:=s2Pos+2;
  end
  else
  begin
   s2Single:=Copy(s2,s2Pos+1,1);
   s2Pos:=s2Pos+1;
  end;
  i:=Pos(s2Single,s1Str);
  if i>0 then
  begin
   if j>128 then  //判断是否为汉字
   begin
    CheckNum:=CheckNum+2;
    s1Str:=Copy(s1Str,i+2,255);
   end
   else
   begin
    CheckNum:=CheckNum+1;
    s1Str:=Copy(s1Str,i+1,255);
   end;
  end;
end;
if Length(s2)>Length(s1) then
  Err:=Length(s2)-CheckNum
else
  Err:=Length(s2)-CheckNum+Length(s1)-Length(s2);
FreeMem(s2P);
end;

To redwoodnymph(红蜂鸟):
  不用感谢。我公布出来是希望提高大家的DELPHI的水平，希望有更多的人做到这一点。
To All：
  感谢大家帮助提前我的贴子。
这个算法我考虑了好久，终于想到了一个办法：
就是查找字符的位置，在s1中的i字符的位置应该小于i+1的位置！这样的话，需要一个双重循环！我目前没有用双重循环，只是用了一个循环，所以精确度不高！头都大了，实在是写起来很烦人，目前我写的算法已经能够满足应用的需要，但是我想写的完美一些，大家一起努力把，可以我的代码没有在这里，不然贴出来了。我给出我目前算法的大致的框架吧：
var
  ch1,ch2:string;
  i:integer;
begin
  inc(Total,length(s1));
  for i:=1 to length(s1) div 2 do
  begin
   ch1:=取i个字符（两个Byte，因为要考虑到汉字）
   ch2:=取I+1个字符（两个Byte，同上）
   if (Pos(ch1,s2)=-1) or (pos(ch1,s2)>pos(ch2,s2) then
     inc(Err,2);
  end;
当然还要考虑到有重复字符的情况！需要特别的处理。

To c_hk(小李抢刀)：
你的算法我没有测试，但是我想应该差不多吧。跟我的思路很相近！非常感谢！

有没有限制必须length(s1) > length(s2)???
否则：
s1='搜索,一个字符串，在另外！'
s2='搜索,一个字符串，在另外搜索,一个字符串，在另外！！';
这时Err=0更合理巴。

To guig(胖胖)　
的确这个问题在我的应用中也是一个头疼的问题，我也无法决定是否应该计算Err，不过考虑从用户的角度出发，我想，不应该计算Err吧。只计算前面的部分算了。

程序在 http://kingron.myetang.com/soft/ctest.zip （但是在竹叶页面上没有连接）
源代码我还没有整理好，代码也没有优化，如果大家实在要，我过几天整理好了，就UpLoad。
我保证，上面的程序不包含任何恶意代码，但是因为我是用其他的机器上载文件的，好像有病毒感染？WFun.Love99?病毒？请下载之后注意杀毒！

看看我的算法：
对原来的问题做了一定的扩展:
s1='搜索,一个字符串，在另外！'
s2='搜索,一个字符a串，在另外！'
s3='搜索,一个字符串，在另外！'
CompareStr(s1,s2,Total,Err);
Total应该=25
Err=-1;//表示s1在s2中可按顺序匹配但s2中类似的字符串分成了2段。（abs(Err) + 1 段）CompareStr(s1,s3,Total,Err);
Total应该=25
Err=-2；//表示s1在s3中可按顺序匹配但s3中类似的字符串分成了3段。（abs(Err) + 1 段）CompareStr(s1,s3,Total,Err);
Total应该=25
Err=0；
如不加扩展定义，用我的算法前面三个例子的Err将都为0，显然不合理，故加以扩展。/////////////////////////////////////////////
{******************
GetMinErr求ms1和ms2比较时最小的Err
CurLev表示当前的递归深度，第一次为0
MinLev表示得到MinErr的值时的最小递归深度。
*******************}
procedure GetMinErr(ms1,ms2:PWideChar;var MinErr,MinLev:integer;CurLev:integer = 0);
var
  wtemp:WideString;
  ps1,es1,ps2,es2:PWideChar;
  i,ml,templev:integer;
  temps:string;
  er1,er2:integer;
begin
  temps := WideCharToString(ms1);
  MinErr := Length(temps);
  MinLev := MinErr;
  ml := MinErr;
  wtemp := '';

  for i := 0 to ml - 1 do
  begin
    ps1 := ms1 + i;
    ps2 := ms2;    temps := wtemp;//前几个不匹配的字符
    er1 := length(temps);//不匹配字符数1
    wtemp := wtemp + ps1^;
    if er1 >= MinErr then Break;    repeat
      while (ps2^ <> #0) and (ps1^ <> ps2^) do inc(ps2);//寻找开始相同的位置
      if ps2^ <> #0 then
      begin
        es1 := ps1 + 1;
        es2 := ps2 + 1;
        while (es1^ <> #0) and (es2^ <> #0) and (es1^ = es2^) do
        begin
          inc(es1);
          inc(es2);
        end;        if es1^ = #0 then
        begin
          er2 := 0;//不匹配字符数2
          templev := CurLev;
        end else if es2^ = #0 then
        begin
          temps := WideCharToString(es1);
          er2 := length(temps);//不匹配字符数2
          templev := CurLev;
        end else
        begin
          GetMinErr(es1,es2,er2,templev,CurLev + 1);//不匹配字符数2
        end;
        er1 := er1 + er2;
        if (er1 < MinErr) or ((er1 = MinErr) and (templev < MinLev) ) then
        begin
          MinErr := er1;
          MinLev := templev;
        end;        inc(ps2);//为下一次寻找做准备      end else
      begin
        break;
      end;    until ( false );  end;end;procedure CompareStr(s1,s2:string;var Total,Err:integer);
var
  ws1,ws2:WideString;
  MinLev:integer;begin
  ws1 := s1;
  ws2 := s2;  Total := length(s1);
  GetMinErr(PWideChar(ws1),PWideChar(ws2),Err,MinLev);  if Err = 0 then Err := Err - MinLev;end;

上面的解释部分敲错了，应该这样：对原来的问题做了一定的扩展:
s1='搜索,一个字符串，在另外！'
s2='搜索,一个字符a串，在另外！'
s3='搜索,一个字符a串，在另b外！'
s4='搜索,一个字符串，在另外！'
CompareStr(s1,s2,Total,Err);
Total应该=25
Err=-1;//表示s1在s2中可按顺序匹配但s2中类似的字符串分成了2段。（abs(Err) + 1 段）CompareStr(s1,s3,Total,Err);
Total应该=25
Err=-2；//表示s1在s3中可按顺序匹配但s3中类似的字符串分成了3段。（abs(Err) + 1 段）CompareStr(s1,s4,Total,Err);
Total应该=25
Err=0；
如不加扩展定义，用我的算法前面三个例子的Err将都为0，显然不合理，故加以扩展。

调试易

［３００’］求一字符串匹配算法！

解决方案 »