Schneller Stringvergleich nach bestimmtem Muster

[taveuni]

Zitat:

Zitat von jobo (Beitrag 1323901)

Nagut, ein "Match" entsteht in 98% der Fälle ja offenbar auch ohne Mustervergleich, sondern bei Exaktheit, solche Abfragen gegen 50T Datensätze haben ja quasi keine spürbare Laufzeit. Ein Mustervergleich mit längerer Laufzeit erfolgt dann nur in wenigen Fällen und wie gesagt, die halbe Sekunde aus meinem Versuch ist bestimmt stark optimierbar, siehe z.B. @Bug: Mengeneinschränkung durch Längenfilter, vielleicht hilft auch die Laufzeitbetrachtung zwischen Eingang und Ausgang und natürlich Optimierung an der Abfrage ..

Leider nicht. Es ist so: Es existieren z.b. 50 "Eingangsscanner". "Ausgangsscanner" nur 5 Stück. Nur 4 von den Eingangsscannern sind aber überhaupt relevant für die ganze Überprüfung (genauer Match, Ähnlichkeit usw.). Also landen nur diese im Pool für den Vergleich an den Ausgängen. Aber alle units passieren die 5 Ausgangsscanner. Somit sind eigentlich 90% am Ausgang nicht relevant. Aber da alle auf den gleichen Ausgang kommen.. müssen wir alle units vergleichen! Und deshalb muss dieser Vergleich sehr schnell sein.

[taveuni]

Eure Vorschläge für die Unterteilung in verschiedene Listen abhängig der Länge werde ich weiter verfolgen. Momentan sehe ich das Problem aber noch in der Abgrenzung. Denn so könnte es ja sein dass ich dann teilweise gegen zwei Listen prüfen muss?

[jobo]

Zitat:

Zitat von taveuni (Beitrag 1323904)

Denn so könnte es ja sein dass ich dann teilweise gegen zwei Listen prüfen muss?

Eher gegen 3?
Aber ist doch egal, der Kern ist eine grobe Reduktion der notwendigen Vergleiche.

[jobo]

Zitat:

Zitat von taveuni (Beitrag 1323903)

Aber da alle auf den gleichen Ausgang kommen.. müssen wir alle units vergleichen! Und deshalb muss dieser Vergleich sehr schnell sein.

Ich rede ja nur davon, dass der Vergleich unterschiedlich komplex Ausfallen kann und damit Zeit gespart werden kann.

[nahpets]

Mal ein paar (unsinnige?) Gedankenspiele:

Ab ins alte Turbopascal, dort enthielt bei Strings das 0. Byte die Länge.
Das dürfte heute bei ShortString noch so sein. Geht ShortString auch? Wenn ja:

Delphi-Quellcode:

var sBaseStr : ShortString;
    lBaseStr : Byte absolut sBaseStr;

Damit befindet sich die Längenangabe von sBaseStr automatisch in lBaseStr. Die wiederholte Längenabfrage per Length kann damit entfallen.

Alternativ die Länge nur einmalig abfragen und in Variabeln speichern. Alles entfernen, was wiederholt gemacht werden muss. Lieber ein paar zusätzliche Variabeln "mitschleppen".

Delphi-Quellcode:

function MatchRule(const BaseStr: String; const CompareList: TStringList): Boolean;
var
  i                  : Integer;
  j                  : Integer;
  cntForward         : Integer;
  cntBackward        : Integer;
  lBase              : Integer;
  lComp              : Integer;
  StrBase            : String;
  lStrBase           : Integer; // Länge von StrBase
  StrCompare         : String;
  lStrCompare        : Integer; // Länge von StrCompare
  lStrBaseStrCompare : Integer; // Differenz: lStrCompare - lStrBase
