Dynamische Arrays "verketten"

[BadenPower]

Zitat:

Zitat von Dennis07 (Beitrag 1288794)

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;

[jaenicke]

Zitat:

Zitat von Bjoerk (Beitrag 1288998)

Wäre schön wenn sich jemand findet der nach asm übersetzt

Das habe ich früher öfter mal gemacht, zuerst nur für 32-Bit, dann auch für 64-Bit und nun auch noch für ARM, und solange man eine reine Pascal Umsetzung dazu packt (sprich 4 Implementierungen macht...), ist das auch kein Problem. Aber angesichts immer mehr Plattformen optimiere ich lieber nur noch die Pascal Implementierungen, wenn es nicht wirklich eine konkrete Notwendigkeit zur extremen Optimierung gibt.

[Bjoerk]

No problem Sebastian. Könntest du eventuell mal bitte in deinem XE7 einen Durchlauf mit Umlauten und IngnoreCase machen?

[Sherlock]

Bin ich eigentlich zu einfach gestrickt? Fragestellung: Wie hänge ich ein Integer Array an ein anderes?
Lösung: auf keinen Fall diese seitenlangen Stringkopierorgien.
Sherlocks dumme KISS-Lösung:

Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  IntArr1: TIntegerArray;
  IntArr2: TIntegerArray;
  i:Integer;
  Output: string;
begin
  SetLength(IntArr1, 5);
  IntArr1 := [1,2,3,4,5];
  SetLength(IntArr2, 3);
  IntArr2 := [6,7,8];
  AppendIntArray(IntArr1, IntArr2);

  Output := '';
  for i := 0 to Length(IntArr1)-1 do
    Output := Output + IntToStr(intarr1[i]);
  ShowMessage(output);
end;

procedure TForm1.AppendIntArray(var IntArr1: TIntegerArray; IntArr2: TIntegerArray);
var
  i: Integer;
  origLen: Integer;
begin
  origLen := Length(IntArr1);
  SetLength(IntArr1, Length(IntArr1) + Length(IntArr2));
  for i := 0 to Length(IntArr2) - 1 do
  begin
    IntArr1[origLen + i] := IntArr2[i];
  end;
end;

[BadenPower]

Zitat:

Zitat von Sherlock (Beitrag 1289015)

Bin ich eigentlich zu einfach gestrickt? Fragestellung: Wie hänge ich ein Integer Array an ein anderes?
Lösung: auf keinen Fall diese seitenlangen Stringkopierorgien.

Diese Stringkopierorgien haben ja nicht mit der Frage zu tun, sondern wie man die Funktion verändern könnte, in der die Notwendigkeit der Array-Verkettung vorgekommen ist.

Zitat:

Zitat von Sherlock (Beitrag 1289015)

Delphi-Quellcode:

procedure TForm1.AppendIntArray(var IntArr1: TIntegerArray; IntArr2: TIntegerArray);
var
  i: Integer;
  origLen: Integer;
begin
  origLen := Length(IntArr1);
  SetLength(IntArr1, Length(IntArr1) + Length(IntArr2));
  for i := 0 to Length(IntArr2) - 1 do
  begin
    IntArr1[origLen + i] := IntArr2[i];
  end;
end;

Nimm die Schleife heraus und mache es mit "Move" so wie in #9 bereits schon beschrieben.

[Dejan Vu]

Bjoerk: Vergleich deine Lösung doch mal spaßeshalber mit der von mir verlinkten Lösung

http://www.delphipraxis.net/105562-f...entierung.html

Probier mal, welche schneller ist.

[Sherlock]

@BadenPower: Ganz ehrlich? Das war mir viel zu kompliziert, und wenn da mit Charactern hantiert wird, wo es um Integer geht, verliere ich ohnehin den Faden. Move ist ausserdem inhärent unsicher (einfach mal Embarcaderos nächste Typredefinition abwarten, und schon knallt das Ding). Wieso ist also die Schleife schlecht? 5 ms langsamer bei 400000 Array-Elementen? Wir wissen doch gar nicht wie groß die in Frage kommenden Arrays sind. Andererseits hat der TE jetzt richtig viel gelernt.

Sherlock

[Bjoerk]

Zitat:

Zitat von Dejan Vu (Beitrag 1289023)

Bjoerk: Vergleich deine Lösung doch mal spaßeshalber mit der von mir verlinkten Lösung

http://www.delphipraxis.net/105562-f...entierung.html

Probier mal, welche schneller ist.

Hi Bud. Hab ich schon. Dort ist übrigens die CharVariante falsch. Meine wird mit zunehmender Länge des Substrings schneller. Und, die FastPos ist langsamer als z.B. die asm PosEx von D2007. Testet du mal wegen der Umlaute?

Edit: Vergiß es. Seehe gerade du hast D7. Bräuchte jemend mit >= 2009