Hallo Furtbichler,
mich hat das auch interessiert und ich habe das mit binärer Suche versucht – war aber, die Performance betreffend, ein Flop.
Also hab ich mir mal deine Lösung angeschaut.
Sehr interessanter Ansatz, leider aber fehlerhaft.
for I := 0 to High(data) - 1 do begin
Das " – 1 " gehört da m.E. nicht hin. Es verursacht, dass das letzte Element von data nicht in Intersect übernommen wrid.
Ich nehme an da stand ursprünglich Length(data) – 1
while (j < n) and (Intersect[j] < data[i]) do inc(j);
Wenn das letzte Element in data größer ist als das letzte Element in Intersect dann wird j=n=Length(Intersect) und bei
if data[i] = Intersect[j] then begin
wird auf Intersect[Length(Intersect)] zugegriffen, was einen Laufzeitfehler verursachen müßte.
Du schriebst 140 ms bei 12 Files je 5 Mio Werten, wobei die Files bereits im
RAM liegen und alle Files die gleichen Daten enthalten.
Ich hab mal deine Prozedur auf meinem Rechner laufen lassen.
Das "Alle Files identisch und bereits im
RAM" habe ich so realisiert, dass das Array "data", das bei dir lokal definiert ist, als Parameter mitgegeben wird.
Bei mir dauert das ganze bei unten stehendem Ablauf 300 ms.
Hab ich da vielleicht irgendwas falsch verstanden? Oder hab ich nur 'nen lahmen Rechner? Auf was für einer Maschine erreichst du 140 ms?
Delphi-Quellcode:
procedure IntersectFileWithHashmap(var Intersect,Data:TSampleArray);
var
newIntersect{, data}: TSampleArray;
n, i, j, k: Integer;
begin
n := Length(Intersect);
if n = 0 then exit;
//ReadSamples(aFilename, data);
j := 0;
k := 0;
SetLength(newIntersect, n);
for I := 0 to High(data) {- 1} do begin
while (j < n) and (Intersect[j] < data[i]) do inc(j);
if data[i] = Intersect[j] then begin
newIntersect[k] := data[i];
inc(k);
end;
end;
setLength(newIntersect, k);
Intersect := newIntersect;
end;
procedure TMain.Button1Click(Sender: TObject);
const count=5000000;
var intersect,data:TSampleArray; i:integer; t:cardinal;
begin
SetLength(data,count);
for i:=0 to High(data) do data[i]:=i+1;
intersect:=Copy(data);
t:=GetTickCount;
for i:=1 to 11 do IntersectFileWithHashmap(intersect,data);
t:=GetTickCount-t;
ShowMessage('Anzahl='+IntToStr(Length(intersect))+#13+
'Zeit='+IntToStr(t)+' ms');
end;
Du wolltest gern bessere Lösungen sehen.
Ich habe da einfach mal deine Prozedur genommen und an ein paar Stellen etwas entfernt.
Du erstellst ein Array newIntersect, schreibst die gefundenen Werte hinein und stellst am Schluss newIntersect in Intersect.
Das ist überflüssig.
Anstatt kann man die gefundenen Werte direkt in das Array Intersect stellen.
Mit diesen Änderungen braucht das Ganze (auf meinem Rechner) nur noch 250 ms, also eine Verbesserung um ca 15 %.
Auf deinem Rechner müsste das dann 140*250/300 = 117 ms brauchen.
Delphi-Quellcode:
procedure xIntersectFileWithHashmap(var Intersect,Data: TSampleArray);
var n, i, j, k: Integer;
begin
n := Length(Intersect);
if n = 0 then exit;
j := 0;
k := 0;
for I := 0 to High(data) do begin
while (j < n) and (Intersect[j] < data[i]) do inc(j);
if (j < n ) and (data[i] = Intersect[j]) then begin
Intersect[k] := data[i];
inc(k);
end;
end;
setLength(Intersect, k);
end;
procedure TMain.Button2Click(Sender: TObject);
const count=5000000;
var intersect,data:TSampleArray; i:integer; t:cardinal;
begin
SetLength(data,count);
for i:=0 to High(data) do data[i]:=i+1;
intersect:=Copy(data);
t:=GetTickCount;
for i:=1 to 11 do xIntersectFileWithHashmap(intersect,data);
t:=GetTickCount-t;
ShowMessage('Anzahl='+IntToStr(Length(intersect))+#13+
'Zeit='+IntToStr(t)+' ms');
end;
Aber damit war ich auch nicht zufrieden, denn ich wollte ja auch auf meiner lahmen Krücke deine 140 ms toppen.
Die unten stehende Version braucht bei identischen Daten (auf meinem Rechner) nur noch 110 ms, was, auf deinen Rechner umgerechnet 140*110/300 = 51 ms heißen sollte.
Verglichen mit den 300 ms, die deine Prozedur auf meinem Rechner brauchte, ist das eine Verbesserung um ca. 65 %.
Jedoch möchte ich mich nicht mit fremden (deinen) Federn schmücken.
Auch meine
Asm-Version baut im Prinzip auf deiner Lösung auf - und die ist einfach nur gut, auch wenn da ein paar Flüchtigkeitsfehler drin waren.
Jetzt hoffe ich nur, daß ich bei meiner
Asm-Version nichts übersehen habe......
Delphi-Quellcode:
FUNCTION IntersectData(
var Intersect,Data:TSampleArray; length:integer):integer;
asm
// IN : EAX=@Intersect, EDX=@Data, ECX=Anzahl der Elemente der bisherigen Schnittmenge
// Out : Neue Anzahl der Elemente der Schnittmenge
pushad
// Temp:=ESP; Push EAX,ECX,EDX,EBX,Temp,EBP,ESI,EDI
mov ebp,ecx
// n := Length(intersect)
test ebp,ebp
je @ReturnZero
// Schnittmenge ist leer
mov esi,[edx]
// @data[0]
test esi,esi
je @ReturnZero
// Data ist leer
mov edi,[eax]
// @Intersect[0]
test edi,edi
// nur zur Sicherheit
je @ReturnZero
// Intersect leer
xor ecx,ecx
// j := 0
xor edx,edx
// k := 0;
xor ebx,ebx
// for i := 0
jmp @CheckFor
@WhileLoop: add ecx,1
// inc(j)
cmp ecx,ebp
// While (j < n)
jae @SetRes
@ForLoop: cmp [edi+ecx*4],eax
// and Intersect[j] < data[i]
jb @WhileLoop
// do
jne @NextFor
mov [edi+edx*4],eax
// Intersect[k] := data[i];
@NoStore: add edx,1
// inc(k);
@NextFor: add ebx,1
// next i
@CheckFor: cmp ebx,[esi-4]
// i > High(data)
jae @SetRes
// ja, fertig
mov eax,[esi+ebx*4]
// data[i]
jmp @ForLoop
// Prüfung j<n nicht erforderlich
@ReturnZero:
xor edx,edx
// k := 0
@SetRes: mov [esp+28],edx
// popad stellt [esp-28] in EAX
popad
end;
procedure TMain.Button3Click(Sender: TObject);
const count=5000000;
var intersect,data:TSampleArray; i,len:integer; t:cardinal;
begin
SetLength(data,count);
for i:=0
to High(data)
do data[i]:=i+1;
intersect:=Copy(data);
len:=Length(intersect);
t:=GetTickCount;
for i:=1
to 11
do len:=IntersectData(intersect,data,len);
SetLength(intersect,len);
t:=GetTickCount-t;
ShowMessage('
Anzahl='+IntToStr(Length(intersect))+#13+
'
Zeit='+IntToStr(t)+'
ms');
end;