πŸŽ‰ Exercism Research is now launched. Help Exercism, help science and have some fun at research.exercism.io πŸŽ‰
Avatar of Sarahhuik

Sarahhuik's solution

to Circular Buffer in the Delphi Pascal Track

Published at Aug 20 2020 · 0 comments
Instructions
Test suite
Solution

A circular buffer, cyclic buffer or ring buffer is a data structure that uses a single, fixed-size buffer as if it were connected end-to-end.

A circular buffer first starts empty and of some predefined length. For example, this is a 7-element buffer:

[ ][ ][ ][ ][ ][ ][ ]

Assume that a 1 is written into the middle of the buffer (exact starting location does not matter in a circular buffer):

[ ][ ][ ][1][ ][ ][ ]

Then assume that two more elements are added β€” 2 & 3 β€” which get appended after the 1:

[ ][ ][ ][1][2][3][ ]

If two elements are then removed from the buffer, the oldest values inside the buffer are removed. The two elements removed, in this case, are 1 & 2, leaving the buffer with just a 3:

[ ][ ][ ][ ][ ][3][ ]

If the buffer has 7 elements then it is completely full:

[6][7][8][9][3][4][5]

When the buffer is full an error will be raised, alerting the client that further writes are blocked until a slot becomes free.

When the buffer is full, the client can opt to overwrite the oldest data with a forced write. In this case, two more elements β€” A & B β€” are added and they overwrite the 3 & 4:

[6][7][8][9][A][B][5]

3 & 4 have been replaced by A & B making 5 now the oldest data in the buffer. Finally, if two elements are removed then what would be returned is 5 & 6 yielding the buffer:

[ ][7][8][9][A][B][ ]

Because there is space available, if the client again uses overwrite to store C & D then the space where 5 & 6 were stored previously will be used not the location of 7 & 8. 7 is still the oldest element and the buffer is once again full.

[D][7][8][9][A][B][C]

Testing

In order to run the tests for this track, you will need to install DUnitX. Please see the installation instructions for more information.

Loading Exercises into Delphi

If Delphi is properly installed, and *.dpr file types have been associated with Delphi, then double clicking the supplied *.dpr file will start Delphi and load the exercise/project. control + F9 is the keyboard shortcut to compile the project or pressing F9 will compile and run the project.

Alternatively you may opt to start Delphi and load your project via. the File drop down menu.

When Questions Come Up

We monitor the Pascal-Delphi support room on gitter.im to help you with any questions that might arise.

Submitting Exercises

Note that, when trying to submit an exercise, make sure the exercise file you're submitting is in the exercism/delphi/<exerciseName> directory.

For example, if you're submitting ubob.pas for the Bob exercise, the submit command would be something like exercism submit <path_to_exercism_dir>/delphi/bob/ubob.pas.

Source

Wikipedia http://en.wikipedia.org/wiki/Circular_buffer

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you may request help from a mentor.

uCircularBufferTests.pas

unit uCircularBufferTests;

interface
uses
  DUnitX.TestFramework;

const
   CanonicalVersion = '1.0.1';

type

  [TestFixture]
  TestCircularBuffer = class(TObject)
  public
    [Test]
//  [Ignore('Comment the "[Ignore]" statement to run the test')]
    procedure reading_empty_buffer_should_fail;

    [Test]
    [Ignore]
    procedure can_read_an_item_just_written;

    [Test]
    [Ignore]
    procedure Write_and_read_back_multiple_items;

    [Test]
    [Ignore]
    procedure each_item_may_only_be_read_once;

    [Test]
    [Ignore]
    procedure items_are_read_in_the_order_they_are_written;

    [Test]
    [Ignore]
    procedure full_buffer_cannot_be_written_to;

    [Test]
    [Ignore]
    procedure a_read_frees_up_capacity_for_another_write;

    [Test]
    [Ignore]
    procedure read_position_is_maintained_even_across_multiple_writes;

    [Test]
    [Ignore]
    procedure items_cleared_out_of_buffer_cannot_be_read;

    [Test]
    [Ignore]
    procedure clear_frees_up_capacity_for_another_write;

    [Test]
    [Ignore]
    procedure clear_does_nothing_on_empty_buffer;

    [Test]
    [Ignore]
    procedure overwrite_acts_like_write_on_non_full_buffer;

    [Test]
    [Ignore]
    procedure overwrite_replaces_the_oldest_item_on_full_buffer;

    [Test]
    [Ignore]
    procedure overwrite_replaces_the_oldest_item_remaining_in_buffer_following_a_read;
  end;

implementation
uses System.SysUtils, uCircularBuffer;

procedure TestCircularBuffer.can_read_an_item_just_written;
var MyBuffer: ICircularBuffer<char>;
    Actual: char;
begin
  MyBuffer := TCircularBuffer<char>.Create(1);
  MyBuffer.Write('1');
  Actual := MyBuffer.Read;
  assert.AreEqual('1', Actual);
