From 98633665b34c6b514ae55b075b7557e04a0fac10 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 21 Nov 2012 07:29:21 -0600 Subject: [PATCH] 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-" but not others namedn "nonempty-") --- collects/data/queue.rkt | 94 +++++++---- collects/data/scribblings/queue.scrbl | 113 ++++++++++--- collects/tests/data/queue.rkt | 231 ++++++++++++++++---------- 3 files changed, 288 insertions(+), 150 deletions(-) diff --git a/collects/data/queue.rkt b/collects/data/queue.rkt index 0441541439..1d3935e42f 100644 --- a/collects/data/queue.rkt +++ b/collects/data/queue.rkt @@ -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])) diff --git a/collects/data/scribblings/queue.scrbl b/collects/data/scribblings/queue.scrbl index 65e5a7572e..e9a8d3cb0f 100644 --- a/collects/data/scribblings/queue.scrbl +++ b/collects/data/scribblings/queue.scrbl @@ -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] diff --git a/collects/tests/data/queue.rkt b/collects/tests/data/queue.rkt index 69bd421f3e..43d5eedbb9 100644 --- a/collects/tests/data/queue.rkt +++ b/collects/tests/data/queue.rkt @@ -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)))))