Schnittmenge von mehreren Mengen ermitteln

[Horst_]

Hallo,

Was soll ich sagen, aber es zählt immer noch einen zuwenig, wenn gleiche Felder vorliegen .

Delphi-Quellcode:

  // Ausgangsfeld erzeugen
  setlength(TestFeld,MAXDATCOUNT);
  FillArray(TestFeld);
  writeln('Laenge Ausgangsfeld                        ',length(TestFeld):9);
  writeln('Ausgabe GetINtersect5 bei gleichen Feldern ',GetIntersect_5(TestFeld,TestFeld,length(TestFeld)):9);  
  writeln();

Ergibt:

Code:

Laenge Ausgangsfeld                             1000
Ausgabe GetINtersect5 bei gleichen Feldern       999

Mit freepascal 2.6.0 funktioniert die Konstante f nicht.

Delphi-Quellcode:

function GetIntersect_5(var Intersect, Data: TSampleArray; len:integer): Integer;
asm
// IN : EAX=@Intersect, EDX=@Data, ECX=Anzahl der Elemente der bisherigen Schnittmenge
// Out : EAX=Neue Anzahl der Elemente der Schnittmenge
                // Alle Register retten
                pushad // Temp:=ESP; Push EAX,ECX,EDX,EBX,Temp,EBP,ESI,EDI
                // Prüfen ob Data leer
                mov esi,[edx] // @Data[0]
                test esi,esi
                je @ReturnZero // Data ist leer
                mov edi,[eax] // @Intersect[0]
                test edi,edi
                je @ReturnZero // Intersect leer
                // Zeiger in Intersect und Data hinter jeweils letzten Eintrag
                // stellen und Indizes auf jeweils ersten Eintrag ausrichten
                {$IFDEF INT64DATA}
                lea edi,[edi+ecx*8] // @Intersect[Len]
                {$ELSE}
                lea edi,[edi+ecx*4] // @Intersect[Len]
                {$ENDIF}
                neg ecx // i [edi+ecx*4] = Intersect[0]
                je @ReturnZero // 0 Elemente in Intersect
                mov ebp,ecx // k [edi+ebp*4] = Intersect[0]
                mov ebx,[esi-4] // Length(data)
                {$IFDEF INT64DATA}
                lea esi,[esi+ebx*8]
                {$ELSE}
                lea esi,[esi+ebx*4] // @Intersect[Len]
                {$ENDIF}
                neg ebx // j [esi+edx*4] = Data[0]
                jmp @Entry

 @Store:        
                // In neuem Intersect speichern
                {$IFDEF INT64DATA}
                 mov [edi+ebp*8],eax
                 mov [edi+ebp*8+4],edx // Hi wenn int64
                {$ELSE}
                 mov [edi+ebp*4],eax
                {$ENDIF}
                add ebp,1 // Neue Anzahl in Intersect
                add ecx,1 // Nächster Intersect-Index
                je @SetRes // Fertig
               {$IFDEF INT64DATA}
                mov eax,[edi+ecx*8] // Zahl aus Intersect laden
                mov edx,[edi+ecx*8+4] // Hi wenn int64                
                {$ELSE}
                 mov eax,[edi+ecx*4] 
                {$ENDIF};
 @NextData:     
                add ebx,1 // Nächster Data-Index
                je @SetRes // Fertig
 @Compare:      
                {$IFDEF INT64DATA}
                cmp edx,[esi+ebx*8+4] // Vergleich Intersect, Data (Hi)
                ja @NextData // Intersect>Data. Nur Data-Index erhöhen
                jb @NextI
                cmp eax,[esi+ebx*8] // Vergleich Intersect, Data
                {$ELSE};                
                cmp eax,[esi+ebx*4] // Vergleich Intersect, Data
                {$ENDIF};                
                je @Store // Gleich. Speichern und beide Indizes erhöhen
                ja @NextData // Intersect>Data. Nur Data-Index erhöhen
 @NextI:        
                add ecx,1 // Nächster Intersect-Index
                je @SetRes // Fertig
                 
 @Entry:        
                {$IFDEF INT64DATA}
                mov eax,[edi+ecx*8] // Zahl aus Intersect laden
                mov edx,[edi+ecx*8+4] // Hi wenn int64
                {$ELSE}
                mov eax,[edi+ecx*4]
                {$ENDIF};
                jmp @Compare

 @SetRes:       
                add ebp,[esp+24] // Alte Länge addieren (ebp ist <= 0)
                jmp @StoreRes

 @ReturnZero:   
                xor ebp,ebp
 @StoreRes:     
                mov [esp+28],ebp // von da wird sie in EAX gepopt
                popad
end;

Natürlich ist es rasant viel schneller.
Etwa 60% Laufzeit von meiner Version #51 und 40% von Furtbichlers Version #39.
Hier einmal mit 64Bit Daten:

Code:

Testlauf mit gleichen Feldern
Laenge Ausgangsfeld     5000000

Pascal #19 |            4999999
Pascal #39 |            5000000
Pascal #39p|            5000000
Pascal #45 |            5000000
Pascal #51 |            5000000
Assem  #59 |            4999999

-1 bei falscher Länge
Pascal #19 |Pascal #39 |Pascal #39p|Pascal #45 |Pascal #51 |Assem  #59 |
 0  1032722|     779007|     781494|     682641|     517543|     309627|
 1  1007572|     756619|     746804|         -1|     552682|     340868|
 0  1037553|     779392|     777746|     682334|     516801|     328240|
 1  1008169|     756272|     746638|     631414|     551661|     329541|
 0  1034872|     779641|     777919|     681329|     514093|     304921|
 1  1005277|     755735|     749490|         -1|     560050|     327174|
 0  1033337|     777257|     781387|     682378|     514298|     306631|
 1  1010560|     756301|     749123|         -1|     550271|     345284|
 0  1033724|     780110|     777521|     685260|     514094|     307414|
 1  1010056|     760684|     749326|         -1|     556893|     329527|
 0  1033210|     776339|     777866|     681292|     513723|     306443|
 1  1008153|     757486|     746477|     628156|     556972|     341013|
Fertig.

Bei 32-bit ist der Unterschied größer:

Code:

Testlauf mit gleichen Feldern
Laenge Ausgangsfeld     5000000
Pascal #19 |            4999999
Pascal #39 |            5000000
Pascal #39p|            5000000
Pascal #45 |            5000000
Pascal #51 |            5000000
Assem  #59 |            4999999

-1 bei falscher Länge
Pascal #19 |Pascal #39 |Pascal #39p|Pascal #45 |Pascal #51 |Assem  #59 |
 0   600767|     495126|     460957|     479938|     432181|     175543|
 1   641177|     528338|     477717|     465587|     459524|     248209|
 0   599462|     496682|     460025|         -1|     431155|     186023|
 1   645629|     525119|     477410|     465200|     463242|     248517|
 0   600016|     495281|     460690|     480712|     430214|     182466|
 1   645418|     526174|     478063|         -1|     463148|     248494|
 0   601073|     496591|     460689|         -1|     433332|     186775|
 1   646770|     525318|     477356|         -1|     460146|     231838|
 0   602341|     496265|     459657|     480644|     433047|     184413|
 1   646620|     525649|     477909|         -1|     463296|     248481|
 0   599127|     495659|     460553|     484453|     428845|     173225|
 1   645832|     525271|     476603|     464068|     461602|     248839|
Fertig.

Gruß Horst