Delphi实验：在串中查找第i个子串的位置及效率评测

lw549说 取得字符串中指定子字符串出现第n次的位置,效率不高,勉强可用 。感上兴趣，于是试上一试。
程序附在最后，这里是一些说明文字：
1、为快速写好，没有使用应当使用的控制台方式，而是使用了GUI方式；
2、测试的样例是查找包含有四处子串的字符串，四次分别查四个位置。这个在Button1Click方法中完成，它调用Tests来进行具体测试，以被测函数、第几次出现、循环次数为参数；
3、Tests依次在一个循环中重复调用每个具体的函数，同时为了公平起见（也许前面的函数为后面的铺了一些路——内存、高速缓冲），这样的测试进行TEST_COUNT次，最后输出每次的平均时间；
4、经过前期的测试，lw549 的代码的确效率不高，所以单独给它小一些的循环次数（一千次），以免造成程序假死现象；其它的为十万次；
5、其它三个函数的思想为：
PosN_Pos: 使用Pos函数及Copy函数；
PosN_PosEx: 使用Delphi 7中增加的PosEx函数；
PosN_StrPos: 使用StrPos函数。

程序输出：

Search "function GetNSubStringPos(N: Integer; SubString,AString: String): Integer;" for "String"
1:
substr index: 1; LOOP COUNT = 1000
GetNSubStringPos: return 17; Timing: 37.60 ms
substr index: 1; LOOP COUNT = 100000
PosN_Pos: return 17; Timing: 40.40 ms
PosN_PosEx: return 17; Timing: 15.60 ms
PosN_StrPos: return 22; Timing: 37.80 ms
2:
substr index: 2; LOOP COUNT = 1000
GetNSubStringPos: return 42; Timing: 96.80 ms
substr index: 2; LOOP COUNT = 100000
PosN_Pos: return 42; Timing: 81.20 ms
PosN_PosEx: return 42; Timing: 47.00 ms
PosN_StrPos: return 47; Timing: 53.00 ms
3:
substr index: 3; LOOP COUNT = 1000
GetNSubStringPos: return 50; Timing: 109.40 ms
substr index: 3; LOOP COUNT = 100000
PosN_Pos: return 50; Timing: 118.80 ms
PosN_PosEx: return 50; Timing: 53.00 ms
PosN_StrPos: return 55; Timing: 62.60 ms
4:
substr index: 4; LOOP COUNT = 1000
GetNSubStringPos: return 58; Timing: 128.20 ms
substr index: 4; LOOP COUNT = 100000
PosN_Pos: return 58; Timing: 162.60 ms
PosN_PosEx: return 58; Timing: 59.40 ms
PosN_StrPos: return 63; Timing: 74.80 ms

可以看出，测试的结果（效率）是：  PosN_PosEx > PosN_StrPos > PosN_Pos >> GetNSubStringPos 。
我本来期望的是 PosN_StrPos 最厉害，但结果不是。估计是 PosEx 优化得比较厉害。

附代码：

Unit1.pas:

unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBTables; type TPosNFunc = function (N: Integer; const SubString,AString: String): Integer; type TForm1 = class(TForm) Memo1: TMemo; Button1: TButton; procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private procedure Tests(const funcs: array of TPosNFunc; const funcnames: array of string; iStr: integer; loopcount: integer); public end; var Form1: TForm1; implementation uses StrUtils; {$R *.dfm} function GetNSubStringPos(N: Integer; SubString,AString: String): Integer; //返回第n个SubString在AString中出现的位置 //如果没找到,返回-1 var FindCount: Integer; Pos: Integer; begin Result := -1; Pos := 0; for FindCount := 1 to N do begin Inc(Pos); while MidStr(AString, Pos, Length(SubString)) <> SubString do begin if Length(AString) < Length(SubString) + Pos then Exit;//未找到 Inc(Pos); end; end; Result := Pos; end; function PosN_Pos(N: Integer; SubString, AString: String): Integer; var p: integer; nSub: integer; nSrc: integer; begin nSub := Length( SubString ); nSrc := Length( AString ); result := -nSub; while N>0 do begin p := Pos(SubString, AString); if p=0 then break; Dec( N ); Inc( result, p+nSub ); AString := Copy( AString, p+nSub+1, nSrc-nSub-p-1 ); Dec( nSrc, nSub+p ); end; if N>0 then result := -1; end; function PosN_PosEx(N: Integer; SubString,AString: String): Integer; var p: integer; nSub: integer; begin nSub := Length( SubString ); result := 0; p := 0; while N>0 do begin p := PosEx( SubString, AString, p+1 ); if p=0 then break; Dec( N ); result := p; Inc( p, nSub ); end; if N>0 then result := -1; end; function PosN_StrPos(N: Integer; SubString, AString: String): Integer; var pSub, pSrc, p: Pchar; nSub: integer; begin nSub := Length( SubString ); pSub := PChar(SubString); pSrc := PChar(AString); p := pSrc; while (N>0) do begin p := StrPos( p, pSub ); if (p=nil) then break; Inc( p, nSub ); Dec( N ); end; if (N=0) and (p<>nil) then result := p - pSrc else result := 0; end; const STR = 'function GetNSubStringPos(N: Integer; SubString,AString: String): Integer;'; SUBSTR = 'String'; TEST_COUNT = 5; procedure TForm1.Tests( const funcs: array of TPosNFunc; const funcnames: array of string; iStr: integer; loopcount: integer ); var i, j, k: Integer; tm: Longword; func: TPosNFunc; count: integer; retv: array of integer; results: array of Longword; begin count := Length(funcs); assert( count=Length(funcnames) ); Memo1.Lines.Add( Format('substr index: %d; LOOP COUNT = %d', [iStr, loopCount]) ); SetLength( retv, count ); SetLength( results, count ); for j:=0 to count-1 do results[j] := 0; for k:=1 to TEST_COUNT do begin for j:=0 to count-1 do begin func := funcs[j]; tm := GetTickCount; for i:=1 to loopcount do retv[j] := func( iStr, SUBSTR, str ); Inc( results[j], GetTickCount - tm ); end; end; for j:=0 to count-1 do begin Memo1.Lines.Add( Format( '%s: return %d; Timing: %n ms', [funcnames[j], retv[j], results[j]*1.0/TEST_COUNT ] ) ); end; end; procedure TForm1.Button1Click(Sender: TObject); var i: integer; begin for i:=1 to 4 do begin Memo1.Lines.Add( Format( '%d:', [i]) ); Tests( [@GetNSubStringPos], ['GetNSubStringPos'], i, 1000 ); Tests( [@PosN_Pos, @PosN_PosEx, @PosN_StrPos], ['PosN_Pos', 'PosN_PosEx', 'PosN_StrPos'], i, 100000 ); end; end; procedure TForm1.FormCreate(Sender: TObject); begin Memo1.Clear; Memo1.Lines.Add( Format( 'Search "%s" for "%s"', [STR, SUBSTR] ) ); end; end.

Unit1.dfm:

object Form1: TForm1 Left = 243 Top = 164 Width = 578 Height = 516 AlphaBlendValue = 192 Caption = 'Form1' Color = clBtnFace Font.Charset = DEFAULT_CHARSET Font.Color = clWindowText Font.Height = -11 Font.Name = 'MS Sans Serif' Font.Style = [] OldCreateOrder = False Position = poDefaultPosOnly OnCreate = FormCreate DesignSize = ( 570 489) PixelsPerInch = 96 TextHeight = 13 object Memo1: TMemo Left = 3 Top = 32 Width = 565 Height = 457 Anchors = [akLeft, akTop, akRight, akBottom] Lines.Strings = ( 'Memo1') ScrollBars = ssVertical TabOrder = 0 end object Button1: TButton Left = 3 Top = 6 Width = 75 Height = 25 Caption = 'Button1' TabOrder = 1 OnClick = Button1Click end end

本文地址：http://com.8s8s.com/it/it4424.htm