Hilfe: Schnellste möglichkeit ein 4-Byte Array zu Sortieren

[Horst_]

Hallo,

wie denn, wo denn, was denn?
0,5 Sekunden für 5e6 Aufrufe sind 100 ns / Aufruf ~ 320 Takte bei mir.
Was soll den mit 15 Sekunden nicht stimmen, zu langsam / zu schnell ?

Ladet doch die unit runter und schaut in den Quelltext.

Delphi-Quellcode:

procedure TLInit;
var
   i : longInt;
begin
  setlength(TL,FeldGroesse);
  randomize;
  TL[0].card := $04030201;
  TL[1].card := $03040201;
  TL[2].card := $04020301;
  TL[3].card := $02040301;
  TL[4].card := $03020401;
  TL[5].card := $02030401;

  TL[6].card := $04030102;
  TL[7].card := $03040102;
  TL[8].card := $04010302;
  TL[9].card := $01040302;
  TL[10].card := $03010402;
  TL[11].card := $01030402;

  TL[12].card := $04020103;
  TL[13].card := $02040103;
  TL[14].card := $04010203;
  TL[15].card := $01040203;
  TL[16].card := $02010403;
  TL[17].card := $01020403;

  TL[18].card := $03020104;
  TL[19].card := $02030104;
  TL[20].card := $03010204;
  TL[21].card := $01030204;
  TL[22].card := $02010304;
  TL[23].card := $01020304;

  For i := 24 to high(TL) do
    TL[i] := TL[random(24)];
end;

Die obere Ausgabe bezieht sich auf 1e9 (= 1e5*1e4) Aufrufe.
Also Runden = 100000 (1e5) mal wird ein High(TL)+1=10000 (1e4)elementiges Testfeld mit zufälligen Werten abgefragt.

Delphi-Quellcode:

  StartTimer;
  For j := 1 to RUNDEN do
  For i := High(TL) Downto 0 do
    begin
    TestWert.Card := TL[i].card;
    Test(TestWert);
    // Prüfen auf Fehler
    IF TestWert.card <> Res then
      begin
      EXIT;
      end;
    end;
  StoppTimer;

Die unter Ausgabe bezieht sich auf 1e8 DIV 24 Aufrufe.
Also Runden = 4'166'666 mal wird ein High(TL)+1=24 elementiges Testfeld mit allen Möglichkeiten abgefragt.

Rein zufällige Werte sind also eine Bremse.

Gruß Horst

[Bjoerk]

Hallo Horst,

ich bezog mich hier auf die in #15 von TE angegeben Rechenzeiten. Sind alle viel zu groß. Deshalb auch meine Frage bezüglich der aufrufenden procedure.

// Edit: Dort gings noch um 5 mill. Durchläufe..

[Horst_]

Hallo,

mit konstantem Wert getestet wie TE Dano un verglichen.
Die Laufzeitunterschiede sind ja gewaltig von der CPU abhängig.
Selbst wenn ich die Dummy-Zeiten draufaddiere, was ja so auch nicht ganz richtig ist, aber auch bei der Anzahl der Durchläufe wohl auch nicht bemerkbar ist, ergeben sich gewaltige Unterschiede, die über die Prozessortaktfrequenzunterschiede von 4% weit hinausgehen.
In Rot AMD x% schneller in schwarz AMD x% langsamer.



Gruß Horst

[himitsu]

Mit einem konstanten Wert bevorteilst und benachteilst du bestimmte Algortihmen, welche gerade bei diesem Wert ihre meisten Verleiche und Verschiebeaktionen hätten.
Die Resultate sind also absolut nicht aussafähig, denn schließlich hat du damit ja 95,8333% aller Möglichkeiten ignoriert.

Die Variante vorher ein Array mit Testwerten zu erstellen, hatte ich ja schonmal vorgeschlagen, das würde allen Algorithmen die selben Testwerte geben, ohne sie live zu berechnen.

[Bjoerk]

Horst, kannst du hier mal die asm routinen einbauen und testen? Wenn du mehr als 1 bis 2 Sekunden einsparst, wäre das m.E. schon ziemlich genial.

Delphi-Quellcode:

unit uArrayOfByteList;

interface

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

