suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

extend data/queue library

Browse Source 
- 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
collects/data/queue.rkt
View File

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

113
collects/data/scribblings/queue.scrbl
View File

@ -10,59 +10,105 @@
@author[@author+email["Carl Eastlund" "cce@racket-lang.org"]] @author[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
This module provides a simple mutable queue representation, This module provides a simple mutable queue representation,
first-in/first-out only. Operations on queues mutate it in a providing first-in/first-out semantics.
thread-unsafe way.
@defproc[(make-queue) queue/c]{ Operations on queues mutate it in a thread-unsafe way.
@defproc[(make-queue) queue?]{
Produces an empty 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. 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]{ @defproc[(enqueue-front! [q queue?] [v any/c]) void?]{
Removes an element from the front of a nonempty queue, and returns that 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. element.
@defexamples[#:eval qeval This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval
(define q (make-queue)) (define q (make-queue))
(enqueue! q 1) (enqueue! q 1)
(dequeue! q) (dequeue! q)
(enqueue! q 2) (enqueue! q 2)
(enqueue! q 3) (enqueue! q 3)
(dequeue! q) (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 Returns an immutable list containing the elements of the queue
in the order the elements were added. in the order the elements were added.
This takes time proportional to the number of elements in @racket[q].
@defexamples[#:eval qeval @defexamples[#:eval qeval
(define queue (make-queue)) (define q (make-queue))
(enqueue! queue 8) (enqueue! q 8)
(enqueue! queue 9) (enqueue! q 9)
(enqueue! queue 0) (enqueue! q 0)
(queue->list queue)] (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. Returns the number of elements in the queue.
This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval @defexamples[#:eval qeval
(define queue (make-queue)) (define queue (make-queue))
(queue-length queue) (queue-length q)
(enqueue! queue 5) (enqueue! q 5)
(enqueue! queue 12) (enqueue! q 12)
(queue-length queue) (queue-length q)
(dequeue! queue) (dequeue! q)
(queue-length queue)] (queue-length q)]
} }
@defproc[(queue-empty? [q queue/c]) boolean?]{ @defproc[(queue-empty? [q queue?]) boolean?]{
Recognizes whether a queue is empty or not. Recognizes whether a queue is empty or not.
This takes constant time, independent of the number
of elements in @racket[q].
@defexamples[#:eval qeval @defexamples[#:eval qeval
(define q (make-queue)) (define q (make-queue))
(queue-empty? q) (queue-empty? q)
@ -75,11 +121,28 @@ thread-unsafe way.
@defproc[(queue? [v any/c]) boolean?]{ @defproc[(queue? [v any/c]) boolean?]{
This predicate recognizes queues. This predicate recognizes queues.
This takes constant time, independent of the
size of the argument @racket[v].
@defexamples[#:eval qeval @defexamples[#:eval qeval
(queue? (make-queue)) (queue? (make-queue))
(queue? 'not-a-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?]) @defproc[(in-queue [queue queue?])
sequence?]{ sequence?]{
@ -91,9 +154,9 @@ Returns a sequence whose elements are the elements of
@defthing[queue/c flat-contract?] @defthing[queue/c flat-contract?]
@defthing[nonempty-queue/c flat-contract?] @defthing[nonempty-queue/c flat-contract?]
)]{ )]{
These contracts recognize queues; the latter requires the queue to These are provided for backwards compatibility. They are
contain at least one value. identical to @racket[queue?] and @racket[non-empty-queue?],
respectively.
} }
@close-eval[qeval] @close-eval[qeval]

231
collects/tests/data/queue.rkt
View File

@ -1,95 +1,146 @@
#lang racket/base #lang racket/base
(require rackunit rackunit/text-ui data/queue) (require rackunit rackunit/text-ui
data/queue
racket/stream)
(run-tests (run-tests
(test-suite "queue.rkt" (test-suite "queue.rkt"
(test-suite "queue-empty?" (test-suite "queue-empty?"
(test-case "make-queue" (test-case "make-queue"
(check-true (queue-empty? (make-queue)))) (check-true (queue-empty? (make-queue))))
(test-case "enqueue! once" (test-case "enqueue! once"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(check-false (queue-empty? q)))) (check-false (queue-empty? q))))
(test-case "enqueue! once / dequeue! once" (test-case "enqueue! once / dequeue! once"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(dequeue! q) (dequeue! q)
(check-true (queue-empty? q)))) (check-true (queue-empty? q))))
(test-case "enqueue! twice" (test-case "enqueue! twice"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(enqueue! q 2) (enqueue! q 2)
(check-false (queue-empty? q)))) (check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! once" (test-case "enqueue! twice / dequeue! once"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(enqueue! q 2) (enqueue! q 2)
(dequeue! q) (dequeue! q)
(check-false (queue-empty? q)))) (check-false (queue-empty? q))))
(test-case "enqueue! twice / dequeue! twice" (test-case "enqueue! twice / dequeue! twice"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(enqueue! q 2) (enqueue! q 2)
(dequeue! q) (dequeue! q)
(dequeue! q) (dequeue! q)
(check-true (queue-empty? q))))) (check-true (queue-empty? q)))))
(test-suite "length" (test-suite "length"
(test-case "length empty" (test-case "length empty"
(let* ([queue (make-queue)]) (let* ([queue (make-queue)])
(check-equal? (queue-length queue) 0))) (check-equal? (queue-length queue) 0)))
(test-case "length enqueue once" (test-case "length enqueue once"
(let* ([queue (make-queue)]) (let* ([queue (make-queue)])
(enqueue! queue 5) (enqueue! queue 5)
(check-equal? (queue-length queue) 1))) (check-equal? (queue-length queue) 1)))
(test-case "length enqueue thrice dequeue once" (test-case "length enqueue thrice dequeue once"
(let* ([queue (make-queue)]) (let* ([queue (make-queue)])
(enqueue! queue 5) (enqueue! queue 5)
(enqueue! queue 9) (enqueue! queue 9)
(enqueue! queue 12) (enqueue! queue 12)
(dequeue! queue) (dequeue! queue)
(check-equal? (queue-length queue) 2)))) (check-equal? (queue-length queue) 2))))
(test-suite "dequeue!" (test-suite "dequeue!"
(test-case "make-queue" (test-case "make-queue"
(check-exn exn:fail? (lambda () (dequeue! (make-queue))))) (check-exn exn:fail? (lambda () (dequeue! (make-queue)))))
(test-case "enqueue! once" (test-case "enqueue! once"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(check-equal? (dequeue! q) 1) (check-equal? (dequeue! q) 1)
(check-exn exn:fail? (lambda () (dequeue! q))))) (check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "enqueue! twice" (test-case "enqueue! twice"
(let* ([q (make-queue)]) (let* ([q (make-queue)])
(enqueue! q 1) (enqueue! q 1)
(enqueue! q 2) (enqueue! q 2)
(check-equal? (dequeue! q) 1) (check-equal? (dequeue! q) 1)
(check-equal? (dequeue! q) 2) (check-equal? (dequeue! q) 2)
(check-exn exn:fail? (lambda () (dequeue! q))))) (check-exn exn:fail? (lambda () (dequeue! q)))))
(test-case "don't leak last element" (test-case "don't leak last element"
(let* ([thing (box 'box-that-queue-should-not-hold-onto)] (let* ([thing (box 'box-that-queue-should-not-hold-onto)]
[wb (make-weak-box thing)] [wb (make-weak-box thing)]
[q (make-queue)]) [q (make-queue)])
(enqueue! q thing) (enqueue! q thing)
(set! thing #f) (set! thing #f)
(dequeue! q) (dequeue! q)
(collect-garbage) (collect-garbage)
(check-false (weak-box-value wb)) (check-false (weak-box-value wb))
;; need a reference to 'q' after looking in the ;; need a reference to 'q' after looking in the
;; box or else the whole queue gets collected ;; box or else the whole queue gets collected
(check-true (queue? q))))) (check-true (queue? q)))))
(test-suite "queue misc" (test-suite "queue misc"
(test-case "queue as a sequence" (test-case "queue as a sequence"
(let ([queue (make-queue)]) (let ([queue (make-queue)])
(enqueue! queue 1) (enqueue! queue 1)
(enqueue! queue 2) (enqueue! queue 2)
(enqueue! queue 3) (enqueue! queue 3)
(check-equal? '(1 2 3) (for/list ([item (in-queue queue)]) item))) (check-equal? '(1 2 3) (for/list ([item (in-queue queue)]) item)))
(check-equal? '() (for/list ([item (in-queue (make-queue))]) item))) (check-equal? '() (for/list ([item (in-queue (make-queue))]) item)))
(test-case "queue to empty list" (test-case "queue to empty list"
(let ([queue (make-queue)]) (let ([queue (make-queue)])
(check-equal? (queue->list queue) '()))) (check-equal? (queue->list queue) '())))
(test-case "queue length" (test-case "queue length"
(let ([queue (make-queue)]) (let ([queue (make-queue)])
(enqueue! queue 1) (enqueue! queue 1)
(enqueue! queue 2) (enqueue! queue 2)
(enqueue! queue 3) (enqueue! queue 3)
(check-equal? (queue->list queue) '(1 2 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)))))