gleiche Zahlenfolgen im Array untersuchen

[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.