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

[Panthrax]

Code:

11 Messungen:
function Intersect(var Left: TSampleArray; const Right: TSampleArray);
* mit Length(Left) = Length(Right) = N = 10000000 // 10 Mio.
* mit denselben Daten für jede Routine
* mit zufällig generierten Daten für jede Messung
* in Millisekunden

             Messung  #19, Pascal  #39, Pascal  #61, Pascal  #35, Assembler  #59, Assembler
                   1      270          225          209              64              104
                   2      241          220          196              65              105
                   3      249          220          207              64              100
                   4      245          218          206              61              104
                   5      262          226          196              61              102
                   6      241          236          194              61              106
                   7      247          226          196              61              103
                   8      257          216          196              61              105
                   9      258          215          199              61              104
                  10      261          216          196              63              103
                  11      248          218          197              66              103

          Mittelwert      252,636      221,455      199,273          62,545          103,545
  Standardabweichung        9,500        6,283        5,350           1,916            1,635

Mein Algorithmus sollte nun auch fehlerfrei sein.

Das letzte Programm von Horst lässt sich nur mit {$DEFINE INT64DATA} kompilieren. Die Messungen sind aber nicht zuverlässig, weil die Hitzeregulierung mittendrin den Prozessortakt verändert.

Code:

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


-1 bei falscher Laenge
Pascal #19 |Pascal #39 |Pascal #39p|Pascal #51 |Pascal #61 |Assem  #59 |
 0  1479473|     942698|     962416|     619718|     869753|     256950|
 1  1237576|     984844|    1067793|     808219|     849550|     333418|
 0  1188971|     970760|     949159|     689957|     896708|     241256|
 1  1248376|     967134|    1073641|     773794|     881661|     332663|
 0  1146181|    1134064|     960496|     604081|    1015837|     277104|
 1  1451410|    1086576|    1069443|     729483|     868560|     328100|
 0  1162970|     977305|     956732|     651758|     916255|     239902|
 1  1234589|    1002855|    1082293|     805464|    1084635|     406615|
 0  1404511|     927632|    1018545|     596848|     904477|     241852|
 1  1235117|     997919|    1076292|     754609|     873866|     366354|
 0  1233630|     970846|     984954|     617806|     920718|     266788|
 1  1223514|    1053170|    1045890|     820487|     914746|     337277|

 Mittelwert
    1251531     1006646     1025931      713864      920638      306484
Standardabweichung
      93849       60489       53601       85766       69511       56339
 
Fertig.

[Horst_]

Hallo,

Da ich kein Unit diagnostics habe, ( Wo gibt es die für freepacal? ) habe ich ein workaround queryperformancecounter oder einfach time unter Linux genommen.

Der Aufruf der Assemblerversion sollte auch Intersect, hier Left, auf die richtige Länge setzen, damit Chancengleichheit herrscht und man den Fehler überhaupt erkennen kann.

Delphi-Quellcode:

procedure _Intersect59ASM(var Left: TSampleArray; const Right: TSampleArray);
var
  R: TSampleArray;
begin
  R := Right;
  //zuvor GetIntersect_5(Left, R, Length(Left)) 
  setlength(left,GetIntersect_5(Left, R, Length(Left)));
end;

Meine Prozedur hatte ich in #51 ja nicht explizit angegeben:

Delphi-Quellcode:

procedure Intersect51(var Left: TSampleArray; const Right: TSampleArray);
// modifiziertes Intersect45 auf while Schleife
type
{$PointerMath On}
  pData = ^tData; // hier ist tData Int64

var
  L, R, LeftEnd, RightEnd: pData;
  N: NativeInt;
begin
  N := 0;
  L := @Left[0];
  R := @Right[0];
  LeftEnd := @Left[Length(Left)];
  RightEnd := @Right[Length(Right)];

  if (L < LeftEnd) and (R < RightEnd) then
    repeat
      while  (L < LeftEnd) and (R < RightEnd) AND (L^ = R^) do
      begin
        Left[N] := L^;
        Inc(N);
        inc(R);
        inc(L);
      end;
      if (L = LeftEnd) OR ( R = RightEnd) then
        Break;
     
      while (L < LeftEnd)  AND (L^ < R^) do
        inc(L);
      while (R < RightEnd) AND (R^ < L^) do
        inc(R);
    until False;

  SetLength(Left, N);
{$PointerMath Off}  
end;

