求比我写的这个POS函数更优化的函数(50分)

function FindPosBM(const ASub, ASource: string
AStartPos: Integer = 1): Integer;
const
MAX_CHAR = 256;
SizeInt = SizeOf(Integer);
type
PByteArr = ^TByteArr;
TByteArr = array[0..MaxInt - 1] of Byte;
var
Src, Sub: PByte;
I, J, CurrPos, SubLen, SrcLen: Integer;
Buffer: array[0..MAX_CHAR - 1] of Integer;
begin
Result := 0;
SubLen := Length(ASub);
SrcLen := Length(ASource);
if SubLen > SrcLen then
Exit;

Sub := PByte(ASub);
Src := PByte(ASource);
for I := 0 to MAX_CHAR - 1 do
Buffer := SubLen;
for I := 0 to SubLen - 2 do
Buffer[PByteArr(Sub)^] := SubLen - I - 1;

CurrPos := SubLen + AStartPos - 2;
while CurrPos < SrcLen do
begin
I := CurrPos;
J := SubLen - 1;
while (J >= 0) and ((PByteArr(Src)^ = PByteArr(Sub)^[J])) do
begin
Dec(J);
Dec(I);
end;
if - 1 = J then
begin
Result := CurrPos - SubLen + 1;
break;
end;
Inc(CurrPos, Buffer[PByteArr(Src)^[CurrPos]]);
end;
end;

function BMH(const lpSubStr, lpSource: string
StartPos: Integer = 1): Integer;
var
I, index, ExitLen: Integer;
CharTable: array[0..255] of Char;
begin
if Length(lpSubStr) < 1 then
begin
Result := -2
// 子字符串长度不能小于1位
Exit;
end;
// 初始化CharTable
FillChar(CharTable, sizeof(CharTable), Char(Length(lpSubStr)));
for I := Length(lpSubStr) downto 1 do
CharTable[Ord(lpSubStr)] := Char(Length(lpSubStr) - I);
if StartPos < 1 then
I := StartPos
else
I := StartPos - 1;
ExitLen := Length(lpSource) - Length(lpSubStr);
while I <= ExitLen do
begin
for index := Length(lpSubStr) downto 1 do
begin
if lpSource[I + index] <> lpSubStr[index] then
break;
end;
if index < 1 then
begin
Result := I + 1;
Exit;
end
else if CharTable[Ord(lpSource[index + I])] = Char(Length(lpSubStr)) then
I := I + index - 1;
Inc(I);
end;
Result := -1
// 没有匹配的字符串
end;

{ TMainForm }

procedure TMainForm.Test(const AMsg: string);
var
nCount, nOffset,
I, nTick, nPos: Integer;
S1, S2: string;
Func: TPosEx;
begin
S1 := Edit1.Text;
S2 := Edit2.Text;

nCount := 1000000;
nOffset := 1;
nPos := -1;

with Memo1.Lines do
begin
Add(' - > ' + AMsg);
nTick := GetTickCount;
for I := 0 to nCount - 1 do
begin
nPos := FFunc(S1, S2, nOffset);
end;
nTick := GetTickCount - nTick;
Caption := IntToStr(nPos);
Add(' ' + IntToStr(nTick))
end;
end;

procedure TMainForm.Button1Click(Sender: TObject);
var
nCount, I, nPos: Integer;
S1, S2: string;
begin
Randomize;

nCount := RandomRange(8, 32);
SetLength(S1, nCount);
for I := 1 to nCount do S1 := Chr(RandomRange(Ord('a'), Ord('z')));

nCount := RandomRange(256, 1024);
SetLength(S2, nCount);
for I := 1 to nCount do S2 := Chr(RandomRange(Ord('a'), Ord('z')));

nPos := RandomRange(512, 1024)
{ 人为的构造查找结果 }
Insert(S1, S2, nPos);

Edit1.Text := S1;
Edit2.Text := S2;
Memo1.Lines.Clear;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
FFunc := Delphi7PosEx;
Test('Delphi 7 PosEx');

FFunc := Delphi2007PosEx;
Test('Delphi 2007 PosEx');

FFunc := Q_PosStr;
Test('Q_PosStr');

FFunc := FindPosBM;
Test('FindPosBM');

FFunc := BMH;
Test('BMH');

