Dynamische Arrays "verketten"

[Dennis07]

Okay. Vielen Dank, schaue ich mir heute Abend mal an.
Also nur um es jetzt zu verstehen, war meine Annahme oben richtig oder was war der genaue Grund, weshalb das nicht funktioniert hat?

[jaenicke]

Further ist ein dynamisches Array, also ist die Variable Further ein Pointer auf dieses dynamische Array. Dementsprechend ist SizeOf(Further) immer 4 bzw. bei 64-Bit 8. Du bewegst also gar nicht das ganze Array. Das hätte dir im Debugger eigentlich auffallen müssen, wenn du das Move dort einzeln ausführst.

Was du möchtest ist aber das ganze Array kopieren und das ist in Byte die Länge des Arrays mal der Größe eines Elements:
SizeOf(Further[0]) * Length(Further)

[Dennis07]

Ah.. Danke! Naja, zwischen dem was man "hätte wissen können" und dem, worauf man dann am Ende kommt, sind manchmal Welten. Ich hatte den Fehler ganz woanders vermutet und deshalb gar nicht gedacht, dass es daran liegen könnte.

[Dennis07]

-GEÄNDERT-

Okay, habe deine Post nicht gesehen. Funktioniert bei mir doch, hatte nur noch irgendwo nen fehler gehabt.
Danke euch allen, werde mich mal in die fastpos-lib einlesen.

MfG

[BadenPower]

Zitat von Dennis07:

Okay, hab es mal ausprobiert, nur probehalber. Funktioniert aber nicht. Er spuckt mir zwar keine nullen mehr aus, aber dafür einen haufen anderer Zahlen.

Probier einmal das kleine Testprogramm, welches ich angehängt habe.

Im 1. Memo kannst Du den Text eingeben.
Der Text im Editfeld ist der Suchtext.

In Memo2 stehen die gefundenen Positionen.
In Memo3 siehst Du die Aufrufe Deiner Funktion.

[Bjoerk]

Bei #9 kann das Inc(Temp) raus. Und die Exit Bedingung stimmt nicht ganz ("Test" kann ja in "Test" bei Offset 1 enthalten sein). BTW, Dennis, wer hat dir eigentlich gesagt, daß das schnell sein soll? Gerade bei langen Strings ist das sehr viel langsamer. Meine verwendete PosEx ist in etwa die von D7.

Beispiel:

Delphi-Quellcode:

unit MultiPosTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Types;

type
  TStrPositions = class
  private
    FItems: TList;
    function GetCount: integer;
    function GetItems(Index: integer): integer;
    function PosEx(const SubStr, S: string; const Index: integer): integer;
  public
    procedure Pos(const SubStr, S: string; Offset: integer);
    property Count: integer read GetCount;
    property Items[Index: integer]: integer read GetItems; default;
    constructor Create;
    destructor Destroy; override;
  end;

  TMultiPosTestForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  end;

var
  MultiPosTestForm: TMultiPosTestForm;

implementation

{$R *.dfm}

{ TStrPositions }

constructor TStrPositions.Create;
begin
  FItems := TList.Create;
end;

destructor TStrPositions.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TStrPositions.GetCount: integer;
begin
  Result := FItems.Count;
end;

function TStrPositions.GetItems(Index: integer): integer;
begin
  Result := Integer(FItems[Index]);
end;

function TStrPositions.PosEx(const SubStr, S: string; const Index: integer): integer;
var
  I, J, A, B: integer;
begin
  Result := 0;
  A := Length(S);
  B := Length(SubStr);
  I := Index;
  if (A > 0) and (B > 0) and (I > 0) then
    while (Result = 0) and (I <= A - B + 1) do
    begin
      if S[I] = SubStr[1] then
      begin
        J := 1;
        while (J < B) and (S[I + J] = SubStr[J + 1]) do
          Inc(J);
        if J = B then
          Result := I;
      end;
      Inc(I);
    end;
end;

procedure TStrPositions.Pos(const SubStr, S: string; Offset: integer);
var
  I: integer;
begin
  FItems.Clear;
  I := PosEx(SubStr, S, Offset);
  while I > 0 do
  begin
    FItems.Add(Pointer(I));
    I := PosEx(SubStr, S, I + Length(SubStr));
  end;
end;

{ TMultiPosTestForm }

function RandomString(const StringLength: integer): string;
const
  CharSet: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  I, Index: integer;
begin
  SetLength(Result, StringLength);
  for I := 1 to StringLength do
  begin
    Index := Random(Length(CharSet)) + 1;
    Result[I] := CharSet[Index];
  end;
end;

function MultiPos(const SubStr, S: String; Offset: Integer = 1): TIntegerDynArray;
var
  Temp: PChar;
  Position: Integer;
  Further: TIntegerDynArray;