end;

procedure TestCircularBuffer.clear_does_nothing_on_empty_buffer;
var MyBuffer: ICircularBuffer<integer>;
    Actual: integer;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.Create(1);
  MyBuffer.Clear;

  MyProc := procedure
            begin
              MyBuffer.Write(1);
            end;

  Assert.WillNotRaise(MyProc, EInvalidOpException);

  Actual := MyBuffer.Read;
  Assert.AreEqual(1, Actual);
end;

procedure TestCircularBuffer.clear_frees_up_capacity_for_another_write;
var MyBuffer: ICircularBuffer<integer>;
    Actual: integer;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.Create(1);
  MyBuffer.Write(1);
  MyBuffer.Clear;

  MyProc := procedure
            begin
              MyBuffer.Write(2);
            end;

  Assert.WillNotRaise(MyProc, EInvalidOpException);

  Actual := MyBuffer.Read;
  Assert.AreEqual(2, Actual);
end;

procedure TestCircularBuffer.Write_and_read_back_multiple_items;
var MyBuffer: ICircularBuffer<char>;
    Act1, Act2: char;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<char>.Create(2);
  MyBuffer.Write('1');
  MyBuffer.Write('2');

  Act1 := MyBuffer.Read;
  Act2 := MyBuffer.Read;

  Assert.AreEqual('1', Act1);
  Assert.AreEqual('2', Act2);

  MyProc := procedure
            begin
              MyBuffer.Read;
            end;

  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.items_cleared_out_of_buffer_cannot_be_read;
var MyBuffer: ICircularBuffer<char>;
    Act1, Act2: char;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<char>.Create(1);

  MyBuffer.Write('1');

  MyBuffer.Clear;

  MyProc := procedure
            begin
              MyBuffer.Read;
            end;
  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.each_item_may_only_be_read_once;
var MyBuffer: ICircularBuffer<integer>;
    Actual: integer;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.Create(1);
  MyBuffer.Write(1);
  Actual := MyBuffer.Read;
  assert.AreEqual(1, Actual);
  MyProc := procedure
            begin
              MyBuffer.Read;
            end;
  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.a_read_frees_up_capacity_for_another_write;
var MyBuffer: ICircularBuffer<integer>;
    Actual: integer;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.create(1);
  MyBuffer.Write(1);
  Actual := MyBuffer.Read;

  MyProc := procedure
            begin
              MyBuffer.Write(2);
            end;
  Assert.WillNotRaise(MyProc, EInvalidOpException);
  Actual := MyBuffer.Read;
  Assert.AreEqual(2, Actual);
end;

procedure TestCircularBuffer.read_position_is_maintained_even_across_multiple_writes;
var MyBuffer: ICircularBuffer<char>;
    Actual: char;
begin
  MyBuffer := TCircularBuffer<char>.create(3);
  MyBuffer.Write('1');
  MyBuffer.Write('2');
  Actual := MyBuffer.Read;
  Assert.AreEqual('1', Actual);

  MyBuffer.Write('3');

  Actual := MyBuffer.Read;
  Assert.AreEqual('2',Actual);
  Actual := MyBuffer.Read;
  Assert.AreEqual('3',Actual);
end;

procedure TestCircularBuffer.full_buffer_cannot_be_written_to;
var MyBuffer: ICircularBuffer<char>;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<char>.create(1);
  MyBuffer.Write('1');

  MyProc := procedure
            begin
              MyBuffer.Write('2');
            end;
  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.overwrite_replaces_the_oldest_item_on_full_buffer;
var MyBuffer: ICircularBuffer<integer>;
    Act1, Act2: integer;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.create(2);
  MyBuffer.Write(1);
  MyBuffer.Write(2);
  MyBuffer.OverWrite(3);

  Act1 := MyBuffer.Read;
  Act2 := MyBuffer.Read;

  Assert.AreEqual(2, Act1);
  Assert.AreEqual(3, Act2);
end;

procedure TestCircularBuffer.overwrite_replaces_the_oldest_item_remaining_in_buffer_following_a_read;
var MyBuffer: ICircularBuffer<integer>;
    MyProc: TTestLocalMethod;
    Actual: integer;
begin
  MyBuffer := TCircularBuffer<integer>.create(3);
  MyBuffer.Write(1);
  MyBuffer.Write(2);
  MyBuffer.Write(3);

  Actual := MyBuffer.Read;
  Assert.AreEqual(1,Actual);

  MyBuffer.Write(4);
  MyBuffer.OverWrite(5);

  Actual := MyBuffer.Read;
  Assert.AreEqual(3,Actual);
  Actual := MyBuffer.Read;
  Assert.AreEqual(4,Actual);
  Actual := MyBuffer.Read;
  Assert.AreEqual(5,Actual);
end;

