Originally posted to comp.lang.tcl, 6 Aug 2003 <[email protected]>
Someone asked:
I want to implement a circular queue in Tcl where the setter function writes to the bottom of the queue and the getter reads them from the top of the queue.
As previously mentioned, tcllib has a FIFO queue package that you could use, but this is an interesting exercise in Tcl data structure design so it's worthwhile looking at how to build one from scratch.
The usual way to implement a FIFO queue in "traditional" languages is with a circular linked list or with a regular linked list and an extra "tail" pointer. This approach doesn't translate into Tcl very well; pointers and anonymous dynamically allocated nodes aren't a good fit with Tcl where "everything is a string".
But Tcl does have a number of other useful building blocks: associative arrays and lists are the main ones. Let's see what we can build out of these.
The simplest approach is simply to represent the queue as a list:
proc qinit {qvar} {
upvar 1 $qvar Q
set Q [list]
}
proc qput {qvar elem} {
upvar 1 $qvar Q
lappend Q $elem
}
proc qget {qvar} {
upvar 1 $qvar Q
set head [lindex $Q 0]
set Q [lrange $Q 1 end]
return $head
}
proc qempty {qvar} {
upvar 1 $qvar Q
return [expr {[llength $Q] == 0}]
}The above implementation of qput is efficient, since lappend has amortized O(1) runtime, but qget is problematic. lrange $Q 1 end is O(N), so in the worst case an algorithm using this queue implementation would take O(N^2) time.
We can improve on this by borrowing an idea from Hood-Melville queues: split the queue into two pieces, "L" and "R". qput adds elements to R, and qget takes them from L; if L is empty, move the contents of R onto L. Instead of actually removing elements from L, we just keep track of the index of the next item; the left half of the queue is empty when this index reaches the end of the list.
proc qinit {qvar} {
upvar 1 $qvar Q
set Q(i) 0
set Q(l) [list]
set Q(r) [list]
}
proc qput {qvar elem} {
upvar 1 $qvar Q
lappend Q(r) $elem
}
proc qget {qvar} {
upvar 1 $qvar Q
if {$Q(i) >= [llength $Q(l)]} {
set Q(l) $Q(r)
set Q(r) [list]
set Q(i) 0
}
set head [lindex $Q(l) $Q(i)]
incr Q(i)
return $head
}
proc qempty {qvar} {
upvar 1 $qvar Q
return [expr {$Q(i) >= [llength $Q(l)] && [llength $Q(r)] == 0}]
}Now qput and qget both run in O(1) time, and the space usage is at most a constant factor more than the naive implementation using a single list.