gleiche Zahlenfolgen im Array untersuchen

[Sendrix]

Hallo K-H,

Danke für Deinen Beitrag. Wenn ich das richtig verstehe läuft Dein Vergleich auf den Index des Array hinaus. Es geht aber nicht um den gleichen Index sondern um die gleichen Elemente des Arrays. Es kann ja sein das die Zahlenfolge 1 2 3 4 irgendwo im Array nochmal vorkommt und das herauszufinden ist mein Ziel.

Vieel Grüße,
Sendrix

[BoolString]

Das große Problem ist tatsächlich, wenn man Sequenzen hat, die als Teilsequenzen in einer größeren wieder auftauchen. Das ist ein Standardproblem, z.B. in der Genetik und ein weites Forschungsfeld. Letztlich ist eine visuelle Kontrolle immer ein sehr gutes Hilfsmittel. Ein hier verwendetes Verfahren nennt sich Dot-Plot und sollte nicht mit der gleichnamigen Darstellungsmethode verwechselt werden. Ein paar Algorithmen und Spielzeuge hierzu findest du bei mir unter:

- Hintergrund und Algos
- Software zum Ausprobieren


Für numerische Sequenzen gibt es eine sehr gute Arbeit von Marwan und Co.:

- Recurrence plots
- Graphische Darstellung

Ist vermutlich nicht genau das, was du suchtest, aber vielleicht etwas zum weiter drüber nachdenken/nutzen...

Jan

[blauweiss]

Hallo Sendrix,

ich würde es folgendermaßen angehen:

1. eine Routine (Funktion bzw. Methode falls Du ein Objekt daraus machen willst) "GetStringFromHere"
function GetStringFromHere(StartIndex, TokenCount: integer): string;
-> liefert Konkatenation von "TokenCount" Bestandteilen (natürlich beschränkt durch Listenende) ab StartIndex in der Liste

2. eine Routine "GetMatchIndex"
function GetMatchIndex(OriginIndex, TokenCount: integer): integer;
-> for-Schleife über alle Indizes (OriginIndex aussparen!), Abprüfung auf Gleichheit via GetStringFromHere
-> liefert -1 für keinen Match, ansonsten den Index des Matches

3. eine Routine "GetAnyMatchIndex"
function GetAnyMatchIndex(TokenCount: integer): integer;
-> for-Schleife über alle Indizes, Abprüfung auf Match via GetMatchIndex(Laufvariable, TokenCount)

3. eine Routine "FindBiggestMatch"
function FindBiggestMatch(aList: TStringList): integer;
-> Start mit TokenCount auf großem Wert (aList.Count falls je nur 1 Buchstabe, sonst irgendwas sinnvoll Großes (maximal Length(aList.Text))
-> per while-Schleife runter(!)zählen, um auf Match zu prüfen via GetAnyMatchIndex(TokenCount)

Die Implementation überlasse ich Dir, dürfte ja unschwer sein... 8-)

Gruß
blauweiss

[ibp]

2 Ideen:
1) Wie wäre es denn, wenn du einfach aufeinanderfolgende Sequenzen (n,n+1,n+2,..,n+k) aus deiner Folge in eine gesonderte Liste schreibst, diese sortierst und dann untersuchst?

2) Bitmasken könnte auch eine Überlegung Wert sein!

[blauweiss]

Hab's doch mal eben implementiert, weil es mich selber interessiert hat.

Delphi-Quellcode:

function GetStringFromHere(aList: TStringList;
                           StartIndex, TokenCount: integer): string;
var
  i: integer;
begin
  Result := aList[StartIndex]; // Achtung keine Abprüfung auf < 0 oder > aList.Count-1 ...!!
  for i := StartIndex+1 to StartIndex+TokenCount-1 do
    if (i > aList.Count-1) then
      break
    else
      Result := Result + aList[i];
end;

function GetMatchIndex(aList: TStringList;
                       OriginIndex, TokenCount: integer): integer;
var
  s: string;
  i: integer;