begin
  Result := False;
  bBreak := False;
  lBase  := Length(BaseStr);
  for i := 0 to CompareList.Count - 1 do begin
    lComp := Length(CompareList[i]);
    if InRange(lBase - lComp,-1,1) then begin
      cntForward  := 0;
      cntBackward := 0;
      if lBase <= lComp then begin
        StrBase    := BaseStr;
        StrCompare := CompareList[i];
      end else begin
        StrBase    := CompareList[i];
        StrCompare := BaseStr;
      end;
      // compare contains base
      lStrBase    := Length(StrBase);
      lStrCompare := Length(StrCompare);
      if lStrBase < lStrCompare then Result:= Pos(StrBase, StrCompare) > 0;
      if not Result then begin
        // check forward
        for j := 1 to lStrBase - 1 do begin // Warum kein Vergleich beim letzten Zeichen?
          if StrBase[j] = StrCompare[j] then inc(cntForward)
          else break;  // Beim ersten Unterschied raus aus For...
        end;
        // check backward
        lStrBaseStrCompare := lStrCompare - lStrBase;
        for j := lStrBase downto 1 do begin
          if StrBase[j] = StrCompare[j + lStrBaseStrCompare] then
            inc(cntBackward)
          else break;  // Beim ersten Unterschied raus aus For...
        end;
        if lBase = lComp then
          // bei gleicher Länge darf es einen Unterschied geben.
          Result := (cntForward + cntBackward) >= (lStrBase - 1)
        else
          Result := (cntForward + cntBackward) = lStrBase;
      end;
      if Result then Exit;  // hier raus, wenn Result = True;
    end;
    // else Continue; // überflüssig, da wir hier ja sowieso am Ende der Schleife sind.
  end;
end;

Ob das jetzt große Geschwindigkeitsunterschiede gibt, mag ich nicht zu beurteilen.
Meine praktische Erfahrung ist jedoch, dass bei häufig wiederholten Routinen durchaus Geschwindigkeitsvorteile zu erwarten sind, wenn man wiederholt per Pos, Length... ermittelte Werte in separaten Variablen "mitschleppt", um die wiederholte Ausführung, eigentlich trivialer Funktionen, zu eliminieren.

[taveuni]

Danke. Ich habs ausprobiert. Bei Prüfung gegen 50000 habe ich keinen messbaren Unterschied gefunden. Vermutlich Compilermagic.
Zu Deinen Kommentaren:
-Bei Forward warum nicht bis zum Schluss? Um einen Durchlauf zu sparen. Denn wenn es die letzte Ziffer ist spielt es keine Rolle. Wenn es die zweitletzte ist - macht es die Prüfung von hinten wieder wett. Fällt grad auf - vermutlich kann ich Rückwärtslauf das gleiche machen.
- Das Continue: Logisch Danke.

[pertzschc]

Versuch es dochmal mit dem Algorythmus des längsten gemeinsames Teilstrings: hier.
Grüße,
Christoph

[Amateurprofi]

Hallo taveuni,
ich hatte ja schon per PN mitgeteilt, dass ich eine Vergleichsfunktion geschrieben habe, die recht flott arbeitet und hatte dich gebeten mir eine etwas größere Anzahl von Testdaten zur Verfügung zu stellen, um meine Funktion zu testen.
Du hattest mir daraufhin eine Datei mit 200000 echten Scan-Daten gesandt.
Ja, das war nun wirklich eine "etwas größere Anzahl".
Danke dafür.

Ich habe dann jeden dieser Teststrings gegen jedem anderen aus der Liste geprüft, insgesamt ca. 40E9 Vergleiche (hat 42 Minuten gebraucht).

Die Vergleiche habe ich durchgeführt
- Mit deiner Routine. (genauer mit einer Routine die ich aus deinem Code extrahiert habe)
- Mit meiner Pascal Routine.
- Mit meiner Asm Routine.

Anfangs gab es Fehlermeldungen weil deine Routine andere Ergebnisse brachte, als meine beiden Routinen.

