Dynamische Arrays "verketten"

[Dennis07]

Hallo, ich bins mal wieder. :)
Ich will folgende ein typisiertes dynamisches array von Integer-Werten an ein anderes anhängen.
Allerdings ist meine Funktion rekursiv. ("TIntegerArray" ist deklariert als "array of Integer")

Delphi-Quellcode:

//Diese Funktion soll mir alle Positionen eines SubStrings in einem String zurückliefern.
//Bitte nicht fragen, wieso ich nicht Gebrauch vom "Offset"-Parameter der
//"Pos(...)"-Funktion mache, ich brauche Abwärtskompatibilität bis einschl. D7.

function MultiPos(const SubStr, Str: String; Offset: Integer = 1): TIntegerArray;
var
  Temp: PChar;
  Position: Integer;
  Further: TIntegerArray;
begin
  SetLength(Result,0);
  if (Offset < 1) or (Offset > (Length(Str) - Length(SubStr))) then
  begin
    Exit;
  end;
  Temp := @Str[OffSet];
  Position := Pos(SubStr,String(Temp));
  if Position <> 0 then
  begin
    SetLength(Result,1);
    Result[0] := Position + Offset - 1;
    Inc(Temp,Position + Length(SubStr) - 1);
    Further := MultiPos(SubStr,Str,Offset + Position + Length(SubStr) - 1);
    if Length(Further) <> 0 then
    begin
      SetLength(Result,1 + Length(Further));
      Move(Further[0],Result[1],SizeOf(Further){Length(Further) - 1});
    end;
  end;
end;

Wenn ich die Funktion jetzt teste, gibt der mir für die ersten beiden Positionen richtige Werte aus. Für alle anderen jedoch erhalte ich nur noch Nullen. Ich vermute, dass es an relativer Adressierung von arrays liegen könnte, die durch "System.Move(...)" die folgenden Kettenglieder unbrauchbar macht, bin mir aber nicht ganz sicher. Und noch weniger weiß ich, wie ich es beheben sollte.

[Bjoerk]

Was soll hier die Verketterei? :-D Delphi 7 hat auch schon eine PosEx (wenn ich mich recht erinnere). Ansonsten kann man sich schnell eine selbst schreiben bzw. hier im Forum.

Ungetestet:

Delphi-Quellcode:

procedure MultiPos(const SubStr, S: String;
  const Offset: Integer; var Positions: TIntegerArray);
var
  I, N: integer;
begin
  N := 0;
  SetLength(Positions, N);
  I := PosEx(SubStr, S, Offset);
  while I > 0 do
  begin
    Inc(N);
    SetLength(Positions, N);
    Positions[N - 1] := I;
    I := PosEx(SubStr, S, I + 1);
  end;
end;

[Dennis07]

Naja, darum geht es aber nicht. :)
Wenn du dir mal die Pos()-Funktion anschaust, wirst du sehen, dass diese in Maschinencode geschrieben ist und somit besonders bei längeren Texten (>50K Zeichen) auch um einiges schneller sein dürfte.
Außerdem will ich ja nicht das gesamte array nochmal durchlaufen, das wäre ja Zeit-und Ressourcenverschwendung. :D

Weiß jemand, wie man das mit Move (oder sonst wie, aber im selben Prinzip) hinbekommen könnte?

PS: Und außerdem sollen die Werte der Reihe nach sortiert sein (in-order), und ein nochmaliges Durchlaufen wäre vollkommen undenkbar. :)

[jaenicke]

Die Umwandlungen von PChar zu string, die Vergrößerung des Array usw. machen das ganze deutlich langsamer. So kannst du das kaum optimieren.
Schnell geht das nur, wenn du z.B. selbst mit Boyer Moore oder einem anderen Algorithmus suchst. Dann kannst du auch direkt auf den Pointern arbeiten. Wirklich einen Vorteil hat Boyer Moore aber nur bei längeren Texten.
Beispiele findest du viele, z.B.:
http://www.entwickler-ecke.de/viewto...=502137#502137
http://www.delphipraxis.net/175187-b...gorithmus.html
...

Und wenn man Assembler benutzt, gibt es auch noch Befehle wie repne scasb (bzw. repne scasw für Unicode), mit der man Strings schnell scannen kann.

[Dejan Vu]

Der Grundfehler ist der rekursive Aufruf. Hier hättest Du einfach eine Iteration durchführen können, da es sich um eine Tailrecursion handelt. Aber deine Frage war ja, wie man dynamische Arrays verketten kann bzw. wie man das Funktionsergebnis deiner Funktion an das Ergebnis des Aufrufers hängen kann.

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

Delphi 7 PosEx hat einen Bug, daher vielleicht doch o.g. Variante nehmen und zusammen mit Bjoerk's Routine hast Du dein ziemlich optimales Ergebnis.

[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:

Delphi-Quellcode:

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.

[BadenPower]

Um auf die eigentliche Frage zu antworten, habe ich Dir den Code berichtigt.

Delphi-Quellcode:

function MultiPos(const SubStr, Str: String; Offset: Integer = 1): TIntegerArray;
var
  Temp: PChar;
  Position: Integer;
  Further: TIntegerArray;
begin
  SetLength(Result,0);
  if (Offset < 1) or (Offset > (Length(Str) - Length(SubStr))) then
  begin
    Exit;
  end;
  Temp := @Str[OffSet];
  Position := Pos(SubStr,String(Temp));
  if Position <> 0 then
  begin
    SetLength(Result,1);
    Result[0] := Position + Offset - 1;
    Inc(Temp,Position + Length(SubStr) - 1);
    Further := MultiPos(SubStr,Str,Offset + Position + Length(SubStr) - 1);
    if Length(Further) <> 0 then
    begin
      SetLength(Result,1 + Length(Further));
      Move(Further[0],Result[1],Length(Further)*SizeOf(Further[0])); // hier änderen
    end;
  end;
end;

EDIT:
Funktioniert neuerdings die "rote Box" nicht mehr, wenn zwichendurch bereits Antworten gepostet wurden?

[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:

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

[Dejan Vu]

Die haben ja irgendwann die FastCode-Teile in die RTL übernommen, daran wird das liegen.