extend data/queue library

- add enqueue-front!

- add queue-filter!

- use the predicates instead of the /c contracts

- make queue-length take constant time

- add some random tests

- note the running times of all of the operations in the docs

- make queues be sequences directly (and use make-do-sequence
  to implement in-queue instead of building a list)

- added non-empty-queue? (note extra hypen as compared
  to the past; this seems better since the function
  wasn't exported before and we already have other
  functions named "non-empty-<something>" but not
  others namedn "nonempty-<something>")
This commit is contained in:
Robby Findler 2012-11-21 07:29:21 -06:00
parent ac7c37812b
commit 98633665b3
3 changed files with 288 additions and 150 deletions

View File

@ -7,17 +7,18 @@
;; to the head and the tail -- where items are pulled from the head and
;; pushed on the tail. It is not thread safe: mutating a queue from
;; different threads can break it.
(struct queue (head tail) #:mutable)
(struct queue (head tail length) #:mutable
#:property prop:sequence (λ (q) (in-queue q)))
;; (Note: uses #f for `head' to mark an empty queue, but in those cases
;; the tail will be set to #f too, to avoid holding on to values that
;; should be collected.)
(struct link (value [tail #:mutable]))
(define (make-queue) (queue #f #f))
(define (make-queue) (queue #f #f 0))
(define (queue-empty? q) (not (queue-head q)))
(define (nonempty-queue? v) (and (queue? v) (queue-head v) #t))
(define (non-empty-queue? v) (and (queue? v) (queue-head v) #t))
(define (enqueue! q v)
(unless (queue? q) (raise-type-error enqueue! "queue" 0 q))
@ -25,7 +26,20 @@
(if (queue-head q)
(set-link-tail! (queue-tail q) new)
(set-queue-head! q new))
(set-queue-tail! q new)))
(set-queue-tail! q new)
(set-queue-length! q (+ (queue-length q) 1))))
(define (enqueue-front! q v)
(unless (queue? q) (raise-type-error enqueue! "enqueue-front!" 0 q))
(define fr (queue-head q))
(cond
[fr
(set-queue-head! q (link v fr))]
[else
(define k (link v #f))
(set-queue-head! q k)
(set-queue-tail! q k)])
(set-queue-length! q (+ (queue-length q) 1)))
(define (dequeue! q)
(unless (queue? q) (raise-type-error dequeue! "queue" 0 q))
@ -37,14 +51,10 @@
(set-queue-head! q #f)]
[else
(set-queue-head! q (link-tail old))])
(set-queue-length! q (- (queue-length q) 1))
(link-value old)))
(define (queue->list queue)
(let loop ([link (queue-head queue)]
[out '()])
(if (not link)
(reverse out)
(loop (link-tail link) (cons (link-value link) out)))))
(define (queue->list q) (for/list ([e (in-queue q)]) e))
;; queue->vector could be implemented as (list->vector (queue->list q))
;; but this is somewhat slow. a direct translation between queue's and
@ -52,19 +62,36 @@
;; as an intermediate data structure.
;; maybe add the elements to a gvector and use gvector->vector?
;; could use (length (queue->list q)) here but that would double
;; the time it takes to get the length
;; probably if `queue->vector' gets implemented it would be better to
;; do (vector-length (queue->vector q))
(define (queue-length queue)
(let loop ([link (queue-head queue)]
[count 0])
(if (not link)
count
(loop (link-tail link) (add1 count)))))
(define (queue-filter! q pred?)
(unless (queue-empty? q)
(let loop ([prev #f]
[curr (queue-head q)]
[i 0])
(cond
[(not curr)
(set-queue-tail! q prev)
(set-queue-length! q i)]
[else
(define passed? (pred? (link-value curr)))
(cond
[passed?
(loop curr (link-tail curr) (+ i 1))]
[else
(define tl (link-tail curr))
(if prev
(set-link-tail! prev tl)
(set-queue-head! q tl))
(loop prev tl i)])]))))
(define (in-queue queue)
(in-list (queue->list queue)))
(define (in-queue q)
(make-do-sequence
(λ ()
(values
link-value
link-tail
(queue-head q)
link?
#f #f))))
(define-sequence-syntax in-queue*
(lambda () #'in-queue)
@ -86,22 +113,19 @@
#f))))
;; --- contracts ---
(define queue/c queue?)
(define nonempty-queue/c non-empty-queue?)
(define queue/c
(flat-named-contract "queue" queue?))
(define nonempty-queue/c
(flat-named-contract "nonempty-queue" nonempty-queue?))
;; Eli: Are these needed? (vs just providing `queue?', `make-queue' and
;; `queue-empty?'.)
(provide/contract
[queue/c flat-contract?]
[nonempty-queue/c flat-contract?]
[queue? (-> any/c boolean?)]
[make-queue (-> queue/c)]
[queue-empty? (-> queue/c boolean?)]
[queue-length (-> queue/c integer?)]
[queue->list (-> queue/c (listof any/c))])
[non-empty-queue? (-> any/c boolean?)]
[make-queue (-> queue?)]
[queue-empty? (-> queue? boolean?)]
[queue-length (-> queue? exact-nonnegative-integer?)]
[queue->list (-> queue? (listof any/c))]
[queue-filter! (-> queue? (-> any/c any/c) void?)])
(provide enqueue! dequeue! (rename-out [in-queue* in-queue]))
(provide enqueue! enqueue-front!
dequeue! (rename-out [in-queue* in-queue]))

View File

@ -10,58 +10,104 @@
@author[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides a simple mutable queue representation,
first-in/first-out only. Operations on queues mutate it in a
thread-unsafe way.
providing first-in/first-out semantics.
@defproc[(make-queue) queue/c]{
Operations on queues mutate it in a thread-unsafe way.
@defproc[(make-queue) queue?]{
Produces an empty queue.
}
@defproc[(enqueue! [q queue/c] [v any/c]) void?]{
@defproc[(enqueue! [q queue?] [v any/c]) void?]{
Adds an element to the back of a queue.
This takes constant time, independent of the number
of elements in @racket[q].
}
@defproc[(dequeue! [q nonempty-queue/c]) any/c]{
Removes an element from the front of a nonempty queue, and returns that
@defproc[(enqueue-front! [q queue?] [v any/c]) void?]{
Adds an element to the front of a queue.
This takes constant time, independent of the number
of elements in @racket[q].
}
@defproc[(dequeue! [q non-empty-queue?]) any/c]{
Removes an element from the front of a non-empty queue, and returns that
element.
@defexamples[#:eval qeval
This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval
(define q (make-queue))
(enqueue! q 1)
(dequeue! q)
(enqueue! q 2)
(enqueue! q 3)
(dequeue! q)
(dequeue! q)]
(dequeue! q)
(enqueue! q 2)
(enqueue! q 1)
(enqueue-front! q 3)
(enqueue-front! q 4)
(queue->list q)]
}
@defproc[(queue->list [queue queue/c]) (listof any/c)]{
@defproc[(queue-filter! [q queue?] [pred? (-> any/c any/c)]) void?]{
Applies @racket[pred?] to each element of the queue,
removing any where @racket[pred?] returns @racket[#f].
This takes time proportional to the number of elements in @racket[q]
(assuming that @racket[pred?] takes constant time, independent
of the number of elements in @racket[q]). It does not allocate and
it calls @racket[pred?] exactly once for each element of @racket[q].
@defexamples[#:eval qeval
(define q (make-queue))
(enqueue! q 1)
(enqueue! q 2)
(enqueue! q 3)
(enqueue! q 4)
(queue-filter! q even?)
(queue->list q)]
}
@defproc[(queue->list [queue queue?]) (listof any/c)]{
Returns an immutable list containing the elements of the queue
in the order the elements were added.
This takes time proportional to the number of elements in @racket[q].
@defexamples[#:eval qeval
(define queue (make-queue))
(enqueue! queue 8)
(enqueue! queue 9)
(enqueue! queue 0)
(queue->list queue)]
(define q (make-queue))
(enqueue! q 8)
(enqueue! q 9)
(enqueue! q 0)
(queue->list q)]
}
@defproc[(queue-length [queue queue/c]) integer?]{
@defproc[(queue-length [queue queue?]) exact-nonnegative-integer?]{
Returns the number of elements in the queue.
This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval
(define queue (make-queue))
(queue-length queue)
(enqueue! queue 5)
(enqueue! queue 12)
(queue-length queue)
(dequeue! queue)
(queue-length queue)]
(queue-length q)
(enqueue! q 5)
(enqueue! q 12)
(queue-length q)
(dequeue! q)
(queue-length q)]
}
@defproc[(queue-empty? [q queue/c]) boolean?]{
@defproc[(queue-empty? [q queue?]) boolean?]{
Recognizes whether a queue is empty or not.
This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval
(define q (make-queue))
@ -74,12 +120,29 @@ thread-unsafe way.
@defproc[(queue? [v any/c]) boolean?]{
This predicate recognizes queues.
This takes constant time, independent of the
size of the argument @racket[v].
@defexamples[#:eval qeval
(queue? (make-queue))
(queue? 'not-a-queue)]
}
@defproc[(non-empty-queue? [v any/c]) boolean?]{
This predicate recognizes non-empty queues.
This takes constant time, independent of the
size of the argument @racket[v].
@defexamples[#:eval qeval
(non-empty-queue? (let ([q (make-queue)])
(enqueue! q 1)
q))
(non-empty-queue? (make-queue))
(non-empty-queue? 'not-a-queue)]
}
@defproc[(in-queue [queue queue?])
sequence?]{
@ -91,9 +154,9 @@ Returns a sequence whose elements are the elements of
@defthing[queue/c flat-contract?]
@defthing[nonempty-queue/c flat-contract?]
)]{
These contracts recognize queues; the latter requires the queue to
contain at least one value.
These are provided for backwards compatibility. They are
identical to @racket[queue?] and @racket[non-empty-queue?],
respectively.
}
@close-eval[qeval]

View File

@ -1,95 +1,146 @@
#lang racket/base
(require rackunit rackunit/text-ui data/queue)
(require rackunit rackunit/text-ui
data/queue
racket/stream)
(run-tests
(test-suite "queue.rkt"
(test-suite "queue-empty?"
(test-case "make-queue"
(check-true (queue-empty? (make-queue))))
(test-case "enqueue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(check-false (queue-empty? q))))
(test-case "enqueue! once / dequeue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(dequeue! q)
(check-true (queue-empty? q))))
(test-case "enqueue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(dequeue! q)
(check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(dequeue! q)
(dequeue! q)
(check-true (queue-empty? q)))))
(test-suite "length"
(test-case "length empty"
(let* ([queue (make-queue)])
(check-equal? (queue-length queue) 0)))
(test-case "length enqueue once"
(let* ([queue (make-queue)])
(enqueue! queue 5)
(check-equal? (queue-length queue) 1)))
(test-case "length enqueue thrice dequeue once"
(let* ([queue (make-queue)])
(enqueue! queue 5)
(enqueue! queue 9)
(enqueue! queue 12)
(dequeue! queue)
(check-equal? (queue-length queue) 2))))
(test-suite "dequeue!"
(test-case "make-queue"
(check-exn exn:fail? (lambda () (dequeue! (make-queue)))))
(test-case "enqueue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(check-equal? (dequeue! q) 1)
(check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "enqueue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(check-equal? (dequeue! q) 1)
(check-equal? (dequeue! q) 2)
(check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "don't leak last element"
(let* ([thing (box 'box-that-queue-should-not-hold-onto)]
[wb (make-weak-box thing)]
[q (make-queue)])
(enqueue! q thing)
(set! thing #f)
(dequeue! q)
(collect-garbage)
(check-false (weak-box-value wb))
;; need a reference to 'q' after looking in the
;; box or else the whole queue gets collected
(check-true (queue? q)))))
(test-suite "queue misc"
(test-case "queue as a sequence"
(let ([queue (make-queue)])
(enqueue! queue 1)
(enqueue! queue 2)
(enqueue! queue 3)
(check-equal? '(1 2 3) (for/list ([item (in-queue queue)]) item)))
(check-equal? '() (for/list ([item (in-queue (make-queue))]) item)))
(test-case "queue to empty list"
(let ([queue (make-queue)])
(check-equal? (queue->list queue) '())))
(test-case "queue length"
(let ([queue (make-queue)])
(enqueue! queue 1)
(enqueue! queue 2)
(enqueue! queue 3)
(check-equal? (queue->list queue) '(1 2 3)))))))
(test-suite "queue-empty?"
(test-case "make-queue"
(check-true (queue-empty? (make-queue))))
(test-case "enqueue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(check-false (queue-empty? q))))
(test-case "enqueue! once / dequeue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(dequeue! q)
(check-true (queue-empty? q))))
(test-case "enqueue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(dequeue! q)
(check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(dequeue! q)
(dequeue! q)
(check-true (queue-empty? q)))))
(test-suite "length"
(test-case "length empty"
(let* ([queue (make-queue)])
(check-equal? (queue-length queue) 0)))
(test-case "length enqueue once"
(let* ([queue (make-queue)])
(enqueue! queue 5)
(check-equal? (queue-length queue) 1)))
(test-case "length enqueue thrice dequeue once"
(let* ([queue (make-queue)])
(enqueue! queue 5)
(enqueue! queue 9)
(enqueue! queue 12)
(dequeue! queue)
(check-equal? (queue-length queue) 2))))
(test-suite "dequeue!"
(test-case "make-queue"
(check-exn exn:fail? (lambda () (dequeue! (make-queue)))))
(test-case "enqueue! once"
(let* ([q (make-queue)])
(enqueue! q 1)
(check-equal? (dequeue! q) 1)
(check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "enqueue! twice"
(let* ([q (make-queue)])
(enqueue! q 1)
(enqueue! q 2)
(check-equal? (dequeue! q) 1)
(check-equal? (dequeue! q) 2)
(check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "don't leak last element"
(let* ([thing (box 'box-that-queue-should-not-hold-onto)]
[wb (make-weak-box thing)]
[q (make-queue)])
(enqueue! q thing)
(set! thing #f)
(dequeue! q)
(collect-garbage)
(check-false (weak-box-value wb))
;; need a reference to 'q' after looking in the
;; box or else the whole queue gets collected
(check-true (queue? q)))))
(test-suite "queue misc"
(test-case "queue as a sequence"
(let ([queue (make-queue)])
(enqueue! queue 1)
(enqueue! queue 2)
(enqueue! queue 3)
(check-equal? '(1 2 3) (for/list ([item (in-queue queue)]) item)))
(check-equal? '() (for/list ([item (in-queue (make-queue))]) item)))
(test-case "queue to empty list"
(let ([queue (make-queue)])
(check-equal? (queue->list queue) '())))
(test-case "queue length"
(let ([queue (make-queue)])
(enqueue! queue 1)
(enqueue! queue 2)
(enqueue! queue 3)
(check-equal? (queue->list queue) '(1 2 3)))))))
;; try 1000 random tests
(for ([x (in-range 1000)])
(define lst '())
(define deq (make-queue))
(define ops '())
;; try 30 random ops per test
(for ([op-number (in-range 30)])
(case (random 5)
[(0)
(define ele (random 100000))
(set! lst (cons ele lst))
(enqueue-front! deq ele)
(set! ops (cons `(add-front ,ele) ops))]
[(1)
(define ele (random 100000))
(set! lst (reverse (cons ele (reverse lst))))
(enqueue! deq ele)
(set! ops (cons `(add-back ,ele) ops))]
[(2)
(unless (null? lst)
(dequeue! deq)
(set! lst (cdr lst))
(set! ops (cons `(pop) ops)))]
[(3)
(set! lst (filter even? lst))
(queue-filter! deq even?)
(set! ops (cons `(filter even?) ops))]
[(4)
(set! lst (filter odd? lst))
(queue-filter! deq odd?)
(set! ops (cons `(filter odd?) ops))])
;; check to make sure the list
;; and queue version match up
;; after each of the ops
(define qlst (queue->list deq))
(unless (equal? lst qlst)
(error 'queue.rkt
"test failure, elements different: ~s\n => ~s (queue)\n => ~s (list)"
ops
qlst lst))
(unless (= (length lst) (queue-length deq))
(error 'queue.rkt
"test failure, lengths different: ~s\n => ~s (queue)\n => ~s (list)"
ops
(length lst) (queue-length deq)))))