如何高效地操作字符串（三）： 第二篇中涉及内容的源代码(0分)

  • 主题发起人 Another_eYes
  • 开始时间
A

Another_eYes

Unregistered / Unconfirmed
GUEST, unregistred user!
由于delphi的StringReplace没有提供替换计数的功能， 所以我将StringReplace源代码从SysUtils.pas中copy了出来， 进行了修改。
半部分为FastPos与FastReplace的实现代码
后半部分为测试程序源代码
代码: 
const
  FR_ARR_SIZE = 512;
  FR_ARR_INC = 32;
var
  MatchPoses: array of Integer;
 // 缓冲区, 保存所有匹配的位置
function FastPos(Source: PChar;
SLen: Integer;
SubS: PChar;
SubLen: Integer;
StartPos: PInteger = nil;
CaseSensitive: Boolean = False): Integer;
var
  b: Integer;
  function DiffChars(p1, p2: PChar;
L: Integer): Boolean;
assembler;
  asm
      		PUSH	ESI
                PUSH    EDI
                MOV     ESI,EAX
                MOV     EDI,EDX
                XOR     EAX,EAX
                OR      ECX,ECX
  		JZ	@@4
                XOR     EDX,EDX
		CMP     byte ptr [CaseSensitive],0
                JE      @@1
                REPE    CMPSB
                JE      @@4
                MOV     EAX,1
                JMP     @@4
    @@1:        REPE    CMPSB
                JE      @@4
    	        MOV	AL,[ESI-1]
		CMP	AL,'a'
		JB	@@2
		CMP	AL,'z'
		JA	@@2
		SUB	AL,20H
    @@2:        MOV     DL,[EDI-1]
                CMP	DL,'a'
		JB	@@3
		CMP	DL,'z'
		JA	@@3
		SUB	DL,20H
    @@3:	SUB	EAX,EDX
		JE	@@1
    @@4:        POP	EDI
                POP     ESI
  end;

begin
  if (StartPos <> nil) and (StartPos^ > 0) then
 b := StartPos^ - 1 else
 b := 0;
  Result := 0;
  if SubS = nil then
 Exit;
  if SubLen > SLen - b then
  begin
    if StartPos <> nil then
 StartPos^ := SLen+1;
    Exit;
  end;
  while b < SLendo
  begin
    if not DiffChars(Source+b, SubS, SubLen) then
    begin
      Result := b+1;
      Inc(b, SubLen);
      break;
    end;
    Inc(b);
  end;
  if StartPos <> nil then
 StartPos^ := b+1;
end;

function FastReplace(var Tag: string;
                    // 目的串
                         const FindStr, ReplaceStr: string;
                         FromPos: Integer=1;
             // 开始查找替换的位置
                         ToPos: Integer=-1;
              // 结束位置, 后面即使有也不替换了
                         CaseSensitive: Boolean = False;
 // 大小写敏感
                         WordOnly: Boolean = False        // 只替换完整的单词(不替换单词中部分匹配的情况)
                         ): Integer;
                     // 返回总共替换的个数