Beispiel:
MCB6551
MCB6554
Deine Routine lieferte False, meine beiden True (und korrekt ist True).

Woran lags?!

Delphi-Quellcode:

// check forward
for j := 1 to Length(StrBase) -1 do begin
  if StrBase[j] = StrCompare[j] then inc(cntForward)
     else break;
end;

cntForward ist jetzt = 6.
Im folgenden Teil werden die jeweils letzten Zeichen der Texte verglichen, also 1 vs. 4.

Delphi-Quellcode:

// check backward
for j := Length(StrBase) downto 1 do begin
  if StrBase[j] = StrCompare[j+(Length(StrCompare) - Length(StrBase))] then
    inc(cntBackward)
  else break;
  if lBase = lComp then
     Result:= (cntForward + cntBackward) >= (Length(StrBase) -1)
  else
  Result:= (cntForward + cntBackward) = Length(StrBase);
end;

Da die Zeichen nicht übereinstimmen, kommt das Break zum tragen und die Prüfung, ob cntForward+ cntBackward >= Length(StrBase) -1 ist, wird nicht ausgeführt.

Also: Wenn bei Texten gleicher Länge nur die jeweils letzten Zeichen abweichen, liefert die Routine False statt True.

Ich hab dann nach dem CheckForward eingefügt:

Delphi-Quellcode:

if (lBase = lComp) and (cntForward=lBase-1) then begin
   Result:=True;
   Exit;
end;

Der nächste Fehler kam bei
NE11925
NE1925

Deine Routine lieferte False, meine beiden dagegen True (und korrekt ist True)

Woran lag es?!
Beim Vorwärtszählen wird cntForward = 3.
Beim Rückwärtszählen ist nach Übereinstimmung der beiden 9nen cntBackward = 3 und Result wird = True gesetzt, weil cntForward + cntBackward = Length(StrBase) ist.
Jedoch wird das Rückwärtszählen nicht abgebrochen. Nachdem auch die vor den 9nen stehenden Zeichen gleich sind, ist dann cntBackward = 4 und Result wird = False gesetzt, weil cntForward + cntBackward nicht = Length(StrBase) ist.

Dieser Fehler tritt bei Texte unterschiedlicher Länge genau dann auf, wenn das Zeichen, mit dem das Vorwärtszählen beendet wird (hier die 1), im längeren Text doppelt vorkommt, und die dann folgenden Zeichen (rückwärts betrachtet) identisch sind.

Lösung auf dir Schnelle:
hinter

Delphi-Quellcode:

  if lBase = lComp then
     Result:= (cntForward + cntBackward) >= (Length(StrBase) -1)
  else
  Result:= (cntForward + cntBackward) = Length(StrBase);

einfügen

Delphi-Quellcode:

if Result then Exit;

Danach wurde die gesamte Prüfung ohne Abweichungen abgearbeitet, also alle 3 Routinen lieferten identische Ergebnisse.

Und nachstehend sind meine beiden Vergleichsroutinen.
Die Pascal Routine arbeitet deutlich schneller als deine, Faktor zwischen 2 und 4 (Bei wiederholten Testen kommen recht unterschiedliche Laufzeiten).
Die Asm-Routine ist dann noch einmal ca. 25 % schneller.

Delphi-Quellcode:

FUNCTION Compare(const S1,S2:String):Boolean;
var I,J,L1,L2:Integer;
begin
   Result:=False;
   if (S1='') or (S2='') then Exit;
   L1:=Length(S1);
   L2:=Length(S2);
   J:=L1-L2;
   case J of
      0  :  for I:=1 to L1 do  // beide gleich lang
               if S1[I]<>S2[I] then
                  if J=1 then Exit
                     else J:=1;
      1  :  begin
               I:=0;
               while J<=L2 do // S2 um 1 kürzer als S1
                  if S2[J]=S1[J+I] then Inc(J)
                     else if I>0 then Exit
                        else I:=1;
            end;
      -1  : begin
               I:=1;
               J:=0;
               while I<=L1 do // S1 um 1 kürzer als S2
                  if S1[I]=S2[I+J] then Inc(I)
                     else if J>0 then Exit
                        else J:=1;
            end;
      else  Exit;
   end;
   Result:=True;
