Comparing arrays in Delphi

Question

I have 3 arrays, for example:

const
  A: Array[0..9] of Byte = ($00, $01, $AA, $A1, $BB, $B1, $B2, $B3, $B4, $FF);
  B: Array[0..2] of Byte = ($A1, $BB, $B1);
  C: Array[0..2] of Byte = ($00, $BB, $FF);

Is there a way to compare and get the index of the right one, instead of checking each byte 1 by 1? For example:

function GetArrayIndex(Source, Value: Array of Byte): Integer;
begin
..
end;

GetArrayIndex(A, B); // results 3
GetArrayIndex(A, C); // results -1

Thank you in advance.

Answer 1

Inspired by SequenceEqual from .net one could do the following:

function ArraysEqual<T>(const Arr1, Arr2: TArray<T>): Boolean;
var
  I: Integer;
  Comparer: IComparer<T>;
begin

  if not Assigned(Arr1) or  not Assigned(Arr2) then Exit(false);

  Result := Length(Arr1) = Length(Arr2);
  if Result then
  begin
    Comparer := TComparer<T>.Default;
    for I := Low(Arr1) to High(Arr1) do
    begin
      if Comparer.Compare(Arr1[I], Arr2[I]) <> 0 then
        Exit(False);
    end;
  end;
end;

Here is a part of my Helper class:

unit Walter.BitUtils;

interface

uses System.SysUtils, System.Generics.Defaults, System.Classes;

type
  TGenericUtils = class
  public
    class function ArraysEqual<T>(const Arr1, Arr2: TArray<T>): Boolean; static;
  end;

implementation

class function TGenericUtils.ArraysEqual<T>(const Arr1,
  Arr2: TArray<T>): Boolean;
var
  I: Integer;
  Comparer: IComparer<T>;
begin

  if not Assigned(Arr1) or  not Assigned(Arr2) then Exit(false);

  Result := Length(Arr1) = Length(Arr2);
  if Result then
  begin
    Comparer := TComparer<T>.Default;
    for I := Low(Arr1) to High(Arr1) do
    begin
      if Comparer.Compare(Arr1[I], Arr2[I]) <> 0 then
        Exit(False);
    end;
  end;
end;

This is how I use it in my test:

procedure SecureDataTests.RoundTripDataWithPasswordTest;
var
  sut: Pointer;
  clearBytes, secureBytes: TBytes;
  size: Integer;
  success, shouldBeEqual: Boolean;
  i: Integer;
const
  TestCount = 5; // Number of times to repeat the decryption test
begin
  clearBytes := TEncoding.Unicode.GetBytes('Hello World');
  CreateSystemUnderTest('You will not guess it in 3 tries!', 1, sut);

  try
    // Test encryption
    success := EncryptBytes(sut, clearBytes, secureBytes, size);
    Assert.IsTrue(success, 'Encryption should succeed.');
    Assert.AreNotEqual(0, size, 'Encrypted data should have a non-zero size.');

    // Test decryption multiple times
    for i := 1 to TestCount do
    begin
      var roundTrip: TBytes; // Local variable for decrypted data
      success := DecryptBytes(sut, secureBytes, roundTrip, size);
      Assert.IsTrue(success, 'Decryption should succeed on iteration ' + IntToStr(i) + '.');
      Assert.AreEqual(Length(clearBytes), Length(roundTrip), 'Decrypted data should match original data length on iteration ' + IntToStr(i) + '.');

      // Verify byte content equality
      shouldBeEqual := TGenericUtils.ArraysEqual<Byte>(clearBytes, roundTrip);
      Assert.IsTrue(shouldBeEqual, 'Round-tripped data should match the original data on iteration ' + IntToStr(i) + '.');
    end;
  finally
    if Assigned(sut) then
    begin
      FreeSystemUnderTest(sut);
      sut := nil; // Ensure pointer is cleared after freeing
    end;
    Assert.IsNull(sut, 'System under test should be nil after disposal.');
  end;
end;

Answer 2

Here is a reworked version of Andreas answer here.

function BytePos(const Pattern: array of byte; const Buffer : array of byte): Integer;
var
  PatternLength,BufLength: cardinal;
  i,j: cardinal;
  OK: boolean;
begin
  Result := -1;
  PatternLength := Length(Pattern);
  BufLength := Length(Buffer);
  if (PatternLength > BufLength) then
    Exit;
  if (PatternLength = 0) then
    Exit;
  for i := 0 to BufLength - PatternLength do
    if Buffer[i] = Pattern[0] then
    begin
      OK := true;
      for j := 1 to PatternLength - 1 do
        if Buffer[i + j] <> Pattern[j] then
        begin
          OK := false;
          Break;
        end;
      if OK then
        Exit(i);
    end;
end;

begin
  WriteLn(BytePos(B,A)); // 3
  WriteLn(BytePos(C,A)); // -1
  ReadLn;
end.

Bummis answer is to prefer, though. Much better.

---

Just a remark as noted in the comments.

For small datasets BytePos outperforms ByteArrayPos, while for large datasets (10000 items) the performance is reversed.

This is for the 32-bit mode, where the assembler optimised Pos() system function works at its best for large datasets.

In 64-bit mode though, there is no assembler optimised Pos() function. In my benchmark test, BytePos is 4-6 times faster than ByteArrayPos, for all types of dataset sizes.

---

Update

The benchmark test was made with XE3.

During the test I discovered a flawed purepascal loop in the System.pas function Pos().

An improvement request has been added, QC111103, where the proposed function is about 3 times faster.

I also optimised the above BytePos a bit and present it here below as ByteposEx().

function BytePosEx(const Pattern,Buffer : array of byte; offset : Integer = 0): Integer;
var
  LoopMax    : Integer;
  OK         : Boolean;
  patternP   : PByte;
  patStart   : Byte;
  i,j        : NativeUInt;
begin
  LoopMax := High(Buffer) - High(Pattern);
  if (offset <= LoopMax) and
     (High(Pattern) >= 0) and
     (offset >= 0) then
  begin
    patternP := @Pattern[0];
    patStart := patternP^;
    for i := NativeUInt(@Buffer[offset]) to NativeUInt(@Buffer[LoopMax]) do
    begin
      if (PByte(i)^ = patStart) then
      begin
        OK := true;
        for j := 1 to High(Pattern) do
          if (PByte(i+j)^ <> patternP[j]) then
          begin
            OK := false;
            Break;
          end;
        if OK then
          Exit(i-NativeUInt(@Buffer[0]));
      end;
    end;
  end;
  Result := -1;
end;

Answer 3

function ByteArrayPos(const SearchArr : array of byte; const CompArr : array of byte) : integer;
//  result=Position or -1 if not found
var
  Comp,Search : AnsiString;
begin
  SetString(Comp, PAnsiChar(@CompArr[0]), Length(CompArr));
  SetString(Search, PAnsiChar(@SearchArr[0]), Length(SearchArr));
  Result := Pos(Search,Comp) - 1;
end;