FFunc := FastcodePosExSSE
{ 在我的机器上 FastcodeTarget -> 3 FastcodePosExSSE/FastcodePosExSSESizePenalty }
Test('FastCode');
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
Caption := IntToStr(Ord(FastcodeTarget));
end;

end.

这是在我的机器上（AMD 1800+ 1.5G）的一次测试结果：
substr：
bodtrimiuqlwhep
sourcestr：
qeevycwmwvuedwgoyctmcyqabrtminwpkrbppplbpnmfsmrunynhgvmgdbutwjbpenvivvddovewcalls
ooovwpooraetlclivpidjsdketimsmovmdboumqnyixixjgjxhjvownklvmvccvgdqvabkhxwigkenveb
dljmaxodmhjvtqoampuxnlkveggsqqqkhcycldpejmvanxrrfekkseivounobqbicewxgaabssjvpkosj
wjhtspkuwkuiqqdxaimkqutlorwogmqqmbcimblsenwowdcgenxpfwuwltyilwatbwetybnvhwnblgoot
nfmasfcsgecnjlpbfojutqetcpkwawnfkymoqnopbtlrvoakidetykhcbkrnpltiftulmtnfqkitixakl
meuhvkmekcflpdjwunlyoqmxxwgcgpquybawnhfjiimdtkwjcoljxgkhnrfndygntjptogiyfiplhoynj
rmtngtmopljfhqtsownngusikikroxffkrwmbetswilgwqmoukopuoxgeeginoexdlfjsfxwbwuwdnusf
twjxiftofkrocfobewjwjahwvtwlvqjptgbisrywflgyayygltdsaskrmtxkqxlrhegfjbfrnfmaidsob
kvahdywubodtrimiuqlwhepluoimscltejrgcxgsycjgfsubfcksxkjtgprfsbkwogxvmvyfdsvwogusl
xkmojksbiwurvmdpujunccdnkwoqmdbgydvkgvqyomcpmetbncmqnndsucsepdkwikrgxfbvfmqiudtcp
dsnkuyhpgunrgvdrxjdooongffklcuosixbhhttosdxmbffhhqkpvcuukidaxhsemtmcssupfbhsgyxxx
uqwksoyfnqsrgkthnhbshbqtukwrhpahmrnjuqadhtupnvygwesjearvqsikabnnwrblvygcddgyoxuvw
dynelvitmdoupavoagblkblkcvgpyvkemyoixilftikydogqhecqxvumv
result：
657

- > Delphi 7 PosEx
2093
- > Delphi 2007 PosEx
1552
- > Q_PosStr
1953
- > FindPosBM
1522
- > BMH
2263
- > FastCode
1282

LSUPER:希望你用我贴的BMH测试一下,在我的电脑上速度是你的3倍
FastCode的BenchMark全部是长度很短的字符串的测试,一般几十个字符,最长也就200多,这样的测试意义不大.
我曾经给他们写过电子邮件问为什么不用几K和几十K的文本测试,他们回答说FastCode只适用于小范围搜索,文本越长,FastCode就越没有优势,在几十K以上的文本中搜索也许还不如System.POS快(老外很诚实 )

这是我用LSUPER的substr和sourcestr的测试结果:
LSUPER的BMH为什么很慢:因为在循环里使用了大量的字符串操作.
要想快就:1.使用指针数组,少用字符串. 2.少用while和repeat,多用goto(goto是最灵活最接近机器码,效率也最高)

次数=1000000 子串长=15 母串长=1055

System 位置: 673 时间: 2657
BMH 位置: 673 时间: 593
LSUPER_BMH 位置: 673 时间: 1797
PosN_PosEx 位置: 673 时间: 1828
Quick 位置: 673 时间: 2672
FastPos 位置: 673 时间: 2172

BMHTextPOS 位置: 673 时间: 1031

是BMH快，还是FastCode快，科学点好不好？！
如果一个专门测试FastCode的程序，FastCode确实是快，但是大多数情况下，大多
数程序段，根本不会去执行FastCode的代码，所以就没效果，而BMH是针对性的算法，
它的代码在这里经常执行，所以就快。
是BMH快，还是FastCode快，还要看看执行环境，看看代码在这整个程序执行的比例。
有人说D2007使用FastCode快了许多，然后举出一堆针对性的测试结果，这是很片面
的，一两黄金很值钱，但分布到一座山里面，连看也看不见。