end;

Code:

FUNCTION CompareAsm(const S1,S2:String):Boolean;
asm
               test     eax,eax
               jz       @Ret                 // S1 leer
               test     edx,edx
               jz       @RetFalse            // S2 leer
               mov      ecx,[eax-4]          // Length(S1)
               sub      ecx,[edx-4]          // Length(S1)-Length(S2)
               je       @SameLen
               ja       @Longer              // S1 ist länger
               cmp      ecx,-1
               jne      @RetFalse            // Längendifferenz>1
               jmp      @DifferentLen
@Longer:       cmp      ecx,1
               jne      @RetFalse            // Längendifferenz>1
               xchg     eax,edx              // EAX <--> EDX
@DifferentLen: // Längen unterscheiden sich um 1.
               // EAX=Kürzerer String, EDX=Längerer String
               push     ebx
               mov      ecx,[eax-4]
               lea      eax,[eax+ecx*2]      // Hinter S1
               lea      edx,[edx+ecx*2]      // Auf letztes Zeichen von S2
               neg      ecx
@DLLoop1:      mov      bx,[eax+ecx*2]       // Zeichen aus S1
               cmp      bx,[edx+ecx*2]       // vs. Zeichen aus S2
               jne      @DLNotFound
               add      ecx,1
               jl       @DLLoop1
               jmp      @True
@DLNotFound:   add      edx,2                // Hinter S2
               jmp      @DLEntry
@DLLoop2:      mov      bx,[eax+ecx*2]       // Zeichen aus S1
@DLEntry:      cmp      bx,[edx+ecx*2]       // vs. Zeichen aus S2
               jne      @False
               add      ecx,1
               jl       @DLLoop2
               jmp      @True
@SameLen:      // Längen sind gleich
               push     ebx
               mov      ecx,[eax-4]
               lea      eax,[eax+ecx*2]      // Hinter S1
               lea      edx,[edx+ecx*2]      // Hinter S2
               neg      ecx
@SLLoop1:      mov      bx,[eax+ecx*2]       // Zeichen aus S1
               cmp      bx,[edx+ecx*2]       // vs. Zeichen aus S2
               jne      @SLNext
               add      ecx,1
               jl       @SLLoop1
               jmp      @True
@SLLoop2:      mov      bx,[eax+ecx*2]       // Zeichen aus S1
               cmp      bx,[edx+ecx*2]       // vs. Zeichen aus S2
               jne      @False
@SLNext:       add      ecx,1
               jl       @SLLoop2
@True:         mov      eax,1
               pop      ebx
               jmp      @Ret
@False:        pop      ebx
@RetFalse:     xor      eax,eax
@Ret:
end;

[taveuni]

Hallo Klaus,
Wie schon per PN mitgeteilt - vielen Dank für Deinen Input. Ich werde Deine Funktion übernehmen da der Performancegewinn beträchtlich ist. Die Fehler in meiner Routine hatten wir mit Tests übrigens ebenfalls bereits bereinigt.

Zu Deinen Gedanken:
Der Pool besteht aus Objekten welche primär in einer generischen Objektliste liegen. Bei einem Match oder neu eben einer Ähnlichkeit gibt die übergeordnete Funktion dem Aufrufer das gefundende Objekt als Clone zurück. Am Schluss wird selbstverständlich dieses Objekt aus dem Pool gelöscht.

Der Fall dass mehrere ähnliche Objekte im Pool sein könnten - darüber müssen wir uns zu einem späteren Zeitpunkt Gedanken machen.

Besten Dank!

Gruss Werner