diff --git a/collects/data/interval-map.rkt b/collects/data/interval-map.rkt index c448e5c8a9..f05230b80e 100644 --- a/collects/data/interval-map.rkt +++ b/collects/data/interval-map.rkt @@ -100,10 +100,10 @@ (define (norm s pos adjust) (cond [(= pos -inf.0) - (let ([iter (splay-tree-iterate-min s)]) + (let ([iter (splay-tree-iterate-least s)]) (and iter (splay-tree-iterate-key s iter)))] [(= pos +inf.0) - (let ([iter (splay-tree-iterate-max s)]) + (let ([iter (splay-tree-iterate-greatest s)]) ;; add 1 to *include* max (recall, half-open intervals) (and iter (+ 1 (splay-tree-iterate-key s iter))))] [else pos])) diff --git a/collects/data/private/ordered-dict.rkt b/collects/data/order.rkt similarity index 73% rename from collects/data/private/ordered-dict.rkt rename to collects/data/order.rkt index 691c10689e..c3c13b610d 100644 --- a/collects/data/private/ordered-dict.rkt +++ b/collects/data/order.rkt @@ -4,6 +4,11 @@ racket/string unstable/prop-contract) +(define ordering/c + (or/c '= '< '>)) + +(provide ordering/c) + (define-values (prop:ordered-dict ordered-dict? ordered-dict-ref) (make-struct-type-property 'ordered-dict #f)) @@ -19,8 +24,8 @@ (define prop:ordered-dict-contract (let ([e extreme-contract] [s search-contract]) - (vector-immutable/c e ;; iterate-min - e ;; iterate-max + (vector-immutable/c e ;; iterate-least + e ;; iterate-greatest s ;; iterate-least/>? s ;; iterate-least/>=? s ;; iterate-greatest/? d k) (appd d 2 k)) @@ -49,8 +54,8 @@ [prop:ordered-dict (struct-type-property/c prop:ordered-dict-contract)] [ordered-dict? (-> any/c boolean?)] - [dict-iterate-min extreme-contract] - [dict-iterate-max extreme-contract] + [dict-iterate-least extreme-contract] + [dict-iterate-greatest extreme-contract] [dict-iterate-least/>? search-contract] [dict-iterate-least/>=? search-contract] [dict-iterate-greatest/ (U '< '= '>) +(define order* + (let ([order + (case-lambda + [(name ctc cmp) + (order name ctc cmp + (lambda (x y) (eq? (cmp x y) '=)) + (lambda (x y) (eq? (cmp x y) '<)))] + [(name ctc = <) + (order name ctc + (lambda (x y) + (cond [(= x y) '=] + [(< x y) '<] + [(< y x) '>] + [else (incomparable name x y)])) + = <)] + [(name ctc = < >) + (order name ctc + (lambda (x y) + (cond [(= x y) '=] + [(< x y) '<] + [(> x y) '>] + [else (incomparable name x y)])) + = <)])]) + order)) + +(define (incomparable name x y) + (error name "values are incomparable: ~e ~e" x y)) + +(provide/contract + [rename order* order + (->* (symbol? contract? procedure?) (procedure? procedure?) + order?)] + [order? (-> any/c boolean?)] + [order-comparator + (-> order? procedure?)] + [order- order? procedure?)] + [order-=? + (-> order? procedure?)] + [order-domain-contract + (-> order? contract?)]) + +;; ============================================================ + +(define (real/not-NaN? x) (and (real? x) (not (eqv? x +nan.0)))) + +(define real-order + (order* 'real-order real/not-NaN? = < >)) + +(provide/contract + [real-order order?]) + +;; ============================================================ #| natural-cmp : Comparator @@ -103,6 +160,8 @@ Other: |# +;; not exported because I'm not sure it's a good idea and I'm not sure +;; how to characterize it (define (natural-cmp x y) (gen-cmp x y #t)) @@ -239,3 +298,9 @@ Other: [(< i (vector-length y)) '<] [else '=])) + +(define datum-order + (order* 'datum-order any/c datum-cmp)) + +(provide/contract + [datum-order order?]) diff --git a/collects/data/scribblings/data.scrbl b/collects/data/scribblings/data.scrbl index 8fa30e75b9..c597a72943 100644 --- a/collects/data/scribblings/data.scrbl +++ b/collects/data/scribblings/data.scrbl @@ -17,6 +17,7 @@ This manual documents data structure libraries available in the @include-section["queue.scrbl"] @include-section["gvector.scrbl"] +@include-section["order.scrbl"] @include-section["splay-tree.scrbl"] @include-section["skip-list.scrbl"] @include-section["interval-map.scrbl"] diff --git a/collects/data/scribblings/order.scrbl b/collects/data/scribblings/order.scrbl new file mode 100644 index 0000000000..363bc00d11 --- /dev/null +++ b/collects/data/scribblings/order.scrbl @@ -0,0 +1,201 @@ +#lang scribble/manual +@(require scribble/eval + (for-label data/order + racket/contract + unstable/prop-contract + racket/dict + racket/base)) + +@title{Orders and Ordered Dictionaries} + +@(define the-eval (make-base-eval)) +@(the-eval '(require racket/dict data/order)) + +@defmodule[data/order] + +@author[@author+email["Ryan Culpepper" "ryanc@racket-lang.org"]] + +This library defines @deftech{orders} and the @deftech{ordered +dictionary} generic interface. + +@defthing[ordering/c flat-contract?]{ + +Contract for orderings, represented by the symbols @racket['=], +@racket['<], and @racket['>]. +} + +@defthing[prop:ordered-dict + (struct-type-property/c + (vector-immutableof _e/c _e/c _s/c _s/c _s/c _s/c))]{ + +Struct-type property for defining new ordered dictionary types. The +value associated with @racket[prop:ordered-dict] should be an +immutable vector of six procedures, two ``extrema'' procedures and +four ``search'' procedures. The extrema procedures must satisfy +@racket[_e/c] and the search procedures must satisfy @racket[_s/c]: + +@racketblock[ +_e/c = (->i ([d ordered-dict?]) + [_ (d) (or/c #f (dict-iter-contract d))]) +_s/c = (->i ([d ordered-dict?] + [k (d) (dict-key-contract d)]) + [_ (d) (or/c #f (dict-iter-contract d))]) +] + +The procedures are implementations of the following generic functions: + +@itemize[ +@item{@racket[dict-iterate-least]} +@item{@racket[dict-iterate-greatest]} +@item{@racket[dict-iterate-least/>?]} +@item{@racket[dict-iterate-least/>=?]} +@item{@racket[dict-iterate-greatest/? [dict ordered-dict?] [key any/c]) any/c] +@defproc[(dict-iterate-least/>=? [dict ordered-dict?] [key any/c]) any/c] +@defproc[(dict-iterate-greatest/ any/c any/c ordering/c)]) + (and/c order? procedure?)] + [(order [name symbol?] + [domain-contract contract?] + [=? (-> any/c any/c boolean?)] + [ any/c any/c boolean?)] + [>? (-> any/c any/c boolean?) + (lambda (x y) ( any/c any/c ordering/c)]{ + +Extracts the comparator function from an order object. +} + +@defproc[(order-domain-contract [ord order?]) contract?]{ + +Extracts the domain contract from an order object. +} + +@deftogether[[ +@defproc[(order-=? [ord order?]) (-> any/c any/c boolean?)] +@defproc[(order- any/c any/c boolean?)] +]]{ + +Returns a procedure representing the order's equality relation or +less-than relation, respectively. +} + +@defthing[real-order order?]{ + +The order of the real numbers. The domain of @racket[real-order] +excludes @racket[+nan.0] but includes @racket[+inf.0] and +@racket[-inf.0]. The standard numeric comparisons (@racket[=], +@racket[<]) are used; exact @racket[1] is equal to inexact +@racket[1.0]. + +@examples[#:eval the-eval +(real-order 1.0 1) +(real-order 5 7) +(real-order 9.0 3.4) +(real-order 1 +inf.0) +(real-order 5 -inf.0) +] +} + +@defthing[datum-order order?]{ + +An ad hoc order that encompasses many built-in Racket data types. The +@racket[datum-order] comparator orders values of the same data type +according to the data type's natural order: @racket[string=?], +@racket[string . any/c)] - [ . any/c)] +@defproc[(make-skip-list [ord order? datum-order] [#:key-contract key-contract contract? any/c] [#:value-contract value-contract contract? any/c]) skip-list?]{ -Makes a new empty skip-list. The skip-list uses @racket[=?] and -@racket[? [skip-list skip-list?] + [key any/c]) + (or/c skip-list-iter? #f)] +@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?] + [key any/c]) + (or/c skip-list-iter? #f)] @defproc[(skip-list-iterate-greatest/? [skip-list skip-list?] - [key any/c]) - (or/c skip-list-iter? #f)] -@defproc[(skip-list-iterate-least/>=? [skip-list skip-list?] - [key any/c]) - (or/c skip-list-iter? #f)]]]{ +]]{ -Return the position of, respectively, the greatest key less than -@racket[key], the greatest key less than or equal to @racket[key], the -least key greater than @racket[key], and the least key greater than or -equal to @racket[key]. +Implementations of @racket[dict-iterate-least], +@racket[dict-iterate-greatest], @racket[dict-iterate-least/>?], +@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/ any/c any/c any/c)] - [ any/c any/c any/c)] +@defproc[(make-splay-tree [ord order? datum-order] [#:key-contract key-contract contract? any/c] [#:value-contract value-contract contract? any/c]) splay-tree?]{ -Makes a new empty splay-tree. The splay tree uses @racket[=?] and -@racket[? [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?)]]]{ + (or/c #f splay-tree-iter?)] +@defproc[(splay-tree-iterate-greatest/?], +@racket[dict-iterate-least/>=?], @racket[dict-iterate-greatest/=? t-key (set-item-next! f-item level t-item*) - (delete-range f-item t-item (sub1 level) f-key t-key ? skip-list-iterate-least/>=? skip-list-iterate-greatest/* ((-> any/c any/c any/c) (-> any/c any/c any/c)) - (#:key-contract contract? #:value-contract contract?) + (->* () + (order? #:key-contract contract? #:value-contract contract?) skip-list?)] [make-adjustable-skip-list (->* () @@ -469,9 +480,9 @@ Levels are indexed starting at 1, as in the paper. [skip-list-iterate-least/>? (->i ([s skip-list?] [k (s) (key-c s)]) [_ (or/c skip-list-iter? #f)])] - [skip-list-iterate-min + [skip-list-iterate-least (-> skip-list? (or/c skip-list-iter? #f))] - [skip-list-iterate-max + [skip-list-iterate-greatest (-> skip-list? (or/c skip-list-iter? #f))] [skip-list-iter? diff --git a/collects/data/splay-tree.rkt b/collects/data/splay-tree.rkt index 3e4107b022..6c023c67ce 100644 --- a/collects/data/splay-tree.rkt +++ b/collects/data/splay-tree.rkt @@ -4,7 +4,7 @@ racket/match racket/dict racket/contract - "private/ordered-dict.rkt") + "order.rkt") #| This library contains two implementations of splay trees. @@ -473,9 +473,9 @@ Options (define (n:splay-tree-iterate-least/>? s key) (n:extreme s key '(>) n:has-next? n:find-next)) -(define (n:splay-tree-iterate-min s) +(define (n:splay-tree-iterate-least s) (n:splay-tree-iterate-first s)) -(define (n:splay-tree-iterate-max s) +(define (n:splay-tree-iterate-greatest s) (match s [(node-splay-tree root size) (let-values ([(ok? root) (n:find-max root)]) @@ -515,8 +515,8 @@ Options n:splay-tree-iterate-value)) (define n:ordered-dict-methods - (vector-immutable n:splay-tree-iterate-min - n:splay-tree-iterate-max + (vector-immutable n:splay-tree-iterate-least + n:splay-tree-iterate-greatest n:splay-tree-iterate-least/>? n:splay-tree-iterate-least/>=? n:splay-tree-iterate-greatest/ =) v:has-next? v:find-next)]) - (if (and ok? (eq? (cmp (vnode-key mem root) '<) to)) + (if (and ok? (eq? (cmp (vnode-key mem root) to) '<)) (loop (v:delete-root mem root cmp)) root)))) @@ -897,9 +897,9 @@ Top-down splay (define (v:splay-tree-iterate-least/>? s key) (v:extreme s key '(>) v:has-next? v:find-next)) -(define (v:splay-tree-iterate-min s) +(define (v:splay-tree-iterate-least s) (v:splay-tree-iterate-first s)) -(define (v:splay-tree-iterate-max s) +(define (v:splay-tree-iterate-greatest s) (match s [(compact-splay-tree mem root cmp) (let-values ([(ok? root) (v:find-max mem root)]) @@ -935,8 +935,8 @@ Top-down splay v:splay-tree-iterate-value)) (define v:ordered-dict-methods - (vector-immutable v:splay-tree-iterate-min - v:splay-tree-iterate-max + (vector-immutable v:splay-tree-iterate-least + v:splay-tree-iterate-greatest v:splay-tree-iterate-least/>? v:splay-tree-iterate-least/>=? v:splay-tree-iterate-greatest/=? s key) (splay-tree-iterate-least/>? s key) - (splay-tree-iterate-min s) - (splay-tree-iterate-max s) + (splay-tree-iterate-least s) + (splay-tree-iterate-greatest s) (splay-tree->list s)) @@ -1053,8 +1050,7 @@ Top-down splay (define (key-c s) (cond [(compact-splay-tree*? s) (compact-splay-tree*-key-c s)] [(node-splay-tree*? s) - (let ([c (node-splay-tree*-key-c s)]) - (if (eq? c any/c) exact-integer? (and/c exact-integer? c)))] + (and/c* exact-integer? (node-splay-tree*-key-c s))] [(node-splay-tree? s) exact-integer?] [else any/c])) (define (val-c s) @@ -1064,8 +1060,8 @@ Top-down splay (provide/contract [make-splay-tree - (->* ((-> any/c any/c any) (-> any/c any/c any)) - (#:key-contract contract? #:value-contract contract?) + (->* () + (order? #:key-contract contract? #:value-contract contract?) splay-tree?)] [make-adjustable-splay-tree (->* () @@ -1123,9 +1119,9 @@ Top-down splay [splay-tree-iterate-least/>? (->i ([s splay-tree?] [k (s) (key-c s)]) [_ (or/c splay-tree-iter? #f)])] - [splay-tree-iterate-min + [splay-tree-iterate-least (-> splay-tree? (or/c splay-tree-iter? #f))] - [splay-tree-iterate-max + [splay-tree-iterate-greatest (-> splay-tree? (or/c splay-tree-iter? #f))] [splay-tree-iter? (-> any/c boolean?)]) diff --git a/collects/tests/data/ordered-dict.rkt b/collects/tests/data/ordered-dict.rkt index 5a3676682d..5a4478ba2b 100644 --- a/collects/tests/data/ordered-dict.rkt +++ b/collects/tests/data/ordered-dict.rkt @@ -1,9 +1,10 @@ #lang racket/base (require rackunit + racket/contract racket/dict data/skip-list data/splay-tree - data/private/ordered-dict) + data/order) ;; Tests for ordered dictionaries ;; - skip-list @@ -92,10 +93,17 @@ dict-iterate-greatest/