Exercism v3 launches on Sept 1st 2021. Learn more! πŸš€πŸš€πŸš€
Avatar of gottaTw

gottaTw's solution

to Circular Buffer in the Delphi Pascal Track

Published at Mar 18 2021 · 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
  System.Generics.Collections, System.SysUtils;

type
  ICircularBuffer<T> = interface
   ['{274D540A-2E7A-4FAA-8BD5-C66A0C3432DB}']
    procedure Write(const aValue: T);
    function Read: T;
    procedure clear;
    procedure OverWrite(aValue: T);

  end;

  TCircularBuffer<T> = class(TInterfacedObject, ICircularBuffer<T>)
  strict private
    FQueue: TQueue<T>;

  public
    constructor Create(const aQueueLength: Integer);
    destructor Destroy;
    procedure Write(const aValue: T);
    function Read: T;
    procedure Clear;
    procedure OverWrite(aValue: T);
  end;

  EInvalidOpException = class(exception);

implementation

{ TCircularBuffer }
constructor TCircularBuffer<T>.Create(const aQueueLength: Integer);
begin
  FQueue := TQueue<T>.Create();
  FQueue.Capacity := aQueueLength;
end;

destructor TCircularBuffer<T>.Destroy;
begin
  FreeAndNil(FQueue);
end;

procedure TCircularBuffer<T>.Write(const aValue: T);
begin
  if(FQueue.Count < FQueue.Capacity) then
    FQueue.Enqueue(aValue)
  else
    raise EInvalidOpException.Create('buffer is full');
end;

function TCircularBuffer<T>.Read: T;
begin
  if (FQueue.Count <= 0) then
    raise EInvalidOpException.Create('buffer is empty')
  else
    Result := FQueue.Dequeue;
end;

procedure TCircularBuffer<T>.Clear;
begin
  FQueue.Clear;
end;

procedure TCircularBuffer<T>.OverWrite(aValue: T);
begin
  if(FQueue.Count >= FQueue.Capacity) then
    FQueue.Dequeue;
  FQueue.Enqueue(aValue);
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?