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

dgeiger's solution

to Circular Buffer in the Delphi Pascal Track

Published at Sep 24 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
  System.Generics.Collections, System.SysUtils;

type
  ICircularBuffer<Char> = interface['{C3D9998D-ECF4-4BC9-8A2F-E4812D56EE05}']
    function Read: Char;

    procedure Clear;
    procedure OverWrite(Value: Char);
    procedure Write(Value: Char);

  end;

  TCircularBuffer<Char> = class(TInterfacedObject, ICircularBuffer<Char>)
    private
      FBuffer: TArray<Char>;
      FCount: Integer;
      FEnd: Integer;
      FSize: Integer;
      FStart: Integer;
//      FCurrent: Integer;

      function FNext(Pointer: Integer): Integer;


    public
      constructor Create(BufferSize: Integer);

      function Read: Char;

      procedure Clear;
      procedure OverWrite(Value: Char);
      procedure Write(Value: Char);

  end;

implementation

{ TCircularBuffer<char> }

procedure TCircularBuffer<Char>.Clear;
begin
  // Set the variables to show that the buffer starts at zero, has no
  // entries, and, therefore, the end position is the same as the start
  FStart   := Low(FBuffer);
  FEnd     := Low(FBuffer);
  FCount   := 0;
end;

constructor TCircularBuffer<Char>.Create(BufferSize: Integer);
begin
  // Save the buffer size
  FSize := BufferSize;

  // Create the buffer
  SetLength(FBuffer, FSize);

  // and clear the buffer
  Clear;
end;

function TCircularBuffer<Char>.FNext(Pointer: Integer): Integer;
begin
  // Get the next pointer into the buffer
  Result := Succ(Pointer);

  // If we're past theend of the buffer,
  if Result > High(FBuffer) then
    // wrap around to the beginning
    Result := Low(FBuffer);
end;

procedure TCircularBuffer<Char>.OverWrite(Value: Char);
begin
  // If the buffer isn't full, just do a normal write
  if FCount < FSize then
    Write(Value)
  else
    // Otherwise, forcibly overwrite the first entry, and
    // move the start position to the next entry.
     begin
       FBuffer[FStart] := Value;

       FStart := FNext(FStart);
     end;
end;

function TCircularBuffer<Char>.Read: Char;
begin
  // If there are no buffer entries, throw an exception
  if FCount = 0 then
    raise EInvalidOpException.Create('buffer is empty');

  // Get the entry
  Result := FBuffer[FStart];

  // Decrement the entry count
  FCount := Pred(FCount);

  // If we've run out of entries, mark the buffer as empty
  if FCount = 0 then
    Clear
  else
    // Otherwise, move the start pointer to the next position
    FStart := FNext(FStart);
end;

procedure TCircularBuffer<Char>.Write(Value: Char);
begin
  // If the buffer is full, throw an exception
  if FCount = FSize then
    raise EInvalidOpException.Create('buffer is full');

  // Otherwise, increment the entry count,
  Inc(FCount);

  // store the entry in the buffer,
  FBuffer[FEnd] := Value;

  // and update the end pointer.
  FEnd := FNext(FEnd);
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?