diff --git a/collects/data/heap.rkt b/collects/data/heap.rkt index 28b19c6df1..a83c75a636 100644 --- a/collects/data/heap.rkt +++ b/collects/data/heap.rkt @@ -5,8 +5,8 @@ (define MIN-SIZE 4) -(define-struct heap (vec count <=?) #:mutable) -;; length(vec)/4 <= size <= length(vec) +(struct heap ([vec #:mutable] [count #:mutable] <=?)) +;; length(vec)/4 <= size <= length(vec), except size >= MIN-SIZE ;; size = next available index ;; A VT is a binary tree represented as a vector. @@ -52,7 +52,7 @@ (unless (<=? n-key child-key) (vector-set! vec n child-key) (vector-set! vec child n-key) - (heapify-down vec child size))))))) + (heapify-down <=? vec child size))))))) (define (subheap? <=? vec n size) (let ([left (vt-leftchild n)] @@ -76,10 +76,11 @@ ;; Heaps -(define make-heap* - (let ([make-heap - (lambda (<=?) (make-heap (make-vector MIN-SIZE #f) 0 <=?))]) - make-heap)) +(define (make-heap <=?) + (heap (make-vector MIN-SIZE #f) 0 <=?)) + +(define (list->heap <=? lst) + (vector->heap <=? (list->vector lst))) (define (vector->heap <=? vec0 [start 0] [end (vector-length vec0)]) (define size (- end start)) @@ -89,27 +90,34 @@ (vector-copy! vec 0 vec0 start end) (for ([n (in-range (sub1 size) -1 -1)]) (heapify-down <=? vec n size)) - (make-heap vec size <=?)) + (heap vec size <=?)) (define (heap-copy h) (match h [(heap vec count <=?) - (make-heap (vector-copy vec) count <=?)])) + (heap (vector-copy vec) count <=?)])) (define (heap-add! h . keys) (heap-add-all! h (list->vector keys))) (define (heap-add-all! h keys) - (let ([keys (if (list? keys) (list->vector keys) keys)]) + (let-values ([(keys keys-size) + (cond [(list? keys) + (let ([keys-v (list->vector keys)]) + (values keys-v (vector-length keys-v)))] + [(vector? keys) + (values keys (vector-length keys))] + [(heap? keys) + (values (heap-vec keys) (heap-count keys))])]) (match h [(heap vec size <=?) - (let* ([new-size (+ size (vector-length keys))] + (let* ([new-size (+ size keys-size)] [vec (if (> new-size (vector-length vec)) (let ([vec (grow-vector vec new-size)]) (set-heap-vec! h vec) vec) vec)]) - (vector-copy! vec size keys 0) + (vector-copy! vec size keys 0 keys-size) (for ([n (in-range size new-size)]) (heapify-up <=? vec n)) (set-heap-count! h new-size))]))) @@ -123,7 +131,7 @@ (define (heap-remove-min! h) (match h - [(heap vec size <+?) + [(heap vec size <=?) (when (zero? size) (error 'heap-remove-min! "empty heap")) (heap-remove-index! h 0)])) @@ -134,7 +142,7 @@ (unless (< index size) (if (zero? size) (error 'heap-remove-index! - "index out of bounds (empty heap): ~s" index) + "empty heap: ~s" index) (error 'heap-remove-index! "index out of bounds [0,~s]: ~s" (sub1 size) index))) (vector-set! vec index (vector-ref vec (sub1 size))) @@ -156,23 +164,38 @@ (lambda _ #t) (lambda _ #t)))) +;; -------- + +(define (heap-sort! <=? v) + ;; to get ascending order, need max-heap, so reverse comparison + (define (>=? x y) (<=? y x)) + (define size (vector-length v)) + (for ([n (in-range (sub1 size) -1 -1)]) + (heapify-down >=? v n size)) + (for ([last (in-range (sub1 size) 0 -1)]) + (let ([tmp (vector-ref v 0)]) + (vector-set! v 0 (vector-ref v last)) + (vector-set! v last tmp)) + (heapify-down >=? v 0 last))) + +(define (heap->vector h) + (match h + [(heap vec size <=?) + (heap-sort! <=? (vector-copy vec 0 size))])) + +;; -------- + (provide/contract [make-heap (-> (-> any/c any/c any/c) heap?)] [heap? (-> any/c boolean?)] [heap-count (-> heap? exact-nonnegative-integer?)] - [heap-copy (-> heap? heap?)] - [vector->heap (-> (-> any/c any/c any/c) vector? heap?)] [heap-add! (->* (heap?) () #:rest list? void?)] - [heap-add-all! (-> heap? (or/c list? vector?) void?)] + [heap-add-all! (-> heap? (or/c list? vector? heap?) void?)] [heap-min (-> heap? any/c)] [heap-remove-min! (-> heap? void?)] - [in-heap (-> heap? sequence?)]) -#| -;; Testing + [vector->heap (-> (-> any/c any/c any/c) vector? heap?)] + [heap->vector (-> heap? vector?)] + [heap-copy (-> heap? heap?)] -(vector->heap #(3 65 3 54 3 2 1 4 6)) - -(define h - (vector->heap #(3 65 3 3 2 1))) -|# + [heap-sort! (-> procedure? vector? void?)]) diff --git a/collects/data/scribblings/data.scrbl b/collects/data/scribblings/data.scrbl index bd9132d8be..8fa30e75b9 100644 --- a/collects/data/scribblings/data.scrbl +++ b/collects/data/scribblings/data.scrbl @@ -16,6 +16,8 @@ This manual documents data structure libraries available in the @;{--------} @include-section["queue.scrbl"] +@include-section["gvector.scrbl"] +@include-section["splay-tree.scrbl"] @include-section["skip-list.scrbl"] @include-section["interval-map.scrbl"] -@include-section["gvector.scrbl"] +@include-section["heap.scrbl"] diff --git a/collects/data/scribblings/heap.scrbl b/collects/data/scribblings/heap.scrbl new file mode 100644 index 0000000000..9cc94f82ea --- /dev/null +++ b/collects/data/scribblings/heap.scrbl @@ -0,0 +1,80 @@ +#lang scribble/manual +@(require scribble/eval + (for-label data/heap + racket/contract + racket/base)) + +@title{Binary Heap} + +@(define the-eval (make-base-eval)) +@(the-eval '(require data/heap)) + +@defmodule[data/heap] + +@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] + +Binary heaps are a simple implementation of priority queues. + +@defproc[(make-heap [<=? (-> any/c any/c any/c)]) + heap?]{ + +Makes a new empty heap. +} + +@defproc[(heap? [x any/c]) boolean?]{ + +Returns @racket[#t] if @racket[x] is a heap, @racket[#f] otherwise. +} + +@defproc[(heap-count [h heap?]) exact-nonnegative-integer?]{ + +Returns the number of elements in the heap. +} + +@defproc[(heap-add! [h heap?] [v any/c] ...) void?]{ + +Adds each @racket[v] to the heap. +} + +@defproc[(heap-add-all! [h heap?] [v (or/c list? vector? heap?)]) void?]{ + +Adds each element contained in @racket[v] to the heap, leaving +@racket[v] unchanged. +} + +@defproc[(heap-min [h heap?]) any/c]{ + +Returns the least element in the heap @racket[h], according to the +heap's ordering. If the heap is empty, an exception is raised. +} + +@defproc[(heap-remove-min! [h heap?]) void?]{ + +Removes the least element in the heap @racket[h]. If the heap is +empty, an exception is raised. +} + +@defproc[(vector->heap [<=? (-> any/c any/c any/c)] [items vector?]) heap?]{ + +Builds a heap with the elements from @racket[items]. The vector is not +modified. +} + +@defproc[(heap->vector [h heap?]) vector?]{ + +Returns a vector containing the elements of heap @racket[h] in the +heap's order. The heap is not modified. +} + +@defproc[(heap-copy [h heap?]) heap?]{ + +Makes a copy of heap @racket[h]. +} + + +@;{--------} + +@defproc[(heap-sort! [<=? (-> any/c any/c any/c)] [v vector?]) void?]{ + +Sorts vector @racket[v] using the comparison function @racket[<=?]. +} diff --git a/collects/data/scribblings/splay-tree.scrbl b/collects/data/scribblings/splay-tree.scrbl index baecb0d5bd..289363a44b 100644 --- a/collects/data/scribblings/splay-tree.scrbl +++ b/collects/data/scribblings/splay-tree.scrbl @@ -90,7 +90,7 @@ adjustment; see @racket[splay-tree-contract!] and @defproc[(splay-tree-remove! [s splay-tree?] [key any/c]) void?] -@defproc[(splay-tree-count! [s splay-tree?]) exact-nonnegative-integer?] +@defproc[(splay-tree-count [s splay-tree?]) exact-nonnegative-integer?] @defproc[(splay-tree-iterate-first [s splay-tree?]) (or/c #f splay-tree-iter?)] @defproc[(splay-tree-iterate-next [s splay-tree?] [iter splay-tree-iter?]) diff --git a/collects/data/splay-tree.rkt b/collects/data/splay-tree.rkt index 967bd0ce2e..5766d08029 100644 --- a/collects/data/splay-tree.rkt +++ b/collects/data/splay-tree.rkt @@ -533,7 +533,7 @@ In an integer splay tree, keys can be stored relative to their parent nodes. [splay-tree-ref (->i ([s splay-tree?] [key (s) (key-c s)]) ([default any/c]) - [_ (s default) (or/c (key-c s) (lambda (x) (eq? x default)))])] + any)] [splay-tree-set! (->i ([s splay-tree?] [key (s) (key-c s)] [v (s) (val-c s)]) [_ void?])] [splay-tree-remove!