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:
parent
ac7c37812b
commit
98633665b3
|
@ -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]))
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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)))))
|
||||
|
|
Loading…
Reference in New Issue
Block a user