procedure TestCircularBuffer.reading_empty_buffer_should_fail;
var MyBuffer: ICircularBuffer<integer>;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<integer>.create(2);
  MyProc := procedure
            begin
              MyBuffer.Read;
            end;
  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.overwrite_acts_like_write_on_non_full_buffer;
var MyBuffer: ICircularBuffer<char>;
    Act1, Act2: char;
    MyProc: TTestLocalMethod;
begin
  MyBuffer := TCircularBuffer<char>.create(2);
  MyBuffer.Write('1');
  MyBuffer.OverWrite('2');

  Act1 := MyBuffer.Read;
  Act2 := MyBuffer.Read;

  Assert.AreEqual('1', Act1);
  Assert.AreEqual('2', Act2);
  MyProc := procedure
            begin
              MyBuffer.Read;
            end;
  Assert.WillRaise(MyProc, EInvalidOpException);
end;

procedure TestCircularBuffer.items_are_read_in_the_order_they_are_written;
var MyBuffer: ICircularBuffer<char>;
    Act: TArray<char>;
begin
  SetLength(Act, 2);
  MyBuffer := TCircularBuffer<char>.create(2);
  MyBuffer.Write('1');
  MyBuffer.Write('2');

  Act[0] := MyBuffer.Read;
  Act[1] := MyBuffer.Read;

  Assert.AreEqual('1', Act[0]);
  Assert.AreEqual('2', Act[1]);
end;

initialization
  TDUnitX.RegisterTestFixture(TestCircularBuffer);
end.
unit uCircularBuffer;
interface

uses Generics.Collections, System.Generics.Defaults;

type
  ICircularBuffer<T> = interface
    procedure Write(const ToWrite: T);
    function read : T;
    procedure overwrite(const ToWrite : T);
    procedure clear;
  end;  // ICircularBuffer interface

type
  TCircularBuffer<T> = class(TInterfacedObject, ICircularBuffer<T>)
  private
    Buffer : array of T;
    NbOfCells, Current, Oldest : Integer;
    BufferFull : Boolean;
    Compare: IEqualityComparer<T>;
    procedure AssignAndIncrement(var iValue : Integer ; const ToWrite : T);
    procedure Init;
  public
    procedure Write(const ToWrite: T);
    function read : T;
    procedure overwrite(const ToWrite : T);
    procedure clear;
    constructor Create(const iNbOfCells : Integer);
    destructor Destroy; override;
  end; // TCircularBuffer class

implementation

uses System.SysUtils;

constructor TCircularBuffer<T>.Create(const iNbOfCells : Integer);
begin
  NbOfCells := iNbOfCells;

  Compare := TEqualityComparer<T>.Default;  // To compare Nil object
                                            // Default(T) = nil = nothing in cell
  SetLength(Buffer, iNbOfCells);
  Current := 0;  // Start at first cell
  Init           // Init all values
End;

destructor TCircularBuffer<T>.Destroy;
begin
 Buffer := nil;
  inherited
end;

function TCircularBuffer<T>.read : T;
  var TResult : T;
begin
  // If oldest item is equal to nil => this is an empty buffer and it can't be read
  if (Compare.Equals(Buffer[Oldest], default(T))) then
    raise EInvalidOpException.Create('You''re trying to read an empty circular Buffer');

  TResult := Buffer[Oldest];
  AssignAndIncrement(Oldest, default(T));
  BufferFull := False; // Buffer is no longer full

  result := TResult
end;

procedure TCircularBuffer<T>.Write(const ToWrite: T);
begin
  if (BufferFull) then
    raise EInvalidOpException.Create('You''re trying to write in a full circular Buffer');

  AssignAndIncrement(Current, ToWrite);

  if (Oldest = Current) then
    BufferFull := True
end;

procedure TCircularBuffer<T>.overwrite(const ToWrite : T);
begin
  if not BufferFull then
    Write(ToWrite)
  else
    AssignAndIncrement(oldest, ToWrite)
end;

procedure TCircularBuffer<T>.AssignAndIncrement(var iValue : Integer ; const ToWrite : T);
begin
  Buffer[iValue] := ToWrite;
  iValue := (iValue + 1) mod NbOfCells // mod => to have a circular buffer, we go back to beginning of the array
end;

procedure TCircularBuffer<T>.clear;
begin
  Init
end;

procedure TCircularBuffer<T>.Init;
var
  i: Integer;
begin
  Oldest := Current; // 0 if First time, whatever if nth time
  BufferFull := False;

  for i := Low(Buffer) to High(Buffer) do
    Buffer[i] := Default(T) // assign nil, i.e: nothing in cell
end;

end.

Community comments

Find this solution interesting? Ask the author a question to learn more.

What can you learn from this solution?

A huge amount can be learned from reading other people’s code. This is why we wanted to give exercism users the option of making their solutions public.

Here are some questions to help you reflect on this solution and learn the most from it.

  • What compromises have been made?
  • Are there new concepts here that you could read more about to improve your understanding?