文字列の加算

今朝ふらふらーと海外の Delphi Tips のページを回りました。
最近自分の Tips ページがレベル低いかなと思ったりする時もありますが、こうやって他人のページを見てるとなかなかの物に感じるから不思議です(爆)
まあ、そんなことはどうでも良いのですが文字列の反転の Tips を数ヶ所で見かけたのでちょっと気になりました。
リストの反転とかならともかく文字列をひっくり返して何が楽しいのでしょうか？

function ReverseString(const S: string): string;
var
  I: Integer;
begin
  Result := '';
  
  for I := Length(S) downto 1 do
    Result := Result + S[I];
end;

まあ、こんな感じで書くのが naive な実装でしょうか。
downto を知らなければ S[I] を S[Length(S) - I] にして 0 .. Length(S) - 1 にして回すんだろうけどまあ大差はないですね。

でもこの実装って遅いですよね。
つーわけで私ならどう書くかとなるとこうなります。

function ReverseString(const S: string): string;
var
  I, L: Integer;
begin
  SetLength(Result, Length(S));
  L := Length(S);
  
  for I := 0 to L - 1 do
    Result[L - I] := S[I + 1];
end;

って言っても文字列が長くなけりゃ差が出ないからどうでも良いんですけどね。
長い文字列の操作の高速化をやってからソースをこんな感じで書く癖がついてしまったのです。

こんな感じで結果を次々と文字列の後ろに追加していくって事は結構ありますが、普通に足し算をすると遅いんですよね。
なんで遅いかと言いますと、文字列の足し算が以下のように行われてるからだと思われます。

//s1 := s1 + s2;  (string concatenation)
p = s1;
s1 = (char *)malloc(strlen(s1) + strlen(s2) + 1);
strcpy(s1, p);
strcat(s1, s2);
free(p)

足し算のたびにメモリ確保、文字列の中身のコピー、いらなくなったメモリを開放というようなことが行われます。
実際には参照カウントの操作も含まれているはずですけど余り気にしないことにします。
しかしこうやって書いてみるとやっぱりC言語ってやーねと思ったりしますね(苦笑)
まあ、C++ の string を使えばいいのですが。

まあ話が逸れましたが例えば長さ 16MB の文字列に1文字足したとすると 16MB + 1byte のメモリ確保と 16MB + 1byte のメモリのコピーと 16MB のメモリの開放が起こります。
こんなのを頻繁にやられた日には激遅になるのは当たり前です。
簡単な解決法は必要なメモリを前もって一回で確保する、それが出来ないのなら適当に余分に確保するということです。
C++ の STL の vector も 4要素くらいは余分に確保していて、要素の追加のたびに上の3操作が起きるような事がないようになっているという話を友人から聞いたことがあります。

まあ、そんなこんなで Delphi 組み込みのこの手の用途の class は無いかなと探したのですが・・・見つかりませんでした。
無ければ作るか・・・・というわけで私は自前のを作って使ってたりします。
文字列反転みたいにごく簡単なものならさすがに使いませんが、普段バッファリングが必要な場合にはそれを使います。
今回は例として利用してみましょう。

function ReverseString(const S: string): string;
var
  I: Integer;
  Writer: TStringWriter;
begin
  Writer := TStringWriter.Create(Length(S));

  for I := Length(S) downto 1 do
    Writer.Write(S[I]);

  Result := Writer.Buffer;
  Writer.Free;
end;

実際どのくらいの速さの差があるかを計測してみます。
10byte, 512KB の文字列を反転してそれにかかった時間を timeGetTime で計測します。
10byte の方は 10万回、512KB の方は 10回ループを回しています。

10byte の時は fast と naive の差は22.3倍ですが、512KB の方は52.3倍と大きくなっています。
ただでさえ 512KB ともなるとそれなりの時間がかかるのでその差の変化はなおさら大きく感じます。

長い文字列を反転することはあまりないでしょうが、その他のプログラムでは話が違います。
長い文字列を扱うときに少し頭に入れておくと良いかもしれません。

最後に TStringWriter のソース。

type
  TStringWriter = class(TObject)
  private
    FBuffer: string;
    FPosition: Integer;
    procedure Extend(I: Integer);
    function GetBuffer: string;
  public
    constructor Create(I: Integer); overload;
    constructor Create; overload;
    procedure Reset(I: Integer);
    procedure SaveToFile(FileName: TFileName);
    procedure SaveToStream(Stream: TStream);
    procedure Unwrite;
    procedure Write(Ch : Char); overload;
    procedure Write(const S: string); overload;
    procedure WriteLn; overload;
    procedure WriteLn(const S: string); overload;
    property Buffer: string read GetBuffer;
  end;

implementation

{ TStringWriter }

constructor TStringWriter.Create(I: Integer);
begin
  inherited Create();
  Reset(I);
end;

constructor TStringWriter.Create;
begin
  Create(4000);
end;

procedure TStringWriter.Extend(I: Integer);
begin
  if I < 4096 then I := 4096
  else I := I + I shr 1;
  SetLength(FBuffer, I);
end;

function TStringWriter.GetBuffer: string;
begin
  if FPosition = Length(FBuffer) then Result := FBuffer
  else SetString(Result, PChar(@FBuffer[1]), FPosition);
end;

procedure TStringWriter.Reset(I: Integer);
begin
  SetLength(FBuffer, I);
  FPosition := 0;
end;

procedure TStringWriter.SaveToFile(FileName: TFileName);
var
  Stream: TStream;
begin
  Stream := TFileStream.Create(FileName, fmCreate);
  try
    SaveToStream(Stream);
  finally
    Stream.Free;
  end;
end;

procedure TStringWriter.SaveToStream(Stream: TStream);
begin
  Stream.WriteBuffer(Pointer(FBuffer)^, FPosition);
end;

procedure TStringWriter.Unwrite;
begin
  if FPosition > 0 then Dec(FPosition);
end;

procedure TStringWriter.Write(const S: string);
var
  I: Integer;
begin
  I := FPosition + Length(S);
  if I > Length(FBuffer) then Extend(I);

  for I := 1 to Length(S) do
  begin
    PChar(FBuffer)[FPosition] := S[I];
    Inc(FPosition, 1);
  end;
end;

procedure TStringWriter.Write(Ch: Char);
var
  I: Integer;
begin
  I := FPosition + 1;
  if I > Length(FBuffer) then Extend(I);

  PChar(FBuffer)[FPosition] := Ch;
  Inc(FPosition);
end;

procedure TStringWriter.WriteLn;
begin
  Write(#13);
  Write(#10);
end;

procedure TStringWriter.WriteLn(const S: string);
begin
  Write(S);
  Write(#13);
  Write(#10);
end;

end.

Return index page