begin
  SetLength(Result, 0);
  if (Offset > 0) and (Offset <= (Length(S) - Length(SubStr) + 1)) then
  begin
    Temp := @S[OffSet];
    Position := Pos(SubStr, String(Temp));
    if Position <> 0 then
    begin
      SetLength(Result, 1);
      Result[0] := Position + Offset - 1;
      Further := MultiPos(SubStr, S, Offset + Position + Length(SubStr) - 1);
      if Length(Further) <> 0 then
      begin
        SetLength(Result, 1 + Length(Further));
        Move(Further[0], Result[1], Length(Further) * SizeOf(Integer));
        FillChar(Further[0], SizeOf(Integer), 0);
      end;
    end;
  end;
end;

procedure TMultiPosTestForm.FormCreate(Sender: TObject);
begin
  ReportMemoryLeaksOnShutDown := true;
  Randomize;
end;

procedure TMultiPosTestForm.Button1Click(Sender: TObject);
var
  T1, T2, T1All, T2All: Cardinal;
  I, N, FindPosCount: integer;
  SubStr, S: string;
  Indices: TIntegerDynArray;
  StrPositions: TStrPositions;
begin
  StrPositions := TStrPositions.Create;
  try
    FindPosCount := 3;
    T1All := 0;
    T2All := 0;
    for N := 1 to 100 do
    begin
      repeat
        SubStr := RandomString(2);
        S := RandomString(100000);

        T1 := GetTickCount;
        Indices := MultiPos(SubStr, S, 1);
        T1All := T1All + GetTickCount - T1;

        T2 := GetTickCount;
        StrPositions.Pos(SubStr, S, 1);
        T2All := T2All + GetTickCount - T2;

        if Length(Indices) <> StrPositions.Count then
          ShowMessage('Error');

        for I := 0 to Length(Indices) - 1 do
          if Indices[I] <> StrPositions[I] then
            ShowMessage('Error');

      until StrPositions.Count >= FindPosCount;
    end;
    Caption := Format('MultiPos %d ms, StrPositions %d ms', [T1All, T2All]);
  finally
    StrPositions.Free;
  end;
end;

end.

[Bjoerk]

Den Boyer-Moore kannte ich nicht. Deshalb hab ich mich mal etwas eingearbeitet und den Algo von da überarbeitet, erweitert und getestet. Tut. In machen Fällen ist er so 2..5 mal schneller. Es gibt einen Parameter IgnoreCase. Ob der dabei in der LowCase angenommene Unterschied von 32 in der Codepage auch für UTF-8 bzw. 16 noch stimmt weiß ich nicht. Ggf. anpassen. Wäre schön wenn sich jemand findet der nach asm übersetzt (vermutlich dann wohl procedural), dann könnte man mal mit der PosEx_JOH_IA32_8_b aus der FastPosEx vergleichen?

Delphi-Quellcode:

  TBoyerMoore = class
  private
    class function LowCase(const C: char): char;
    class function SameChar(const A, B: char; const IgnoreCase: boolean): boolean;
  public
    class function PosEx(const SubStr, S: string;
      const Index: integer = 1; const IgnoreCase: boolean = false): integer;
  end;

..

{ TBoyerMoore }

class function TBoyerMoore.LowCase(const C: char): char;
const
  CharSet: TSysCharSet = ['A'..'Z', 'Ä', 'Ö', 'Ü'];
begin
  if C in CharSet then // if CharInSet(C, CharSet) then
    Result := Char(Ord(C) + 32) // 32 ??? bei UTF-8, UTF-16
  else
    Result := C;
end;

class function TBoyerMoore.SameChar(const A, B: char; const IgnoreCase: boolean): boolean;
begin
  if IgnoreCase then
    Result := LowCase(A) = LowCase(B)
  else
    Result := A = B;
end;

class function TBoyerMoore.PosEx(const SubStr, S: string;
  const Index: integer; const IgnoreCase: boolean): integer;
var
  I, J, K, N, M: integer;
  C: char;
  Skip: array[Char] of integer;
begin
  Result := 0;
  N := Length(S);
  M := Length(SubStr);
  if (Index > 0) and (N > 0) and (M > 0) and (Index <= N - M + 1) then
  begin
    for C := Low(Char) to High(Char) do
      Skip[C] := M;
    if not IgnoreCase then
      for K := 1 to M - 1 do
        Skip[SubStr[K]] := M - K
    else
      for K := 1 to M - 1 do
        Skip[LowCase(SubStr[K])] := M - K;
    K := M + Index - 1;
    while (Result = 0) and (K <= N) do
    begin
      I := K;
      J := M;
      while (J > 0) and SameChar(S[I], SubStr[J], IgnoreCase) do
      begin
        Dec(J);
        Dec(I);
      end;
      if J = 0 then
        Result := I + 1
      else
        if not IgnoreCase then
          K := K + Skip[S[K]]
        else
          K := K + Skip[LowCase(S[K])];
    end;
  end;
end;