begin
  Result := -1;
  s := GetStringFromHere(aList, OriginIndex, TokenCount);
  for i := 0 to aList.Count-1 do
    if (i <> OriginIndex) then
      if (s = GetStringFromHere(aList, i, TokenCount)) then
        begin
          Result := i;
          break;
        end;
end;

function GetAnyMatchIndex(aList: TStringList;
                          TokenCount: integer): integer;
var
  i: integer;
begin
  Result := -1;
  for i := 0 to aList.Count-1 do
    if (GetMatchIndex(aList, i, TokenCount) <> -1) then
      begin
        Result := i;
        break;
      end;
end;

function FindBiggestMatch(aList: TStringList): integer;
var
  TokenCount: integer;
  MatchIndex: integer;
begin
  Result := 0;
  TokenCount := Length(aList.Text);
  while (TokenCount >= 1) do
    begin
      MatchIndex := GetAnyMatchIndex(aList, TokenCount);
      if (MatchIndex <> -1) then
        begin
          ShowMessage('Größter Match "' + GetStringFromHere(aList, MatchIndex, TokenCount) +
                      '" bei Index ' + IntToStr(MatchIndex) + #13#10 +
                      'Anzahl Zeichen: ' + IntToStr(TokenCount));
          Result := TokenCount;
          break;
        end;
      dec(TokenCount);
    end;
end;

Aufruf z.B.:

Delphi-Quellcode:

  aList := TStringList.Create;
  // aList füllen ... try..except sparen oder auch nicht
  if (FindBiggestMatch(aList) < 1) then
    ShowMessage('Keine Matches gefunden');
  aList.Free;

Gruß
blauweiss

[Klaus01]

Guten Abend,

würde es denn nicht auch schon ausreichen, wenn maximal nach einer 2 Ziffernfolge sucht
und das Array damit in Einzelschritten absucht.

In der angehängten Grafik wird deutlich, dass damit auch größere zusammenhängende Ziffernfolgen finden kann.

Grüße
Klaus

[Sir Rufo]

Wie wäre es damit? ;)

Das sucht alle gleichen heraus und gibt diese in ein Array (die Folge und die gefundene Anzahl).
Die längsten Folgen werden als erstes gefunden. Somit könnte man auch bei einer gefundenen einfach abbrechen.

Delphi-Quellcode:

unit model.ByteFolge;

interface

uses
  SysUtils;

type
  TByteSequence = record
    Sequence : TBytes;
    Count : Integer;
    function AsString : string;
  end;

  TByteSequences = array of TByteSequence;

function FindByteSequences( AByteArray : TBytes; ADepth : Integer = 0 ) : TByteSequences;

implementation

function Match( a, b : TBytes ) : Boolean;
var
  idx : Integer;
begin
  Result := ( Length( a ) = Length( b ) );
  if not Result
  then
    Exit;

  for idx := low( a ) to high( a ) do
    begin
      Result := Result and ( a[idx] = b[idx] );
      if not Result
      then
        Break;
    end;
end;

function IndexOfSequence( ASequence : TBytes; AList : TByteSequences ) : Integer;
var
  idx : Integer;
begin
  Result  := - 1;
  for idx := low( AList ) to high( AList ) do
    begin
      if Match( ASequence, AList[idx].Sequence )
      then
        begin
          Result := idx;
          Break;
        end;
    end;
end;

procedure AddSequence( ASequence : TBytes; var AList : TByteSequences );
var
  idx : Integer;
begin
  idx := IndexOfSequence( ASequence, AList );
  if idx < 0
  then
    begin
      SetLength( AList, Length( AList ) + 1 );
      idx                 := high( AList );
      AList[idx].Sequence := Copy( ASequence, low( ASequence ) );
      AList[idx].Count    := 1;
    end
  else
    begin
      AList[idx].Count := AList[idx].Count + 1;
    end;
end;

function FindByteSequences( AByteArray : TBytes; ADepth : Integer ) : TByteSequences;
var
  lSearchFor :   TBytes;
  lSearchIn :    TBytes;
  lCompare :     TBytes;
  lSearchIndex : Integer;
  lSearchPos :   Integer;