Meine Laufzeiten unter Linux mit freepascal 2.6.0 sind nun mit einem Phenom 955 X4 mit 3,2 Ghz:

Code:

  #61, Pascal  10000000
  #39, Pascal  10000000
  #51, Pascal  10000000
  #59, Assem    9999999

   Messung  #61, Pascal  #39, Pascal  #51, Pascal  #59, Assem 
         1      138          134           76           62
         2      137          133           76           59
         3      137          134           77           59
         4      136          134           77           59
         5      137          134           76           59
         6      137          134           77           64
         7      137          133           77           58
         8      137          135           76           60
         9      138          134           76           59
        10      137          133           76           59
        11      137          134           76           59
Fertig.

Im angehängten Program habe ich als Gag es ein Define Laptop, um die Pause einzubauen.

Gruß Horst

[Panthrax]

Vielen Dank für den Kompilerschalter! Hier meine Messwerte auf einem i7 M640 @ 2,8 GHz, Windows 7 64 Bit:

{$DEFINE INT64DATA}

Code:

  #61, Pascal  10000000
  #39, Pascal  10000000
  #51, Pascal  10000000
  #59, Assem   10000000

   Messung  #61, Pascal  #39, Pascal  #51, Pascal  #59, Assem
         1      218          154           75           38
         2      212          154           73           37
         3      216          148           72           39
         4      214          153           74           39
         5      216          152           71           41
         6      217          152           82           41
         7      221          155           75           39
         8      220          152           72           43
         9      214          160           74           51
        10      213          154           73           41
        11      231          156           73           37

Mittelwert      217,455      153,636       74,000       40,545
Standardabw.      5,298        2,976        2,933        3,934
Fertig.

//{$DEFINE INT64DATA}

Code:

  #61, Pascal  10000000
  #39, Pascal  10000000
  #51, Pascal  10000000
  #59, Assem   10000000

   Messung  #61, Pascal  #39, Pascal  #51, Pascal  #59, Assem
         1      218          158           80           34
         2      219          155           71           34
         3      220          166           77           38
         4      225          159           76           35
         5      217          164           80           40
         6      218          150           72           37
         7      218          161           78           36
         8      220          152           71           35
         9      214          164           76           37
        10      217          152           70           35
        11      231          166           85           38

Mittelwert      219,727      158,818       76,000       36,273
Standardabw.      4,606        5,896        4,690        1,902
Fertig.

Damit ich es kompilieren konnte musste ich einen Schreibfehler korrigieren:

Delphi-Quellcode:

{$Else} // war: eine schließende, eckige Klammer
  {$AppType Console}
{$EndIf}

Das Längesetzen im _Intersect*ASM hätte ich tun sollen. Ich weiß auch nicht, warum ich das immer unterschlagen habe.

Auch wenn es die Unit Diagnostics für FreePascal so nicht zu geben schein. Dein Ersatz ist doch angemessen und gut!

Vielleicht sollte ich noch ein Wort zu den Schleifen sagen. Ich hatte ausprobiert welche schneller sind; und für mein System waren es die Repeat-Until-Schleifen, was den Algorithmus etwas verkompliziert hat. Ich hatte auch erst While-Schleifen, weil sie einfach so viel besser zum Algortihmus passen, wie ein oberflächlicher Vergleich schon zeigt. Interessanterweise zeigen die Zeiten, dass das es dieser Geschwindigkeitsgewinn nicht überall so zu geben scheint.

[Amateurprofi]

Zitat von Horst_:

Hallo,

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

Gruß Horst

Hallo Horst,
sorry, aber bei mir passiert das nicht.
Zumindest dann nicht, wenn ich tData=integer deklariere.
Wenn ich, wie du es gemacht hast tData=cardinal deklariere, dann wird nicht compiliert, anstatt kommt in der Prozedur FillArray bei der Zeile
d := delta * MAXDATCOUNT; eine Fehlermeldung :
[DCC Fehler] Intersect_Main.pas(318): E2099 Überlauf bei Konvertierung oder arithmetischer Operation
Die OH sagt hierzu:
Der Compiler hat in einem arithmetischen Ausdruck einen Überlauf entdeckt. Das Ergebnis des Ausdrucks kann wegen seiner Größe nicht in 32 Bits dargestellt werden. Überprüfen Sie die durchgeführten Berechnungen, und stellen Sie sicher, dass die Ergebnisse von der Hardware des Computers dargestellt werden können.