type
  TArrayOfByte = packed record
    case boolean of
      true: (A: array[0..3] of Byte);
      false: (Card: Cardinal);
  end;

  TArrayOfByteList = class(TList)
  private
    function GetItem(Index: integer): TArrayOfByte;
    procedure SetItem(Index: integer; const Value: TArrayOfByte);
  public
    procedure AddItem(const Value: TArrayOfByte);
    procedure DelItem(Index: integer);
    function Networksort(Index: integer): TArrayOfByte;
    function Selectionsort(Index: integer): TArrayOfByte;
    procedure SelectionsortASM(var A: TArrayOfByte);
    procedure SelectionsortASM2(var A: TArrayOfByte);
    procedure SelectionsortASM2Horst(var A: TArrayOfByte);
    procedure SelectionsortASM3Horst(var A: TArrayOfByte);
    property Item[Index: integer]: TArrayOfByte read GetItem write SetItem; default;
    destructor Destroy; override;
  end;

  TWaitTime = class
  private
    FStartTime: TDateTime;
    FWaitTime: int64;
  public
    procedure Start;
    procedure Stop;
    property WaitTime: int64 read FWaitTime;
  end;

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
  end;

var
  Form1: TForm1;
  ArrayOfByteList: TArrayOfByteList;
  WaitTime: TWaitTime;

implementation

{$R *.dfm}

{ TArrayOfByteList }

function TArrayOfByteList.GetItem(Index: integer): TArrayOfByte;
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  Result:= P^;
end;

procedure TArrayOfByteList.SetItem(Index: integer; const Value: TArrayOfByte);
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  P^:= Value;
end;

procedure TArrayOfByteList.AddItem(const Value: TArrayOfByte);
var
  P: ^TArrayOfByte;
begin
  New(P);
  P^:= Value;
  Add(P);
end;

procedure TArrayOfByteList.DelItem(Index: integer);
var
  P: ^TArrayOfByte;
begin
  P:= Items[Index];
  Dispose(P);
  Delete(Index);
end;

destructor TArrayOfByteList.Destroy;
begin
  while Count > 0 do DelItem(Count-1);
  inherited Destroy;
end;

function TArrayOfByteList.Selectionsort(Index: integer): TArrayOfByte;
  procedure Exchange(const I, J: integer);
  var
    T: byte;
  begin
    T:= Result.A[I];
    Result.A[I]:= Result.A[J];
    Result.A[J]:= T;
  end;
begin
  Result:= Item[Index];
  if Result.A[0] < Result.A[1] then Exchange(0, 1);
  if Result.A[0] < Result.A[2] then Exchange(0, 2);
  if Result.A[0] < Result.A[3] then Exchange(0, 3);
  if Result.A[1] < Result.A[2] then Exchange(1, 2);
  if Result.A[1] < Result.A[3] then Exchange(1, 3);
  if Result.A[2] < Result.A[3] then Exchange(2, 3);
end;

function TArrayOfByteList.Networksort(Index: integer): TArrayOfByte;
  procedure Exchange(const I, J: integer);
  var
    T: byte;
  begin
    T:= Result.A[I];
    Result.A[I]:= Result.A[J];
    Result.A[J]:= T;
  end;
begin
  Result:= Item[Index];
  if Result.A[0] < Result.A[1] then Exchange(0, 1);
  if Result.A[2] < Result.A[3] then Exchange(2, 3);
  if Result.A[0] < Result.A[2] then Exchange(0, 2);
  if Result.A[1] < Result.A[3] then Exchange(1, 3);
  if Result.A[1] < Result.A[2] then Exchange(1, 2);
end;