to lxddd：
1、
呵呵，我上面说了啊，我的测试前提：
“不过直觉这和具体的应用场合可能非常相关，楼上的测试：子串长=xx 母串长=14xxxx 上百 k 的内容啊。我通常自在字段中查找，长度通常 < 1k。”

来自：LSUPER, 时间：2008-4-3 23:06:27, ID：3885090 | 编辑
发一个例子，具体的结果可能有偏差，不过这无关紧要，[red]重要的是结合自己项目实际场景进行函数的选取，尺有所短寸有所长吗。[/red]

2、
“LSUPER_BMH”汗颜啊，当时为了测试，随手摘抄的“最后发的” BMH 代码，就是
来自：[xiaopei], 时间：2008-3-31 17:07:26, ID：3883894 发布的那个

3、刚才仔细看了，lxddd 你建议是那个：
function BMH0(subpt: QByte
SubLen: Integer
fapt: QByte
fLen: Integer
n: Integer = 1): Integer;

更新我的测试例子：
procedure TMainForm.Testlxddd_BMH(const AMsg: string);
var
nCount, nOffset,
I, nPos: Integer;
nTick: LongWord;
S1, S2: string;
cPos: TPos;
begin
S1 := Edit1.Text;
S2 := Edit2.Text;

nCount := 1000000;
nOffset := 1;
nPos := -1;

with Memo1.Lines do
begin
Add(' - > ' + AMsg);
nTick := GetTickCount;
cPos := TPos.Create;
for I := 0 to nCount - 1 do
begin
nPos := cPos.Pos(S1, S2, nOffset);
end;
FreeAndNil(cPos);
nTick := GetTickCount - nTick;
Caption := IntToStr(nPos);
Add(' ' + IntToStr(nTick))
end;
end;

上面需要 uses BMHPos，这是一次测试结果：
- > Delphi 7 PosEx
3164
- > Delphi 2007 PosEx
2514
- > Q_PosStr
2624
- > FindPosBM
1812
- > xiaopei_BMH
2764
- > lxddd_BMH
1623
- > FastCode
1872
只要实现的好，BMH 算法确实是最快的 ;>

to kinneng：
1、“如果一个专门测试FastCode的程序，FastCode确实是快，但是大多数情况下，大多
数程序段，根本不会去执行FastCode的代码，所以就没效果，而BMH是针对性的算法，
它的代码在这里经常执行，所以就快。”你这是什么逻辑？真实的场景是：我项目代码原来是 PosEx 的现在换成 FastCodePosEx 或者 BMHPosEx，我当然构造项目环境针对性的测试啦我这样替换带来的好处啊：尽管这样替换 PosEx 可以提升例如 50% 的效率，也许占总时间不足 1%，但效率就是这么一点一点的挤出来的啊。
2、没人必你用 FastCode 啊
3、“但是大多数情况下，大多数程序段，根本不会去执行FastCode的代码，所以就没效果”。确实，我审过不少程序员写的代码，有一些写的很烂而且非常没有效率。烂人给他再牛x的编译器也白搭。重要的还是程序员的专业素质啊。
4、上面 errorcode 给出的 FindPosBM 不但思路清晰明了而且非常的高效，很专业！pfpf！对于 lxddd 的代码，看得出你非常注重代码细节，看重代码的执行效率（如 JoinStr 之类的，我看到 Result := Result + .. 就想骂人！）不过过我想说，这个 BMHPos 单元实现的有些小瑕疵，比如，既然抽提了 TPos 为什么游离 BMH0 之类的历程？单元搞全局变量可以放到 TPos 中啊（否则多线程无法使用了 :），还有直接用 delphi 的 string 多好啊，非得用 QByte；个人不喜欢这样的写法：
Result := MemBMH(@substr[1], Length(substr), @fastr[1], Length(fastr), n) + 1;
我通常使用：
Result := MemBMH(QByte(substr), Length(substr), QByte(fastr), Length(fastr), n) + 1;
因为说白了，string 就是 pointer。
;>

BMH0之所以单独做为一个函数,是因为后面的字符串替换函数也要用到它;
全局变量是我考虑不周,应该放到TPos里,多谢指教;
谁有兴趣可以测试一下TextPos和ReplaceText,目前还没发现哪个函数速度能达到它们的1/3

楼上的BMH0代码太难看懂，取变量名能不能取个有意义点的？不然弄成汇编让我看不懂得了。。。