Und wenn ich mit der Maus auf die Konstante "delta" zeige dann kommt der Hinweis
delta = null - Erroneous Type

Wenn ich aber nun die Konstante delta explizit als cardinal deklariere, also
delta:cardinal= High(TData) div maxdatcount-1; dann wird compiliert und die Asm-Funktion liefert korrekte Ergebnisse.

Ich vermute, dass es daran liegt….

Delphi-Quellcode:

type
   TData=cardinal;

const
   maxdatcount=5000000;
//   delta=High(TData) div maxdatcount-1; // so wird nicht compiliert
     delta:cardinal=High(TData) div maxdatcount-1; // so funktioniert es

procedure FillArray(var A:TSampleArray);
var
  i : integer;
  d : tData;
begin
  i := High(A);
  d := delta * MAXDATCOUNT;
  For i := i downto 0 do
    begin
    d := d-delta;
    A[i] := d;
    end;
end;

procedure TMain.Button1Click(Sender: TObject);
var intersect,data:TSampleArray; 
begin
   SetLength(data,maxdatcount);
   FillArray(data);
   intersect:=copy(data);
   SetLength(intersect,GetIntersect_5(intersect,data,Length(intersect)));
   meRes.Lines.Add(inttostr(Length(intersect)));
end;

[Horst_]

Hallo,

Ach Herr je,
da will man clever sein und fällt wieder auf die Nase
Weil bei mir PrepareSamples wegen random in freepascal so ewig dauerte, kam ich auf die Idee, für eine neue Runde Left aus Right zu kopieren und anschliessend nur PrepareSamples(Right) aufzurufen.
Dämlicherweise habe ich dies nicht ans Ende der repetitions-Schleife getan sondern noch in der Schleife für die Varianten.
Deshalb hatten die Nicht-Ersten Varianten immer gleiche Felder zu untersuchen, was rasend schnell ist.
Dies habe ich nun geändert.

@Amateurprofi:
Ich benutze seit der letzten Version für die Belegung der Testfelder die Version von Panthrax.
Ich weiß nicht, ob freepascal statt length, high abspeichert und deshalb das Programm das letzte Element des array nicht mehr testet

Delphi-Quellcode:

asm

...
mov edi,[eax] // @Intersect[0]
              // Zeiger in Intersect und Data hinter jeweils letzten Eintrag
              // stellen und Indizes auf jeweils ersten Eintrag ausrichten
lea edi,[edi+ecx*8] // @Intersect[Len] // Offset berechnen damit
neg ecx             // [edi+ecx*8] = Intersect[0]

..
mov esi,[edx] // @Data[0]
..
mov ebx,[esi-4] // Length(Data) oder High(Data)?
...
add ecx,1 // Nächster Intersect-Index
je @SetRes // Fertig
end;

Deshalb hab ich die Vorbelegung derart geändert, das im letzten Element im High(TData) steht.

Delphi-Quellcode:

procedure PrepareSamples(out Value: TSampleArray; const N: NativeInt = 10000000; const S: NativeInt = 5);
var
  I: NativeInt;
begin
  SetLength(Value, N);
  Value[0] := Random(S);
  for I := 1 to N - 2 do
    Value[I] := Value[I - 1] + Random(S) + 1;
  Value[N-1] := High(TData);
end;

Dann habe ich die Ausgabe wie im Kommentar von Panthrax gemacht, also die Ausgabe von Länge der Schnittmenge und Laufzeit,aber mit Komma getrennt ( csv )
Mit Freepascal ergibt sich:

Code:

  #39, Pascal  10000000
  #51, Pascal  10000000
  #61, Pascal  10000000
  #59, Assem    9999999

   Messung  #39, Pascal  #51, Pascal  #61, Pascal  #59, Assem
         1,3332223,125 ,3332223,116 ,3332223,111  ,3332222,76
         2,3333764,129 ,3333764,121 ,3333764,118  ,3333763,70
         3,3338301,123 ,3338301,117 ,3338301,112  ,3338300,69
         4,3334825,123 ,3334825,115 ,3334825,111  ,3334824,68
         5,3330696,123 ,3330696,115 ,3330696,112  ,3330695,68
         6,3333988,124 ,3333988,119 ,3333988,111  ,3333987,71
         7,3333174,123 ,3333174,117 ,3333174,111  ,3333173,76
         8,3333983,123 ,3333983,118 ,3333983,111  ,3333982,68
         9,3335054,125 ,3335054,117 ,3335054,112  ,3335053,74
        10,3333229,123 ,3333229,117 ,3333229,111  ,3333228,71
        11,3332975,123 ,3332975,115 ,3332975,111  ,3332974,70
Fertig.

Hier hat die Assembler Version immer ein Element zu wenig.

Gruß Horst

EDIT:
Der Test mit Freepascal ergab:

Delphi-Quellcode:

  L := @Left[0];
  R := @Right[0];
  DEC(R); writeln(R^);INC(R);
  DEC(L); writeln(L^);INC(L);
...
Ausgabe
9999999
9999999

Also speichert freepascal High(DynArray) statt Length(DynArray)

Böse Falle das!

[Panthrax]

{$DEFINE INT64DATA}
{$DEFINE LAPTOP}

Code:

 #39, Pascal  10000000
 #51, Pascal  10000000
 #61, Pascal  10000000
 #59, Assem   10000000

  Messung  #39, Pascal  #51, Pascal  #61, Pascal  #59, Assem
        1,3333535,239 ,3333535,238 ,3333535,217 ,3333535,138
        2,3332769,223 ,3332769,223 ,3332769,210 ,3332769,129
        3,3332354,223 ,3332354,218 ,3332354,202 ,3332354,124
        4,3335244,219 ,3335244,221 ,3335244,200 ,3335244,129
        5,3330107,222 ,3330107,220 ,3330107,204 ,3330107,128
        6,3333308,219 ,3333308,222 ,3333308,208 ,3333308,128
        7,3330565,226 ,3330565,220 ,3330565,202 ,3330565,128
        8,3331374,252 ,3331374,245 ,3331374,206 ,3331374,129
        9,3332415,220 ,3332415,221 ,3332415,206 ,3332415,141
       10,3333225,223 ,3333225,216 ,3333225,219 ,3333225,128
       11,3333172,221 ,3333172,221 ,3333172,217 ,3333172,127
Mittelwert
          226,091      224,091      208,273      129,909
Standardabweichung
           10,232        8,949        6,680        4,989

//{$DEFINE INT64DATA}
{$DEFINE LAPTOP}

Code:

 #39, Pascal  10000000
 #51, Pascal  10000000
 #61, Pascal  10000000
 #59, Assem   10000000

  Messung  #39, Pascal  #51, Pascal  #61, Pascal  #59, Assem
         1,3333535,206 ,3333535,193 ,3333535,176 ,3333535,116
         2,3332769,188 ,3332769,179 ,3332769,166 ,3332769,104
         3,3332354,194 ,3332354,181 ,3332354,165 ,3332354,108
         4,3335244,219 ,3335244,194 ,3335244,183 ,3335244,120
         5,3330107,201 ,3330107,181 ,3330107,166 ,3330107,100
         6,3333308,198 ,3333308,189 ,3333308,171 ,3333308,102
         7,3330565,195 ,3330565,179 ,3330565,165 ,3330565,106
         8,3331374,195 ,3331374,177 ,3331374,166 ,3331374,104
         9,3332415,199 ,3332415,180 ,3332415,163 ,3332415,105
        10,3333225,207 ,3333225,182 ,3333225,167 ,3333225,107
        11,3333172,220 ,3333172,179 ,3333172,163 ,3333172,102
Mittelwert
           202,000      183,091      168,273      106,727
Standardabweichung
            10,188        5,991        6,150        6,101

[Horst_]

Hallo,

dann liegt es wohl an Freepascal und deren Speicherung dynamischer Felder.
Was mich wundert, dass Panthrax mit Win64 das kompiliert bekommt.
Freepascal 2.7.1. für Linux64 meckert über jede Zeile.
Die Pascalversionen sind dann aber für Int64 (etwas mehr) und Int32 ( ein wenig) schneller, weil dann viel mehr Register benutzt werden können, aber kein Vergelich zu den Assemblerversionen.

Gruß Horst