var
  MaxCnt: Integer;
  RplLen: Integer;
  FndLen: Integer;
  Gap: Integer;
  i, n, m, p, l: Integer;
  function IsWord: Boolean;
  begin
    result := not (
      ((n>FndLen-1) and (Tag[n-FndLen-1] in ['0'..'9', '_', 'A'..'Z', 'a'..'z', #127..#255]))
          // 匹配字符串的前一个字符不是标点或空格
       or
      ((n <= ToPos) and (Tag[n] in ['0'..'9', '_', 'A'..'Z', 'a'..'z', #127..#255]))
          // 匹配字符串的后一个字符不是标点或空格
      );
  end;

begin
  Result := 0;
  if (Tag = '') or (FindStr='') then
 Exit;
  FndLen:=Length(FindStr);
  RplLen := Length(ReplaceStr);
  Gap := RplLen - FndLen;
  if High(MatchPoses)<0 then
    SetLength(MatchPoses, FR_ARR_SIZE);
  MaxCnt := High(MatchPoses)+1;
  n := FromPos;
  if ToPos < 0 then
 ToPos := Length(Tag);
  while n <= ToPosdo
  begin
    if FastPos(pchar(Tag), ToPos, pchar(FindStr), FndLen, @n, CaseSensitive) > 0 then
    begin
      if not WordOnly or IsWord then
      begin
        if Result >= MaxCnt then
        begin
          Inc(MaxCnt, FR_ARR_INC);
          SetLength(MatchPoses, MaxCnt);
        end;
        MatchPoses[Result] := n;
        inc(Result);
      end;
    end;
  end;
  if Result > 0 then
    if Gap > 0 then
                         // 被替换的串短
    begin
      m := Length(Tag) + 1;
      p := Gap * Result + m;
      SetLength(Tag, p-1);
                 // 调整字符串大小
      for n := Result-1do
wnto 0do
      begin
        l := m - MatchPoses[n];
        Move(Tag[MatchPoses[n]], Tag[p-l], l);
// 移动两个被替换串之间的字符
        Dec(p, l+RplLen);
        m := MatchPoses[n] - FndLen;
        Move(ReplaceStr[1], Tag[p], RplLen);
  // 替换
      end;
    end
    else
 if Gap < 0 then
                    // 被替换的串长
    begin
      p := MatchPoses[0] - FndLen;
      for n := 0 to Result - 1do
      begin
        if n = Result - 1 then
                 //　移动两个被替换串间的字符
          l := Length(Tag) - MatchPoses[n]+1
        else
          l := MatchPoses[n+1]-MatchPoses[n]-FndLen+1;
        if ReplaceStr <> '' then
          Move(ReplaceStr[1], Tag[p], RplLen);
        Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
 // 替换
        Inc(p, RplLen+l-1);
      end;
      SetLength(Tag, p);
                      // 调整字符串大小
    end
    else
      for n := 0 to Result - 1do
        Move(ReplaceStr[1], Tag[MatchPoses[n]-FndLen], FndLen);
// 直接替换
end;

// 测试程序源代码
const
  MAX_SEED_CNT =  10;
  MAX_SEED_LEN =  128;
var
  Buffer: string;
  Seeds: array of string;
  sss: string;
procedure GenTestData(max_data_len: Integer);
var
  i, j, n, l: Integer;
begin
  setlength(Seeds, random(MAX_SEED_CNT)+3);
  for i := 0 to high(seeds)do
  begin
    setlength(Seeds[i], random(MAX_SEED_LEN)+1);
    for j := 1 to length(Seeds[i])do
      Seeds[i][j] := Char(random(94)+32);
  end;
  j := high(Seeds)+1;
  setlength(buffer, max_data_len);
  n := 1;
  while n < MAX_DATA_LENdo
  begin
    i := Random(j);
    l := length(seeds[i]);
    if n+l>max_data_len+1 then
      l := max_data_len+1-n;
    move(seeds[i][1], buffer[n], l);
    inc(n,l);
  end;
end;

var
  stringreplacecnt: Integer;
function StringReplace(const S, OldPattern, NewPattern: string;
  Flags: TReplaceFlags): string;
var
  SearchStr, Patt, NewStr: string;
  Offset: Integer;
begin
  stringreplacecnt:=0;
 // 我加的
  if rfIgnoreCase in Flags then
  begin
    SearchStr := AnsiUpperCase(S);
    Patt := AnsiUpperCase(OldPattern);
  end else
  begin
    SearchStr := S;
    Patt := OldPattern;
  end;
  NewStr := S;
  Result := '';
  while SearchStr <> ''do
  begin
    Offset := AnsiPos(Patt, SearchStr);
    if Offset = 0 then
    begin
      Result := Result + NewStr;
      Break;
    end;
    inc(stringreplacecnt);
 // 我加的
    Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
    NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
    if not (rfReplaceAll in Flags) then
    begin
      Result := Result + NewStr;
      Break;
    end;
    SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
  procedure AddRep(ttl: string;
l: Integer);
  var
    n: Cardinal;
    i, j: integer;
    s: string;
  begin
    n := GetTickCount;
    GenTestData(l);
    n := GetTickCount-n;
    memo1.lines.add('*******************Test Report('+TTL+')******************');
    memo1.lines.add(format('Generated %d bytes in %d ms', [length(Buffer), n]));
    memo1.lines.add('----------------------Seeds---------------------');
    for i := 0 to high(seeds)do
      memo1.lines.add(inttostr(i+1)+': '+seeds[i]);
    memo1.lines.add('---------------------Testing--------------------');
    setlength(s, random(MAX_SEED_LEN*2));
    for i := 1 to length(s)do
      s[i] := char(random(94)+32);
    i := Random(high(seeds)+1);
    memo1.lines.add('Lookup for '+inttostr(i+1)+': '+seeds[i]);
    memo1.lines.add('');
    memo1.lines.add('Replaced with: '+s);
    memo1.lines.add('');
    memo1.lines.add(' function name                                 '#9'Time(ms) '#9' Replaced Count ');
    if l > 5242880 then
      memo1.lines.add('*** StringReplace (Case Insensitive)'#9'Dare not to test'#9'Unknown')
    else
 begin
      n := gettickcount;
      sss := stringreplace(buffer, seeds[i], s, [rfReplaceAll,rfIgnoreCase]);
      n := gettickcount-n;
      memo1.lines.add(format('*** StringReplace (Case Insensitive)'#9'%d      '#9'%d      ',[n,stringreplacecnt]));
    end;
    n := gettickcount;
    j := fastreplace(buffer, seeds[i],s);
    n := gettickcount-n;
    memo1.lines.add(format('*** FastReplace (Case Insensitive)'#9'%d      '#9'%d      ',[n, j]));
  end;

begin
  memo1.lines.clear;
  addrep('1K data with MatchPoses size '+inttostr(high(matchposes)+1),1024);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('5K data with MatchPoses size '+inttostr(high(matchposes)+1),5120);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('10K data with MatchPoses size '+inttostr(high(matchposes)+1),10240);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('100K data with MatchPoses size '+inttostr(high(matchposes)+1), 102400);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('1M data with MatchPoses size '+inttostr(high(matchposes)+1), 1048576);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('5M data with MatchPoses size '+inttostr(high(matchposes)+1), 5242880);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('10M data with MatchPoses size '+inttostr(high(matchposes)+1),10485760);
  memo1.lines.add('');
  memo1.lines.add('');
  setlength(matchposes,0);
  addrep('10M data with MatchPoses size '+inttostr(high(matchposes)+1),10485760);
  memo1.lines.add('');
  memo1.lines.add('');
  addrep('10M data with MatchPoses size '+inttostr(high(matchposes)+1), 10485760);
  memo1.lines.add('');
  memo1.lines.add('');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  randomize;
end;
源代码分析：
待续......
 
up
 
收了先。
 
Another_eYes:测试过http://www.delphibbs.com/delphibbs/dispq.asp?lid=283208的
那个FastReplace么？不过，他是一次性分配了所有需要的空间的，边查找边替换，当
ReplaceStr比FindStr大很多的时候会有麻烦，呵呵。
你的FastReplace没有考虑中文，可能会有点限制。
Anyway，很好的话题，多谢了。
 
嗯，的确是按照你的第二篇的思路写出来的代码，思路也很清晰。从大多数方面来讲，
已经优化得很不错了。不过，我补充一下，当你的 Result 很大，即需要替换的次数很
多的时候，你这段代码还有值得商酌的地方。在替换循环里面还有一些东西可以移出来
减少循环体内部的开销。一段一段的看吧。
先看第一段：
if Gap > 0 then
// 被替换的串短
begin
m := Length(Tag) + 1;
p := Gap * Result + m;
SetLength(Tag, p-1);
// 调整字符串大小
for n := Result-1do
wnto 0do
begin
l := m - MatchPoses[n];
Move(Tag[MatchPoses[n]], Tag[p-l], l);
// 移动两个被替换串之间的字符
Dec(p, l+RplLen);
m := MatchPoses[n] - FndLen;
Move(ReplaceStr[1], Tag[p], RplLen);
// 替换
end;
end
里面有三次对 MatchPoses[n] 进行访问，而这是一个变址访问，需要一定的消耗，
可以先用一临时变量 MatchPosesN 暂存，可以加快 少许 速度：） 测试代码如下：
var
Buf: array of Byte;
Arr: array of Byte;
procedure TForm1.Button1Click(Sender: TObject);
var
i, j: Integer;
Tick: DWord;
begin
SetLength(Arr, 10000);
SetLength(Buf, 10);
FillChar(Arr[0], 10000, $0F);
Tick := GetTickCount;
for j := 0 to 10000do
for i := 0 to 9999do
begin
Buf[0] := Arr;
Buf[1] := Arr;
Buf[2] := Arr;
Buf[3] := Arr;
Buf[4] := Arr;
Buf[5] := Arr;
Buf[6] := Arr;
Buf[7] := Arr;
Buf[8] := Arr;
Buf[9] := Arr;
end;
ShowMessage(IntToStr(GetTickCount - Tick));
// 平均速度 8.7s
SetLength(Buf, 0);
SetLength(Arr, 0);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
i, j: Integer;
Tmp: Byte;
Tick: DWord;
begin
SetLength(Arr, 10000);
SetLength(Buf, 10);
FillChar(Arr[0], 10000, $0F);
Tick := GetTickCount;
for j := 0 to 10000do
for i := 0 to 9999do
begin
Tmp := Arr;
Buf[0] := Tmp;
Buf[1] := Tmp;
Buf[2] := Tmp;
Buf[3] := Tmp;
Buf[4] := Tmp;
Buf[5] := Tmp;
Buf[6] := Tmp;
Buf[7] := Tmp;
Buf[8] := Tmp;
Buf[9] := Tmp;
end;
ShowMessage(IntToStr(GetTickCount - Tick));
// 平均速度 6.6s
SetLength(Buf, 0);
SetLength(Arr, 0);
end;

可以看到，虽然减少了 2.1s 的时间，但是这是在超大循环次数的前提下的，若无
绝对必要，就不用这样干了：）
有点吹毛求疵了，纯属技术性研究：）
 
再看这一段：
else
if Gap < 0 then
// 被替换的串长
begin
p := MatchPoses[0] - FndLen;
for n := 0 to Result - 1do
begin
if n = Result - 1 then
//　移动两个被替换串间的字符
l := Length(Tag) - MatchPoses[n]+1
else
l := MatchPoses[n+1]-MatchPoses[n]-FndLen+1;
if ReplaceStr <> '' then
Move(ReplaceStr[1], Tag[p], RplLen);
Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
// 替换
Inc(p, RplLen+l-1);
end;
SetLength(Tag, p);
// 调整字符串大小
end
for 循环里面的两次判断都可以移出来！
对于第一个 if n = Result - 1 只在最后一次成立，即它会失败 Result - 2 次，
从命中率上讲，至少应该将其改为 if n <> Result - 1。
但是这样还不够，因为无论如何它都会判断 Result 次，这是不必要的。将循环拆
开，成两部分，即可避免这 Result 次判断。
还有，那个 if ReplaceStr <> '' 显然和你自己说的矛盾，这是每次都相同的结果
完全可以放在循环外面。（当然了，写那么长的代码，出点小差错是难免的）
修改后的代码段如下：
else
if Gap < 0 then
// 被替换的串长
begin
p := MatchPoses[0] - FndLen;
if ReplaceStr <> '' then
begin
// ReplaceStr <> ''
for n := 0 to Result - 2do
// 被拆开的循环的前面部分
begin
l := MatchPoses[n+1]-MatchPoses[n]-FndLen+1;
//　移动两个被替换串间的字符
Move(ReplaceStr[1], Tag[p], RplLen);
Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
// 替换
Inc(p, RplLen+l-1);
end;
n := Result - 1;
// 被拆开的循环的最后一步
if n >= 0 then
begin
l := Length(Tag) - MatchPoses[n]+1;
Move(ReplaceStr[1], Tag[p], RplLen);
Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
// 替换
Inc(p, RplLen+l-1);
end;
end else
begin
// ReplaceStr = ''
for n := 0 to Result - 2do
// 被拆开的循环的前面部分
begin
l := MatchPoses[n+1]-MatchPoses[n]-FndLen+1;
//　移动两个被替换串间的字符
Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
// 替换
Inc(p, RplLen+l-1);
end;
n := Result - 1;
// 被拆开的循环的最后一步
if n >= 0 then
begin
l := Length(Tag) - MatchPoses[n]+1;
Move(Tag[MatchPoses[n]], Tag[p+RplLen], l);
// 替换
Inc(p, RplLen+l-1);
end;
end;
SetLength(Tag, p);
// 调整字符串大小
end
可以看到，效率应该是提高了，不过清晰性的确不如改前了。如果您要使用，请自
行取舍。
首先声明，我前面的所有分析的前提都是 Result 非常大（替换次数非常多）的情况。
纯粹属于技术性研究，仔细推敲的过程，如果没有绝对的必要，根本不必考虑那么多。
在一般的情况下，Another_eYes 大虾的这段代码已经相当的棒了！
见笑了。
 
我考，我真是愚昧啊。刚回头看了看eyes原来的问题，最快的FastReplace都
早就出来过了。对了，eyes的那个版本后来发现什么问题没有？没有的话，
我可就准备用那个版本了，呵呵。
 
刚才贴的代码有点小问题[:(]，已经改正了[:)]
 
Buf[8]:= Tmp;
那个8怎么显示成一个图片了，是不是论坛的Bug？
 
[8]这个图片应该拿掉了
 
hehe, 就是 Buf［8］ := Tmp;
是那个 UBB 标签在作怪：）
 
to DreamTiger: 见笑了。 那段代码的确有点问题。 主要是因为当初对delphi的参数传递不是很清楚。 所以那段查找代码中接受参数的部分有问题。 后来也懒得改了。 呵呵， 劝您别用吧。
to Beta: 谢谢。 两个点子都不错。 不过第二个点子更实用些。 第一个点子没必要了。 对重量级循环中访问数组我一般用指针，不用下标的。
 
// 第一个点子没必要了
这我知道，我写出来的当时就说了：）
 
对了，把你那个控件发给我看看吧：）
xbeta#(160 + 3).net
 
To Another_eYes：帮忙看一下这个贴子，谢谢！
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1417440
 
to beta: 哪个控件？
 
to Another_eYes:
呵呵，有兴趣的话不如研究一下Qstring？速度大约快上十倍哦，就算是JCL里
的strreplace在大多数情况下也要快一些[:D]
另外Qstrings大部分是用汇编实现的，偶看起来头比较大的样子[:(]
 
to Another_eYes: 你的待答问题里面的那个“小范围控件测试并征求意见”啊，呵呵
邮箱您看明白了吧：）
 
to beta, 现在不发， 被我改得面目全非了（把子类里的几个属性和方法抽象到父类里了）， 这需要调试调试。
而且我有了一个新想法。现在的控件都继承自TControl，输入焦点是在它上面贴一个edit来实现的。
现在我打算修改这种做法， 贴一个rectregion (-2,-2,-1,-1) 的edit（就象现在我控件组里不需要输入光标只需要Onkeydown事件的控件的实现方法）， 然后所有的屏幕显示都自己实现（包括闪动的光标， 也许我会做一个羽毛笔型的cursor哦）， 这样还可以在文字输入时加入某些特效（嘿嘿， 比如刚打进去的字有光晕， 过一会(100-300ms)光晕消失）。
用后台edit的好处是文字的format它都帮我做了，我只要取当前edit中的位置然后相应地在我的控件中做出显示即可， 不然处理选中、删除、多行输入自动换行、滚屏等太麻烦了。
这主要看时间够不够。 因为目前我还有4-5个控件需要开发呢（另外要调试4个）。
 
您必须登录或注册才可回复。

Similar threads

I
Delphi 代码优化-字符串篇
回复
0
查看
760
import
I
I
如何用函数名字符串来调用函数？
回复
0
查看
647
import
I
I
一个检测本机网卡号（物理地址）的程序源码
回复
0
查看
595
import
I
3
生成大量的随机字符串，代码已贴出，但我觉得不够高效！(200)
回复
4
查看
660
32881
3
X
应部分网友要求，公开 myfunctions 单元，里面有很多有用的函数(0)
回复
10
查看
4K
yczjs
Y
顶部