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

glennj's solution

to Circular Buffer in the Tcl Track

Published at Apr 01 2020 · 0 comments
Instructions
Test suite
Solution

Note:

This exercise has changed since this solution was written.

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]

Submitting Incomplete Solutions

It's possible to submit an incomplete solution so you can see how others have completed the exercise.

Running the tests

To run the test suite, execute one of the following commands:

tclsh circular-buffer.test            # Will stop testing after the first failure.
RUN_ALL=1 tclsh circular-buffer.test  # Will run all tests and report all failures.

Feedback, Issues, Pull Requests

The exercism/tcl repository on GitHub is the home for all of the Tcl exercises on Exercism.

If you have feedback about an exercise, or want to help implementing a new one, head over there and create an issue. We'll do our best to help you!

Source

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

circular-buffer.test

#!/usr/bin/env tclsh
set version 1.2.0
package require tcltest
namespace import ::tcltest::*
source "circular-buffer.tcl"

proc fail_fast {} {
    return [expr {
        ![info exists ::env(RUN_ALL)]
        || [string is boolean -strict $::env(RUN_ALL)]
        && !$::env(RUN_ALL)
    }]
}

proc failed {} {
    return [expr {$::tcltest::numTests(Failed) > 0}]
}

if {[fail_fast]} {
    proc test args {
        if {[failed]} {::tcltest::configure -skip *}
        uplevel [list ::tcltest::test {*}$args]
    }
}

proc cleanupTests {} {
    set failed [failed]
    uplevel 1 ::tcltest::cleanupTests
    if {$failed} {exit 1}
}

customMatch boolean booleanMatch
proc booleanMatch {expected actual} {
    return [expr {
        [string is boolean -strict $expected] &&
        [string is boolean -strict $actual] &&
        (($expected && $actual) || (!$expected && !$actual))
    }]
}

if {$::argv0 eq [info script]} {

    test circular-buffer-0.1 "new buffer is empty" -body {
        set b [CircularBuffer new 2]
        $b empty?
    } -returnCodes ok -match boolean -result true

    test circular-buffer-0.2 "non-empty buffer is not empty" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b empty?
    } -returnCodes ok -match boolean -result false

    test circular-buffer-0.3 "full buffer is full" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b write 2
        $b full?
    } -returnCodes ok -match boolean -result true

    test circular-buffer-0.4 "non-full buffer is not full" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b full?
    } -returnCodes ok -match boolean -result false

    test circular-buffer-1 "reading empty buffer should fail" -body {
        set b [CircularBuffer new 1]
        $b read
    } -returnCodes error -result "buffer is empty"

    test circular-buffer-2 "can read an item just written" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b read
    } -returnCodes ok -result "1"

    test circular-buffer-3 "each item may only be read once" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b read
        $b read
    } -returnCodes error -result "buffer is empty"

    test circular-buffer-4 "items are read in the order they are written" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b write 2
        set values {}
        lappend values [$b read]
        lappend values [$b read]
    } -returnCodes ok -result {1 2}

    test circular-buffer-5 "full buffer can't be written to" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b write 2
    } -returnCodes error -result "buffer is full"

    test circular-buffer-6 "a read frees up capacity for another write" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b read
        $b write 2
        $b read
    } -returnCodes ok -result "2"

    test circular-buffer-7 "read position is maintained even across multiple writes" -body {
        set b [CircularBuffer new 3]
        $b write 1
        $b write 2
        $b read
        $b write 3
        $b read
        $b read
    } -returnCodes ok -result "3"

    test circular-buffer-8 "items cleared out of buffer can't be read" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b clear
        $b read
    } -returnCodes error -result "buffer is empty"

    test circular-buffer-9 "clear frees up capacity for another write" -body {
        set b [CircularBuffer new 1]
        $b write 1
        $b clear
        $b write 2
        $b read
    } -returnCodes ok -result "2"

    test circular-buffer-10 "clear does nothing on an empty buffer" -body {
        set b [CircularBuffer new 1]
        $b clear
    } -returnCodes ok -result ""

    test circular-buffer-11 "overwrite acts like write on non-full buffer" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b overwrite 2
        set values {}
        lappend values [$b read]
        lappend values [$b read]
    } -returnCodes ok -result {1 2}

    test circular-buffer-12 "overwrite replaces the oldest item on full buffer" -body {
        set b [CircularBuffer new 2]
        $b write 1
        $b write 2
        $b overwrite 3
        set values {}
        lappend values [$b read]
        lappend values [$b read]
    } -returnCodes ok -result {2 3}

    test circular-buffer-13 "overwrite replaces the oldest item remaining in buffer following a read" -body {
        set b [CircularBuffer new 3]
        $b write 1
        $b write 2
        $b write 3
        $b read
        $b write 4
        $b overwrite 5
        set values {}
        lappend values [$b read]
        lappend values [$b read]
        lappend values [$b read]
    } -returnCodes ok -result {3 4 5}

    test circular-buffer-14 "initial clear does not affect wrapping around" -body {
        set b [CircularBuffer new 2]
        $b clear
        $b write 1
        $b write 2
        $b overwrite 3
        $b overwrite 4
        # some inelegant code: collect the results to ensure
        # the 3rd read is the one with the error.
        set result {}
        lappend result [$b read]
        lappend result [$b read]
        try {
            $b read
        } on error {} {
            lappend result "err"
        }
    } -returnCodes ok -result {3 4 err}

    cleanupTests
}
oo::class create CircularBuffer {
    variable tape
    variable readPtr writePtr
    variable NULL

    constructor {cap} {
        set NULL \x0
        set tape [lrepeat $cap $NULL]
        my clear
    }

    method empty? {} {
        expr {[lindex $tape $readPtr] eq $NULL}
    }

    method full? {} {
        expr {[lindex $tape $writePtr] ne $NULL}
    }

    method read {} {
        if {[my empty?]} {
            error "buffer is empty"
        }
        set value [lindex $tape $readPtr]
        lset tape $readPtr $NULL
        my increment readPtr
        return $value
    }

    method write {value} {
        if {[my full?]} {
            error "buffer is full"
        }
        lset tape $writePtr $value
        my increment writePtr
        return
    }

    method increment {ptrName} {
        upvar 1 $ptrName ptr
        # implement the circularity: wrap to zero when at end of tape
        set ptr [expr {(1 + $ptr) % [llength $tape]}]
    }
    unexport increment ;# private

    method overwrite {value} {
        if {[my full?]} {
            # discard oldest value
            my read
        }
        my write $value
    }

    method clear {} {
        set tape [lmap cell $tape {set NULL}]
        set readPtr 0
        set writePtr 0
        return
    }
}

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?