还有，你那ReplaceText的处理应该这样会更好些：先找到所有SubString的位置Poss: array of Integer；记录起来，然后计算最后replace的长度内存，一次SetLength，而不是循环体中不断SetLength。在循环体中重新分配内存是效率的杀手。

QQ在线:
BMH比BM和KMP简单的多,只要掌握算法,很容易看懂;
SetLength在ReplaceText共有3次,全部在循环体外;
你说的处理我早就试过,必须把母串过2遍,速度并不快,花费时间大约是现在这种方法的1.2~2倍.

to LSUPER
基本同意您的说法，只不过网上将FastCode吹得好像用了它之后，奔三快过双核一样，
期望太高了。

BM算法的原理倒底是什么，在网上搜了一下，好像是一种仿生学的算法，就是
摸拟蚂蚁的运动。

>>难道你选好了 MyPosEx 然后 UltraEdit Replace PosEx ？？这个不是项目的做法。
我不是在程序的所有地方都用优化的POS函数，只在最核心的地方调用。只需要改一个
POS函数即可。如果POS函数在程序中遍布，恰恰说明软件的结构不好。
在我的软件中，用到POS的也仅有几处。我还有自编的几个CHARPOS函数，用于不同的
需要。

BMH大概是这样：
原理上是比BM快，所以也就快了。呵呵

function FindPosBMH(const ASub, ASource: string
AStartPos: Integer = 1): Integer;
var
Sub, Src: PByteArray;
I, J, CurrPos, SubLen, SrcLen: Integer;
Buffers: array [0..255] of Integer;
begin
Result := 0;
SubLen := Length(ASub);
SrcLen := Length(ASource);
if (SubLen = 0) or (SubLen > SrcLen) then Exit;

Sub := Pointer(ASub);
Src := Pointer(ASource);
for I := 0 to 255 do
Buffers := SubLen;
for I := 0 to SubLen - 1 do
Buffers[Sub] := SubLen - I - 1;

CurrPos := AStartPos + SubLen - 1;
while CurrPos < SrcLen do
begin
J := Buffers[Src[CurrPos]];
if J > 0 then
begin
Inc(CurrPos, J);
continue;
end;

I := CurrPos;
J := SubLen - 1;
while (J >= 0) and (Src = Sub[J]) do
begin
Dec(J);
Dec(I);
end;

if -1 = J then
begin
Result := CurrPos;
break;
end else
Inc(CurrPos, SubLen);
end;
end;

delphi的这个应该很快了吧,循环肯定没这个汇编来的快啊

procedure _Pos{ substr : ShortString
s : ShortString ) : Integer};
asm
{ ->EAX Pointer to substr }
{ EDX Pointer to string }
{ <-EAX Position of substr in s or 0 }

PUSH EBX
PUSH ESI
PUSH EDI

MOV ESI,EAX { Point ESI to substr }
MOV EDI,EDX { Point EDI to s }

XOR ECX,ECX { ECX = Length(s) }
MOV CL,[EDI]
INC EDI { Point EDI to first char of s }

PUSH EDI { remember s position to calculate index }

XOR EDX,EDX { EDX = Length(substr) }
MOV DL,[ESI]
INC ESI { Point ESI to first char of substr }

DEC EDX { EDX = Length(substr) - 1 }
JS @@fail { < 0 ? return 0 }
MOV AL,[ESI] { AL = first char of substr }
INC ESI { Point ESI to 2'nd char of substr }

SUB ECX,EDX { #positions in s to look at }
{ = Length(s) - Length(substr) + 1 }
JLE @@fail
@@loop:
REPNE SCASB
JNE @@fail
MOV EBX,ECX { save outer loop counter }
PUSH ESI { save outer loop substr pointer }
PUSH EDI { save outer loop s pointer }

MOV ECX,EDX
REPE CMPSB
POP EDI { restore outer loop s pointer }
POP ESI { restore outer loop substr pointer }
JE @@found
MOV ECX,EBX { restore outer loop counter }
JMP @@loop

@@fail:
POP EDX { get rid of saved s pointer }
XOR EAX,EAX
JMP @@exit

@@found:
POP EDX { restore pointer to first char of s }
MOV EAX,EDI { EDI points of char after match }
SUB EAX,EDX { the difference is the correct index }
@@exit:
POP EDI
POP ESI
POP EBX
end;

这个要快，应该觉对的用汇编，并且要四字对齐!

什么叫四字对齐，能不能讲一下原理