From 58aa6873fe4952811de8c822d60713e4cb62713d Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Tue, 14 Sep 2010 01:00:10 -0600 Subject: [PATCH] added data/heap tests doc fixes --- collects/data/heap.rkt | 18 ++++-- collects/data/scribblings/heap.scrbl | 4 +- collects/data/scribblings/splay-tree.scrbl | 9 +-- collects/data/splay-tree.rkt | 4 +- collects/tests/data/heap.rkt | 69 ++++++++++++++++++++++ 5 files changed, 91 insertions(+), 13 deletions(-) create mode 100644 collects/tests/data/heap.rkt diff --git a/collects/data/heap.rkt b/collects/data/heap.rkt index a83c75a636..4520aff4d8 100644 --- a/collects/data/heap.rkt +++ b/collects/data/heap.rkt @@ -34,7 +34,7 @@ (unless (<=? parent-key n-key) (vector-set! vec parent n-key) (vector-set! vec n parent-key) - (heapify-up vec parent))))) + (heapify-up <=? vec parent))))) (define (heapify-down <=? vec n size) (let ([left (vt-leftchild n)] @@ -64,10 +64,14 @@ (<=? (vector-ref vec n) (vector-ref vec right)) #t)))) -(define (grow-vector v1) - (let ([v2 (make-vector (* (vector-length v1) 2) #f)]) - (vector-copy! v2 0 v1 0) - v2)) +(define (grow-vector v1 new-size-min) + (let ([new-size (let loop ([size (vector-length v1)]) + (if (>= size new-size-min) + size + (loop (* size 2))))]) + (let ([v2 (make-vector new-size #f)]) + (vector-copy! v2 0 v1 0) + v2))) (define (shrink-vector v1) (let ([v2 (make-vector (quotient (vector-length v1) 2) #f)]) @@ -181,7 +185,9 @@ (define (heap->vector h) (match h [(heap vec size <=?) - (heap-sort! <=? (vector-copy vec 0 size))])) + (let ([v (vector-copy vec 0 size)]) + (heap-sort! <=? v) + v)])) ;; -------- diff --git a/collects/data/scribblings/heap.scrbl b/collects/data/scribblings/heap.scrbl index 9cc94f82ea..1bcffc8480 100644 --- a/collects/data/scribblings/heap.scrbl +++ b/collects/data/scribblings/heap.scrbl @@ -4,7 +4,7 @@ racket/contract racket/base)) -@title{Binary Heap} +@title{Binary Heaps} @(define the-eval (make-base-eval)) @(the-eval '(require data/heap)) @@ -18,7 +18,7 @@ Binary heaps are a simple implementation of priority queues. @defproc[(make-heap [<=? (-> any/c any/c any/c)]) heap?]{ -Makes a new empty heap. +Makes a new empty heap using @racket[<=?] to order elements. } @defproc[(heap? [x any/c]) boolean?]{ diff --git a/collects/data/scribblings/splay-tree.scrbl b/collects/data/scribblings/splay-tree.scrbl index 289363a44b..abad9739c5 100644 --- a/collects/data/scribblings/splay-tree.scrbl +++ b/collects/data/scribblings/splay-tree.scrbl @@ -118,8 +118,9 @@ greater than or equal to @racket[from] and less than @racket[to]. [from any/c] [to any/c]) void?]{ -Like @racket[splay-tree-remove-range!], but decreases the value of all -keys greater than or equal to @racket[to] by @racket[(- to from)]. +Like @racket[splay-tree-remove-range!], but also decreases the value +of all keys greater than or equal to @racket[to] by @racket[(- to +from)]. } @defproc[(splay-tree-expand! [s (and/c splay-tree? splay-tree-with-adjust?)] @@ -135,9 +136,9 @@ by @racket[(- to from)]. (or/c #f splay-tree-iter?)] @defproc[(splay-tree-iterate-greatest/<=? [s splay-tree?] [key any/c]) (or/c #f splay-tree-iter?)] -@defproc[(splay-tree-iterate-least/? [s splay-tree?] [key any/c]) (or/c #f splay-tree-iter?)] -@defproc[(splay-tree-iterate-least/<=? [s splay-tree?] [key any/c]) +@defproc[(splay-tree-iterate-least/>=? [s splay-tree?] [key any/c]) (or/c #f splay-tree-iter?)]]]{ Return the position of, respectively, the greatest key less than diff --git a/collects/data/splay-tree.rkt b/collects/data/splay-tree.rkt index 5766d08029..efa00e208c 100644 --- a/collects/data/splay-tree.rkt +++ b/collects/data/splay-tree.rkt @@ -570,4 +570,6 @@ In an integer splay tree, keys can be stored relative to their parent nodes. [splay-tree-iterate-least/>=? (->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])] [splay-tree-iterate-least/>? - (->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])]) + (->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])] + + [splay-tree-iter? (-> any/c boolean?)]) diff --git a/collects/tests/data/heap.rkt b/collects/tests/data/heap.rkt new file mode 100644 index 0000000000..256478d55f --- /dev/null +++ b/collects/tests/data/heap.rkt @@ -0,0 +1,69 @@ +#lang racket +(require rackunit + data/heap) + +(define (mkheap) (vector->heap <= (vector 6 2 4 10 8))) + +(test-equal? "heap->vector" + (heap->vector (mkheap)) + '#(2 4 6 8 10)) + +(test-equal? "heap-add! min" + (let ([h (mkheap)]) + (heap-add! h 0) + (heap->vector h)) + '#(0 2 4 6 8 10)) + +(test-equal? "heap-add! mid" + (let ([h (mkheap)]) + (heap-add! h 5) + (heap->vector h)) + '#(2 4 5 6 8 10)) + +(test-equal? "heap-add! multi" + (let ([h (mkheap)]) + (heap-add! h 0 5 12) + (heap->vector h)) + '#(0 2 4 5 6 8 10 12)) + +(test-equal? "heap-remove-min!" + (let ([h (mkheap)]) + (heap-remove-min! h) + (heap->vector h)) + '#(4 6 8 10)) + +(define (rand-test range count1 count2 count3) + (let ([h (make-heap <=)] + [xs null]) ;; mutated + (define (fill! count) + (for ([i (in-range count)]) + (let ([x (random range)]) + (heap-add! h x) + (set! xs (cons x xs)))) + (set! xs (sort xs <))) + + (fill! count1) + + ;; check equal (non-destructive) + (check-equal? (vector->list (heap->vector h)) + xs) + + (for ([i (in-range count2)]) + (let ([xl (car xs)] + [xh (heap-min h)]) + (set! xs (cdr xs)) + (heap-remove-min! h))) + + (fill! count3) + + (for ([x (in-list xs)]) + (check-equal? (heap-min h) x) + (heap-remove-min! h)) + + (check-equal? (heap-count h) 0))) + +(test-case "heap random sparse" + (rand-test 1000 100 50 100)) + +(test-case "heap random dense" + (rand-test 20 100 50 100))