procedure TArrayOfByteList.SelectionsortASM(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM2(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM2Horst(var A: TArrayOfByte); assembler;
asm
  //
end;

procedure TArrayOfByteList.SelectionsortASM3Horst(var A: TArrayOfByte); assembler;
asm
  //
end;

{ TWaitTime }

procedure TWaitTime.Start;
begin
  FStartTime:= Now;
end;

procedure TWaitTime.Stop;
var
  Hour, Min, Sec, MSec: Word;
begin
  DecodeTime(Now - FStartTime, Hour, Min, Sec, MSec);
  FWaitTime:= MSec + Sec * 1000 + Min * 60000 + Hour * 3600000;
end;

{ TForm1 }

procedure TForm1.Button1Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
    A:= ArrayOfByteList.Selectionsort(I);
  WaitTime.Stop;
  ShowMessage('Selectionsort: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
    A:= ArrayOfByteList.Networksort(I);
  WaitTime.Stop;
  ShowMessage('Networksort: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM2(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM2: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM2Horst(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM2Horst: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  I: integer;
  A: TArrayOfByte;
begin
  WaitTime.Start;
  for I:= 0 to ArrayOfByteList.Count-1 do
  begin
    A:= ArrayOfByteList[I];
    ArrayOfByteList.SelectionsortASM3Horst(A);
  end;
  WaitTime.Stop;
  ShowMessage('SelectionsortASM3Horst: '+IntToStr(WaitTime.WaitTime)+' ms');
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I, J: integer;
  A: TArrayOfByte;
begin
  Randomize;
  WaitTime:= TWaitTime.Create;
  ArrayOfByteList:= TArrayOfByteList.Create;
  for I:= 1 to MaxInt div 32 do
  begin
    for J:= 0 to 3 do
      A.A[J]:= Random(256);
    ArrayOfByteList.AddItem(A);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ArrayOfByteList.Free;
  WaitTime.Free;
end;

end.

[Dano]

procedure SelectionsortASMDown(var A: Cardinal); register; vieleicht kannst du die proceduren mal mit "register" angeben, weil dann der compiler vor dem aufruf der procedur ein LEA (Load Effective Adress) nach EAX macht... und dann sollten die geposteten ASM-Proceduren eigentlich funktionieren

Delphi-Quellcode:

procedure TArrayOfByteList.SelectionsortASM(var A: TArrayOfByte); register;
label Weiter1,Weiter2,Weiter3,Weiter4,Weiter5,Weiter6;
asm
  // In einer asm-Anweisung muss der Inhalt der Register
  // EDI, ESI, ESP, EBP und EBX erhalten bleiben, während die Register
  // EAX, ECX und EDX beliebig geändert werden können.
  mov ECX,[EAX]; // A in ECX
  mov DL,CL;
  rol ECX,8;
  // init fertig
  // if A[0] > A[1] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  cmp DL,CL;
  jnb Weiter1;
  xchg DL,CL;
Weiter1:
  // if A[0] > A[2] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  rol ECX,8
  cmp DL,CL;
  jnb Weiter2;
  xchg DL,CL;
Weiter2:
  // if A[0] > A[3] then begin T:= A[0]; A[0]:= A[1]; A[1]:= T; end;
  rol ECX,8;
  cmp DL,CL;
  jnb Weiter3;
  xchg DL,CL;
Weiter3:
  // if A[1] > A[3] then begin T:= A[1]; A[1]:= A[2]; A[2]:= T; end;
  rol EDX,8;
  mov DL,CL;
  ror ECX,8;
  cmp DL,CL;
  jnb Weiter4;
  xchg DL,CL;
Weiter4:
  // if A[1] > A[2] then begin T:= A[1]; A[1]:= A[3]; A[3]:= T; end;
  ror ECX,8;
  cmp DL,CL;
  jnb Weiter5;
  xchg DL,CL;
Weiter5:
  // if A[2] > A[3] then begin T:= A[2]; A[2]:= A[3]; A[3]:= T; end;
  rol EDX,8;
  mov DL,CL;
  rol ECX,8;
  cmp DL,CL;
  jnb Weiter6;
  xchg DL,CL;
Weiter6:
  rol EDX,8;
  mov DL,CL;
  mov [EAX],EDX;
end;

hab es selber noch nicht getestet
aber wäre mir jetzt so aufgefallen... nicht das er die var über den stack übergibt

mov ECX,[EAX]; // A in ECX
sagt das er die varieable die an der speicherstelle steht auf die eax zeigt nach ECX kopieren soll... darum [eax]... ist immer eine dereferenzierung so wie bei zeigern/pointern

mfg Dano

[Dano]

@horst

hab deine angehängte zip mal zum laufen gebracht

Code:

MaxRound 100000000

Tests mit Dummy
 Anzahl: 100000000 Ticks: 704506120 ms: 210,968.3
Tests mit Selectionsort3Down
 Anzahl: 100000000 Ticks: 8187710850 ms: 2451,738.3
Tests mit NetworkSort2
 Anzahl: 100000000 Ticks: 7469487830 ms: 2236,678.3
Tests mit SelectionsortASMDown
 Anzahl: 100000000 Ticks: 6598611390 ms: 1975,898.3
Tests mit SelectionsortASMDown2
 Anzahl: 100000000 Ticks: 6523360900 ms: 1953,368.3
Tests mit SelectionsortASMDown2Horst
 Anzahl: 100000000 Ticks: 6242008250 ms: 1869,118.3
Tests mit SelectionsortASMDown3Horst
 Anzahl: 100000000 Ticks: 4513095900 ms: 1351,408.3

ich frag mich jetzt warum deine foo wieder so viel schneller ist^^