begin
  if ( Length( AByteArray ) div 2 < ADepth ) or ( ADepth = 0 )
  then
    Result := FindByteSequences( AByteArray, Length( AByteArray ) div 2 )
  else if ADepth >= 2
  then
    begin

      for lSearchIndex := low( AByteArray ) to high( AByteArray ) - ADepth * 2 + 1 do
        begin

          lSearchFor := Copy( AByteArray, lSearchIndex, ADepth );

          if IndexOfSequence( lSearchFor, Result ) < low( Result )
          then
            begin

              lSearchIn := Copy( AByteArray, lSearchIndex + ADepth );

              for lSearchPos := low( lSearchIn ) to high( lSearchIn ) - ADepth + 1 do
                begin
                  lCompare := Copy( lSearchIn, lSearchPos, ADepth );
                  if Match( lSearchFor, lCompare )
                  then
                    AddSequence( lSearchFor, Result );
                end;
            end;
        end;

      if ADepth > 2
      then
        Result := FindByteSequences( AByteArray, ADepth - 1 );

    end;
end;

{ TByteSequence }

function TByteSequence.AsString : string;
var
  idx : Integer;
begin
  Result  := '';
  for idx := low( Sequence ) to high( Sequence ) do
    begin
      if Result <> ''
      then
        Result := Result + ', ';
      Result   := Result + IntToHex( Sequence[idx], 2 );
    end;
  Result := '[ ' + Result + ' ] ' + IntToStr( Count );
end;

end.

[Medium]

Noch ein netter Fall: 1 2 3 1 2 3 1

Ist das 2x 1 2 3 und 1x 1
oder 2x 1 2 3 1 wobei die mittlere 1 2-fach verwendet wird?

Die Frage ist also: Darf mehrfach verwendet werden? Kommt auf den Einsatzzweck an, aber das Problem sollte einem bewusst sein.

[Sir Rufo]

Zitat:

Zitat von Medium (Beitrag 1128693)

Noch ein netter Fall: 1 2 3 1 2 3 1

Ist das 2x 1 2 3 und 1x 1
oder 2x 1 2 3 1 wobei die mittlere 1 2-fach verwendet wird?

Die Frage ist also: Darf mehrfach verwendet werden? Kommt auf den Einsatzzweck an, aber das Problem sollte einem bewusst sein.

Ja gute Frage :)

Um das zu finden muss der Start-Index für das lSearchIn geändert werden, dann werden die auch gefunden.

Delphi-Quellcode:

// statt
lSearchIn := Copy( AByteArray, lSearchIndex + ADepth );
// muss dann das genommen werden
lSearchIn := Copy( AByteArray, lSearchIndex + 1 );

[UliBru]

Wie wäre es mit einem etwas anderen Ansatz?
Bei einem Array der Länge n (n sei als gerade Zahl angenommen) könnte es maximal 2 Sequenzen der Länge n/2 geben. Wenn die Sequenzen gleich sind ist auch die Summe gleich.
Um nun die maximale Tiefe festzustellen bildet man ausgehend von n/2 Summanden bis runter zu 2 Summanden die jeweilige Summe. Man muss dann anschliessend nur die Sequenzen vergleichen, die eine gleiche Summe aufweisen.
Bei einer vorgegebenen gewünschten Tiefe x bildet man eben eben gleitend die Summen über x Werte.

Beispiel: Array = 1, 2, 3, 4, 5, 9, 2, 3, 5, 9
Tiefe x = 3
Summenwerte = 6, 9, 12, 18, 16, 14, 10, 17 => alle Werte unterschiedlich, damit x <> 3
Tiefe x = 2
Summenwerte = 3, 5, 7, 9, 14, 11, 5, 8, 14
Es zeigen sich mit 5 und 14 jeweils zwei identische Summen. Die weitere Untersuchung ergibt die Sequenzen 2, 3 und 5, 9.

Es müssen also nur Sequenzen mit gleichen Summen untersucht werden. Natürlich fallen dann Sequenzen mit veränderter Reihenfolge aber gleicher Summe dabei raus.